plotter.tcl

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

    return $result
}

proc layout:onOk {context cmd} {
    global mainContext
    upvar #0 layout:displayed displayed
    plotter:startIsBusy $mainContext

    set displayed [eval $cmd]
    set displayed [layout:modifiedHierarchyCleanUp $displayed]
    plotter:display $context [plotter:setDisplayedContext $context $displayed]
    destroy $context.layout
    plotter:stopIsBusy $mainContext

    if {[TkRequest $mainContext GetBackendState] == "running"} {
	plotter:simRunning $context
    }
}

proc plotter:menuHack {context} {
    if {[plotter:pathDepth $context] == 1} {
	return [plotter:getVisiblePlotter $context]
    } else {
	return $context
    }
}

proc layout:display {context} {
    global mainContext
    upvar #0 layout:displayed displayed

    if { [winfo exists $mainContext.layout]} {
	wm deiconify $mainContext.layout
	raise $mainContext.layout
	return;
    }
    
    if {![info exists displayed]} {
	set displayed {}
    }

    set layout [toplevel $mainContext.layout]
    wm title $layout "Graph Selector"
    bind $layout <Escape> "destroy  $layout"
    cascadeWindow $layout
    
    plotter:sortContext $mainContext
    layout:buildModifiedHierarchy $mainContext
    set item [layout:buildChklistArg $mainContext contextList]
    set myDisplayed [layout:buildDisplayedList]

    set chk $layout.chk
    tixCheckList $chk -scrollbar auto \
	-options {hlist.indicator 1} -width 350 -height 450
    chklist:addInHList $item $chk "" $contextList $myDisplayed
    $chk config -browsecmd "chklist:selectAll $chk"
    $chk config -command "chklist:selectAll $chk"
    $chk autosetmode
    focus [$chk subwidget hlist]
    pack $chk -fill both -expand yes

    set box [tixButtonBox $layout.box -relief flat -bd 0]
    set cmd "chklist:getSelection $chk"
    $box add ok -text OK -command "layout:onOk $mainContext \"$cmd\"" -width 6
    $box add cancel -text Cancel -command "destroy $layout"
    pack $box -fill x -expand no
}

proc layout:buildDisplayedList {} {
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects     
    
    set list {}
    foreach i $plotters {
	foreach j $objects($i) {
	    lappend list $j
	}
    }
    return $list
}

# *** FIXME ***
# this doesn't work.
proc plotter:pixel2point {pixel} {
    set point2pixel [tk scaling]
    
    set point [expr $pixel / $point2pixel]
    return [expr round($point)] 
}

proc plotter:point2pixel {points} {
    set pixelsPerPoint [tk scaling]
    return [expr $points * $pixelsPerPoint]
}

proc plotter:initFont {} {
    if {[lsearch -exact [font names] "plotter:axis"] == -1} {
	# regular font for axises
	eval font create plotter:axis [font actual -*-helvetica-medium-r-normal--8-*-*-*-*-*-*-*]
    }
    if {[lsearch -exact [font names] "plotter:vAxisComp"] == -1} {
	# font used when the display is vertically compressed
	eval font create plotter:vAxisComp [font actual -*-helvetica-medium-r-normal--8-*-*-*-*-*-*-*]
    }
    if {[lsearch -exact [font names] "plotter:vAxis"] == -1} {
	# font used for vertical axis text (starts as a copy of plotter:axis)
	eval font create plotter:vAxis [font configure plotter:axis]
    }
}

# a descritpion of what the toolbars/menus must contain
proc plotter:initFunction {} {
    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:functionnalitiesLocalCMPD fLocalCMPD
    upvar #0 plotter:functionnalitiesDescription fDes
    upvar #0 plotter:mainMenu mainMenu

    # a list of the ids of the functionnalities (ie buttons or fields in a menu)
    set fListC [list displayed printAll compress zoomIn zoomOut session vcompress \
		    globalBreak simCont simStop]
    set fListH [list displayed printAll histoPoll session vcompress] 
    set fLocalTG [list modeTime color printOnePlot seek localTimeG remove]
    set fLocalTS [list modeTime color printOnePlot seek remove]
    set fLocalH [list color histoDisplay histoView printOnePlot localHisto remove]
    set fLocalCMPD [list modeTime multiPlotColor multiPlotContext seek localCMPD]
    set mainMenu [list {"File" {mdisplayed mprintAll msession msep mquit} plotter:noop} \
		      {"View" {mhistoPoll msep mcompress mzoomIn mzoomOut mvcompress msep mglobalBreak} \
			   plotter:preProcessCurrentState} \
		      {"Options" {mxadjust mscrollLock mcolorChoice mautoSession} plotter:getGlobalTConf}]
    
    # and an array giving a description of the functionnalities (to be used to build a
    # toolbar or a menu): the command to call, a help message, an icon bitmap (a file), the state 
    # Of the field and possibly additionnal informations for menus
    set fDes(displayed-1) [list layout:display {"Select" "Select graphs to display"} select normal left]
    set fDes(compress-1) [list plotter:compress {"X-compress" "Compress time scale"} compress normal left]
    set fDes(compress-2) [list plotter:uncompress {"X-uncompress" "Uncompress time scale"} uncompress normal left]
    set fDes(vcompress-1) [list plotter:verticalCompress {"Y-compress" "Pack graphs vertically"}  ycompress normal left]
    set fDes(vcompress-2) [list plotter:verticalUncompress {"Y-uncompress" "Unpack graphs vertically"} yuncompress normal left]
    set fDes(vcompress-3) [list plotter:noop {"Y-compress" "Pack graphs vertically"} ycompress disabled left]
    set fDes(zoomIn-2) [list plotter:zoomIn {"Zoom in" "Zoom in 200%%"} zoomin normal left]
    set fDes(zoomIn-1) [list plotter:zoomIn {"Zoom in" "Zoom in 200%%"} zoomin disabled left]
    set fDes(zoomOut-2) [list plotter:zoomOut {"Zoom out" "Zoom out 50%%"} zoomout normal left]
    set fDes(zoomOut-1) [list plotter:zoomOut {"Zoom out" "Zoom out 50%%"} zoomout disabled left]
    set fDes(histoPoll-1) [list plotter:histoPoll {"Update" "Actualize histograms"} update normal left]
    set fDes(printAll-1) [list plotter:printAll {"Print" "Print all graphs"} print normal left]
    set fDes(simCont-1) [list plotter:simCont {"Continue" "Continue execution"} cont normal right]
    set fDes(simStop-1) [list plotter:simStop {"Stop" "Suspend execution"} break disabled right]
    set fDes(simCont-2) [list plotter:simCont {"Continue" "Resume execution"} cont disabled right]
    set fDes(simStop-2) [list plotter:simStop {"Stop" "Suspend execution"} break normal right]
    set fDes(session-1) [list plotter:saveSession {"Save" "Save current session"} save normal left]
    set fDes(globalBreak-1) [list plotter:globalBreakpointStart {"Breakpoints" "Edit breakpoints"} plotbrk normal left]

    set fDes(mquit-1) [list plotter:dismiss "Close" "" normal command \
			   {-underline 0}]
    set fDes(mdisplayed-1) [list layout:display "Select" "" normal command \
				"-underline 0"]
    set fDes(mcompress-1) [list plotter:compress "X-compress" "" normal command \
			       "-underline 0"]
    set fDes(mcompress-2) [list plotter:uncompress "X-uncompress" "" normal command \
			      "-underline 0"]
    set fDes(mcompress-3) [list plotter:uncompress "X-uncompress" "" disabled command \
			       "-underline 0"]
    set fDes(mvcompress-1) [list plotter:verticalCompress "Y-compress" "" normal command \
				"-underline 0"]
    set fDes(mvcompress-2) [list plotter:verticalUncompress "Y-uncompress" "" normal command \
				"-underline 0"]
    set fDes(mvcompress-3) [list plotter:noop "Y-compress" "" disabled command \
				"-underline 0"]
    set fDes(mzoomIn-2) [list plotter:zoomIn "Zoom In 200%" "" normal command \
			    "-underline 5"]
    set fDes(mzoomIn-1) [list plotter:zoomIn "Zoom In 200%" "" disabled command \
			    "-underline 5"]
    set fDes(mzoomOut-2) [list plotter:zoomOut "Zoom Out 50%" "" normal command \
			     "-underline 5"]
    set fDes(mzoomOut-1) [list plotter:zoomOut "Zoom Out 50%" "" disabled command \
			     "-underline 5"]
    set fDes(mhistoPoll-1) [list plotter:histoPoll "Update" "" disabled command \
			       "-underline 0"]
    set fDes(mhistoPoll-2) [list plotter:histoPoll "Update" "" normal command \
			       "-underline 0"]
    set fDes(mprintAll-1) [list plotter:printAll "Print" "" normal command \
			      "-underline 0" ]
    set fDes(msession-1) [list plotter:saveSession "Save" "" normal command \
			     "-underline 0"]
    set fDes(mxadjust-1) [list "plotter:setGlobalTConf xadjust" "X-adjust" "" normal checkbutton \
					 {-onvalue 1  -variable mainMenu:xadjust}]
    set fDes(mscrollLock-1) [list "plotter:setGlobalTConf linked" "Scroll lock" "" normal checkbutton \
					 {-onvalue 1  -variable mainMenu:linked}]
    set fDes(mcolorChoice-1) [list "plotter:setGlobalTConf colorAuto"  "Auto-select color" "" normal checkbutton \
					 {-onvalue 1  -variable mainMenu:colorAuto}]
    set fDes(mxadjust-2) [list plotter:noop "X adjust" "" disabled checkbutton \
					 {-onvalue 1  -variable mainMenu:xadjust}]
    set fDes(mscrollLock-2) [list plotter:noop  "Scroll lock" "" disabled checkbutton \
					 {-onvalue 1  -variable mainMenu:linked}]
    set fDes(mcolorChoice-2) [list plotter:noop "Auto-select color" "" disabled checkbutton \
					 {-onvalue 1  -variable mainMenu:colorAuto}]
    set fDes(mautoSession-1) [list "plotter:setGlobalTConf autoSaveSession"  \
				  "Auto-save session" "" normal checkbutton \
				  {-onvalue 1  -variable mainMenu:autoSaveSession}]
    set fDes(mglobalBreak-1) [list plotter:globalBreakpointStart "Breakpoints" \
				  "" normal command "-underline 0"]
    set fDes(mglobalBreak-2) [list plotter:noop "Breakpoints" \
				  "" disabled command "-underline 0"]
    set fDes(msep-1) [list plotter:noop "" "" normal separator]

    # procedure to call, menu entry label, "" (no icon), state, type 
    # optionnal arg 1: additionnal arguments for the menu entry (as expected by tcl)
    # optionnal arg 2: for a cascade, the list of the children menu entry
    set fDes(modeTime-1) [list plotter:noop "Mode" "" normal cascade "" {modeNormal modeSelection modeBreakpts}]
    set fDes(modeHisto-1) [list plotter:noop "Mode" "" normal cascade "" {modeNormal modeSelection}]
    set fDes(modeNormal-1) [list plotter:modeNormal "Normal" "" normal radiobutton \
				{-value normal -variable plotter:mode($context)}]
    set fDes(modeSelection-1) [list selection:beforeDrag "Selection" "" normal radiobutton \
				   {-value sel  -variable plotter:mode($context)}]
    set fDes(modeBreakpts-1) [list breakpoint:beforeDrag "Breakpoint" "" normal radiobutton \
				  {-value break -variable plotter:mode($context)}]
    set fDes(color-1) [list plotter:setPlotColor "Colors" "" normal command]
    set fDes(poll-1) [list plotter:localHistoPoll  "Poll" "" normal command]

    set fDes(histoDisplay-1) [list plotter:noop  "Display" "" normal cascade "" \
				  {histoDisplayDensity histoDisplayRep}]
    set fDes(histoDisplayDensity-1) [list plotter:setHistoDisplay "Density" "" normal radiobutton \
					 {-value density -variable plotter:histoDisplay($context)}]
    set fDes(histoDisplayRep-1) [list plotter:setHistoDisplay "Repartition" "" normal radiobutton \
					 {-value rep -variable plotter:histoDisplay($context)}]

    set fDes(histoView-1) [list plotter:noop  "View" "" normal cascade "" \
			       {histoViewRel histoViewAbs}]
    set fDes(histoViewRel-1) [list plotter:setHistoView "Relative" "" normal radiobutton \
				  {-value rel -variable plotter:histoView($context)}]
    set fDes(histoViewAbs-1) [list plotter:setHistoView "Absolute" "" normal radiobutton \
				  {-value abs -variable plotter:histoView($context)}]
    set fDes(printOnePlot-1) [list plotter:printThis  "Print" "" normal command]
    set fDes(localTimeG-1) [list plotter:localTimeMenu "Advanced" "" normal command]
    set fDes(localHisto-1) [list plotter:localHistoMenu "Advanced" "" normal command]

    set fDes(seek-2) [list plotter:noop "Seek" "" disabled cascade "" {seekFw seekBw}]
    set fDes(seek-1) [list plotter:noop "Seek" "" normal cascade "" {seekFw seekBw}]
    set fDes(seekBw-1) [list plotter:seekBw "Backward" "" normal command]
    set fDes(seekFw-1) [list plotter:seekFw "Forward" "" normal command]
    set fDes(remove-1) [list plotter:removeThisGraph "Remove" "" normal command]
}

proc plotter:setHierarchy {context masterContext} {
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    if {$masterContext != ""} {
	if {[info exists hierarchy($masterContext)] == 1} {
	    if {[lsearch -exact [set hierarchy($masterContext)] $context] != -1} {
		return
	    }
	}
	lappend hierarchy($masterContext) $context
    }

    set invertedHierarchy($context) $masterContext

    if {[array names hierarchy $context] == ""} {
	set hierarchy($context) {}
    }

    if {[array names invertedHierarchy $masterContext] == "" } {
	if {$masterContext != ""} {
	    set invertedHierarchy($masterContext) ""
	}
    }

    global mainContext
    upvar #0 plotter:properties properties    
    set properties($context) [TkRequest $context GetProperties]

    if {[plotter:pathDepth $context] == 3} {
	plotter:getGraphSession $mainContext $context
	plotter:dynamicGraphSession $mainContext $context
    } else {
	if {[plotter:pathDepth $context] == 2} {
	    plotter:getPlottersSession $mainContext $context
	}
    }
}

proc plotter:unSetHierarchy {context masterContext} {
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    if {[info exists hierarchy($masterContext)]} {
	plotter:lremove hierarchy($masterContext) $context
    }
    if {[info exists hierarchy($context)]} {
	unset hierarchy($context)
    }
}

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

    set properties($context) [TkRequest $context GetProperties]
    
    foreach i $hierarchy($context) {
	plotter:setProperties $i
    }
}

proc plotter:unmap {w} {
    upvar #0 plotter:toplevels toplevels
    global mainContext
    foreach i $toplevels {
	wm withdraw $i
    }
}

proc plotter:map {w} {
    upvar #0 plotter:toplevels toplevels
    global mainContext
    foreach i $toplevels {
	wm deiconify $i
    }
}

proc plotter:addTopLevel {w} {
    upvar #0 plotter:toplevels toplevels
    global mainContext
    if {[plotter:isInApp $w] && $mainContext != $w} {
	plotter:ladd toplevels $w
    }
}

proc plotter:rmTopLevel {w} {
    upvar #0 plotter:toplevels toplevels
    global mainContext
    if {[plotter:isInApp $w] && $mainContext != $w} {
	plotter:lremove toplevels $w
    }
}

proc plotter:isInApp {w} {
    global mainContext
    regexp {(\.[^/.]+)(\.[^/.]+)*} $w dummy simpleName
    if {$mainContext == $simpleName} {
	return 1
    }
    return 0
}

proc plotter:initialize {context title toolname} {
    global mainContext
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects
    upvar #0 plotter:compound compound
    upvar #0 plotter:compressDone compressDone

    plotter:initFont
    plotter:initFunction
    
    set mainContext $context
    set plotters {}
    set compound {}
    # Tell Tcl that plotter:objects is an array variable
    set objects(0) {}
    unset objects(0)
    
    upvar #0 plotter:toplevels toplevels
    set toplevels {} 
    toplevel $context
    bind Toplevel <Map> "+ plotter:addTopLevel %W"
    bind Toplevel <Destroy> "+ plotter:rmTopLevel %W"
    bind $context <Unmap> "+ plotter:unmap %W"
    bind $context <Map> "+ plotter:map %W"
        
    if {$title != {}} {
	wm title $context $title
    }
    wm withdraw $context

    wm protocol $context WM_DELETE_WINDOW \
	"plotter:popdown $context"

    plotter:setPrecision 3
    upvar #0 plotter:isInConf isInConf
    # allow only one configuration at a time
    set isInConf 0
    set compressDone 0
    
    global tcl_precision
    set tcl_precision 17

    if {$toolname != {}} {
	global plotter:toolname
	set plotter:toolname $toolname
    }
}

proc plotter:popup {context} {
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects     

    if {[plotter:lempty $plotters]} {
	set todisplay ""
	global plotter:started plotter:reloaded
	if {! [info exists plotter:started]} {
	    set todisplay [plotter:getGraphListSession $context]
	    if {$todisplay != {}} {
		set plotter:reloaded true
	    } {
		set plotter:reloaded false
	    }
	    plotter:getMainContextSession $context
	}
	if {$todisplay != ""} {
	    plotter:display $context $todisplay
	} else {