plotter.tcl

rtai-3.1-test3的源代码(Real-Time Application Interface )

proc plotter:pathDepth {path} {
    set i 0
    set index [string first "." $path]
    while {$index != -1} {
	incr i
	set path [string range $path [expr $index + 1] end]
	set index [string first "." $path]
    }
    return $i
}

proc plotter:removeDots {path} {
    regsub -all "\\." $path "" result
    return $result
}

proc plotter:removeSpaces {string} {
    regsub -all "\\ " $string "" result
    return $result
}

proc plotter:lempty {list} {
    if {[llength $list] == 0} {
	return 1
    }
    return 0
}

proc plotter:lremove {listName element} {
    upvar 1 $listName list
    
    set index [lsearch -exact $list $element]
    
    if {$index == -1} {
	return 0
    }
    
    set i 0
    while {$index != -1} {
	set list [lreplace $list $index $index]
	set index [lsearch -exact $list $element]
	incr i
    }

    return $i
}

proc plotter:ladd {listName element} {
    upvar 1 $listName list
    set index [lsearch -exact $list $element]
    
    if {$index == -1} {
	lappend list $element
	return 0
    }

    set nextlist [lreplace $list $index $index]
    set index [lsearch -exact $nextlist $element]
    while {$index != -1} {
	set list $nextlist
	set nextlist [lreplace $nextlist $index $index]
	set index [lsearch -exact $nextlist $element]
    }
    return 1
}

proc plotter:panedResize {context wcanvas hcanvas} {
    upvar #0 plotter:vComp vComp

    set hpanedw [winfo height $context.panedw]
    if {$hcanvas > $hpanedw || $vComp($context)} {
	$context itemconfigure plotter:$context -width $wcanvas -height $hcanvas
	update idletasks
	$context configure -scrollregion \
	    [list 0 0 [winfo width $context.panedw] [winfo height $context.panedw]]
    } else {
	$context itemconfigure plotter:$context -width $wcanvas
    }
    plotter:manageVerticalCompress $context
}

proc plotter:panedSetSize {context} {
    set wcanvas [winfo width $context]
    set hcanvas [winfo height $context]

    set height [winfo height $context.panedw]
    if {$hcanvas >= $height} {
	set height $hcanvas
    }
    $context itemconfigure plotter:$context -height $height -width $wcanvas
    update idletasks
    $context configure -scrollregion [list 0 0 [winfo width $context.panedw] $height]
}

proc plotter:panedSetSizeWhenMapped {context} {
    upvar #0 plotter:vComp vComp \
	plotter:objects objects
    
    plotter:manageVerticalCompress $context
	
    set panesList [$context.panedw panes]
    set nbpanes [llength $panesList]

    if {$vComp($context)} {
	#	set paneSize [expr [winfo height $context.panedw] / $nbpanes]
	set paneSize [plotter:getItsMinHeight $context]
	set allPaneSize [plotter:getAllMinHeight $context]
    } else {
	set paneSize 250
	set allPaneSize [expr $paneSize * $nbpanes]
	$context yview moveto 0
    }
    $context itemconfigure plotter:$context -height $allPaneSize
    update idletasks
    
    foreach i $objects($context) {
	set pane [plotter:removeDots $i]
	set paneSize [plotter:getItsMinHeight $i]
	$context.panedw paneconfigure $pane -min $paneSize -max $paneSize
    }
    
    foreach i $objects($context) {
	set pane [plotter:removeDots $i]
	set paneSize [plotter:getItsMinHeight $i]
	$context.panedw setsize $pane $paneSize next
    }
    
    foreach i $objects($context) {
	set pane [plotter:removeDots $i]
	$context.panedw paneconfigure $pane -min 0 -max 10000
    }

    plotter:panedSetSize $context
    bind $context <Map> ""
}

proc plotter:displayPreProcess {context display} {
    upvar #0 plotter:compound compound
    upvar #0 plotter:properties properties
    

    set error "Error during the selection:"
    set nb 0
    foreach i $compound {
	if {[lsearch -exact $display $i] != -1} {
	    foreach j [lindex $properties($i) 4] {
		if {[plotter:lremove display $j]} {
		    set error "$error\n [lindex [lindex $properties($j) 0] 0] is already displayed in [lindex [lindex $properties($i) 0] 0]"
		    incr nb
		}
	    }
	}
    }
    if {$nb} {
	if {$nb > 1} {
	    set error "$error\n\n These objects won't be displayed"
	} else {
	    set error "$error\n\n This object won't be displayed"
	}
	
	tk_messageBox -default ok -icon error \
	    -message $error \
	    -parent . -title Error -type ok
    }
    return $display
}

proc plotter:getVisiblePlotter {context} {
    upvar #0 plotter:nbPageName2Context p2c

    set pageName [$context.nb raised]
    return $p2c($pageName)
}

proc plotter:menuUpdate {context} {
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:properties properties

    set thisContext [plotter:getVisiblePlotter $context]
    
    if {$thisContext == ""} {
	return
    }
    
    if {[lindex $hierarchy($thisContext) 0] == ""} {
	return
    }

    if {[lindex $properties([lindex $hierarchy($thisContext) 0]) 2] == "time"} {  
	plotter:modifyEntry $context mhistoPoll-1
	plotter:modifyEntry $context mxadjust-1
	plotter:modifyEntry $context mscrollLock-1
	plotter:modifyEntry $context mcolorChoice-1
	plotter:modifyEntry $context mglobalBreak-1
    } else {
	plotter:modifyEntry $context mhistoPoll-2
	plotter:modifyEntry $context mxadjust-2
	plotter:modifyEntry $context mscrollLock-2
	plotter:modifyEntry $context mcolorChoice-2
	plotter:modifyEntry $context mcompress-3
	plotter:modifyEntry $context mzoomIn-1
	plotter:modifyEntry $context mzoomOut-1
	plotter:modifyEntry $context mglobalBreak-2
    }
    plotter:processCurrentState $thisContext
}

proc plotter:slowScroll {context amount} {
    set cont [plotter:getVisiblePlotter $context]
    $cont yview scroll $amount units
}

proc plotter:fastScroll {context amount} {
    set cont [plotter:getVisiblePlotter $context]
    $cont yview scroll $amount pages
}


proc plotter:display {context display} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects
    global plotter:xAxisManage 
    upvar #0 plotter:functionnalitiesListCurve fListC
    upvar #0 plotter:functionnalitiesListHisto fListH
    upvar #0 plotter:functionnalitiesLocalTimeGraph fLocalTG
    upvar #0 plotter:functionnalitiesLocalTimeState fLocalTS
    upvar #0 plotter:functionnalitiesLocalHisto fLocalH
    upvar #0 plotter:functionnalitiesDescription fDes
    upvar #0 plotter:functionnalitiesLocalCMPD fLocalCMPD
    global plotter:isMapped
    upvar #0 plotter:tMax tMax  
    global plotter:mode
    global plotter:histoDisplay
    global plotter:histoView
    upvar #0 plotter:colorAuto colorAuto
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:mainMenu mainMenu
    upvar #0 plotter:nbPageName2Context p2c
    upvar #0 plotter:tCur tCur
    global plotter:vComp

    # plotter:display can be called from the main context and from one of the 
    # sub-context
    if {[plotter:pathDepth $context] == 2} {
	set context $invertedHierarchy($context)
    }
    
  
    set oldPlotters $plotters
    set plotters {}
    set waitForMap {}
    
    global plotter:started
    if {! [info exists plotter:started]} {
	# retrieve the previous session geometry
	set geometry [plotter:getGeometrySession $context]
	wm geometry $context =[lindex $geometry 0]x[lindex $geometry 1]
	set plotter:started 1
	TkRequest $context StartDisplay
    }
  

    set display [plotter:displayPreProcess $context $display]
    
    set oldObjectsList {}
    set newObjectsList {}
    set newPlottersList {}

    if {! [winfo exists $context.nb]} { 
	frame $context.menubar -relief raised -borderwidth 2
	tixNoteBook $context.nb
	pack $context.menubar -fill x
	pack $context.nb -expand yes -fill both -side top
	set k 0
	foreach m $mainMenu {
	    set title [lindex $m 0]
	    set entries [lindex $m 1]
	    set cmd [lindex $m 2]
	    menubutton $context.menubar.$k -text $title \
		-menu $context.menubar.$k.m -underline 0 \
		-takefocus 0
	    set menu [menu $context.menubar.$k.m -tearoff 0 -postcommand "$cmd $context"]
	    pack $context.menubar.$k -side left
	    foreach name $entries {
		set arg [plotter:argConfigForMenu $context $name]
		localsettings:addEntry $context $menu $name [lindex $arg 0] [lindex $arg 1] \
		    [lindex $arg 2] [lindex $arg 3] [lindex $arg 4] [lindex $arg 5] [lindex $arg 6]
	    }
	    incr k
	}
    } else {
	set id [array startsearch objects]
	while {[array anymore objects $id]} {
	    set el [array nextelement objects $id]
	    set oldObjectsList [concat $oldObjectsList $objects($el)]
	    set objects($el) {} 
	}
	array donesearch objects $id
    }
    
    set toResize {}
    set prevPane ""
    foreach i $display {
	# first deal with the "containers"
	if {[plotter:pathDepth $i] == 2} {
	    # this container is already displayed?
	    if {![plotter:lremove oldPlotters $i]} {
		set plotter:isMapped($i) 0

 		# vertical compression mode
		set plotter:vComp($i) 0

		$context.nb add [plotter:removeDots $i] -label [lindex [lindex $properties($i) 0] 0] \
		    -raisecmd "plotter:menuUpdate $context"
		set p2c([plotter:removeDots $i]) $i
		set master [$context.nb subwidget [plotter:removeDots $i]]
		scrollbar $master.vbar -command "$i yview" 
		canvas $i -yscrollcommand "$master.vbar set"

		bind $context <Up> "plotter:slowScroll $context -1"
		bind $context <Down> "plotter:slowScroll $context 1"
		bind $context <Prior> "plotter:fastScroll $context -1"
		bind $context <Next> "plotter:fastScroll $context 1"

		bind $i <Configure> "plotter:panedResize $i %w %h"
		tixPanedWindow $i.panedw -dynamicgeometry true 

		$i create window 0 0 -window $i.panedw -anchor nw -tags plotter:$i
		toolbar:addToolBar $i $master "-column 0 -row 0 -sticky news -columnspan 2" \
		    "-column 0 -row 4 -sticky news -columnspan 2"

		if {[lindex $properties([lindex $hierarchy($i) 0]) 2] == "time"} {  
		    canvas $master.xaxis -height 32 -relief sunken -borderwidth 1
		    canvas $master.xaxis.x -width 1 -height 32

		    canvas $master.xaxis.display

		    scrollbar $master.hbar -orient horizontal
		    hbar:add $i $master.hbar
		    bind $master.xaxis <Map> "plotter:initDrawXAxis $i %W"
		    
		    grid $master.hbar -column 0 -row 3 -sticky news
		    grid $master.xaxis -column 0 -row 2 -sticky news
		    
		    grid rowconfig $master 3 -weight 0 -minsize 0
		    grid rowconfig    $master 2 -weight 0 -minsize 0
		    
		    set rowspan ""
		    
		    foreach name $fListC {
			toolbar:addButton $i $name "[lindex $fDes($name-1) 0] $i"\
			    [lindex $fDes($name-1) 1] [lindex $fDes($name-1) 2]  \
			    [lindex $fDes($name-1) 3] [lindex $fDes($name-1) 4] 
			
		    }

		    plotter:setMax $i [lindex $properties($i) 3] $tMax($i)
		} else {
		    grid rowconfig $master 3 -weight 1 -minsize 0
		    grid rowconfig    $master 2 -weight 1 -minsize 0
		    set rowspan "-rowspan 3"
		    foreach name $fListH {
			toolbar:addButton $i $name "[lindex $fDes($name-1) 0] $i" \
			    [lindex $fDes($name-1) 1] [lindex $fDes($name-1) 2] \
			    [lindex $fDes($name-1) 3] [lindex $fDes($name-1) 4] 
		    }
		}	

		plotter:initStates $i
		
		eval grid $master.vbar -column 1 -row 1 -sticky news $rowspan
		eval grid $i -column 0 -row 1 -sticky news -in $master $rowspan

		grid rowconfig    $master 0 -weight 0 -minsize 0
		grid rowconfig    $master 4 -weight 0 -minsize 0
		grid rowconfig $master 1 -weight 1 -minsize 0
		
		grid columnconfig $master 0 -weight 1
		grid columnconfig $master 1 -weight 0 -minsize 0
		lappend newPlottersList $i
	    }
	    lappend plotters $i
	    set currentPaneList($i) [$i.panedw panes]
	}
	# then deal with the canvases
	if {[plotter:pathDepth $i] == 3} {
	    if {! [plotter:lremove oldObjectsList $i]} {
		set plotter:isMapped($i) 0
		
		if {$prevPane != ""} {
		    set pos [lsearch -exact $currentPaneList($invertedHierarchy($i)) $prevPane]
		    incr pos
		} else {
		    set pos 0
		}

		set p [$invertedHierarchy($i).panedw add [plotter:removeDots $i] \
			   -at $pos -expand 1] 
		
		canvas $p.canvas -height 250

		pack configure $p.canvas  -fill both -expand yes
		bind $p.canvas <Map> "plotter:initDrawPlot $i %W"

		button $p.canvas.title -relief flat
		set popup [localsettings:addPopUp $i $p.canvas]
		set plotter:mode($i) normal
		
		if {[lindex $properties($i) 2] == "histo" } {
		    TkRequest $i HistoPolling
		    foreach name $fLocalH {
			set arg [plotter:argConfigForMenu $i $name]
			localsettings:addEntry $i $popup $name [lindex $arg 0] [lindex $arg 1] \
			    [lindex $arg 2] [lindex $arg 3] [lindex $arg 4] [lindex $arg 5] [lindex $arg 6]