plotter.tcl

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

	    layout:display $context
	}
    } else {
	if {! [winfo ismapped $context]} {
	    foreach i $plotters {
		foreach j $objects($i) {
		    TkRequest $j ProtoSetDisplay
		}
	    }
	    wm deiconify $context
	}
    }
    # FIXME: for MS windows, the $context widget appears below the main window
    # when the selection is done for the first time (call to layout:display
    # in this procedure). One possible reason may be that layout:display creates
    # a toplevel  widget; when the selection is done the $context widget is deiconified
    # and the layout's toplevel widget is destroyed. This destruction seems to cause
    # a raise.

    raise $context
}

proc plotter:dismiss {context} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    
    plotter:popdown $invertedHierarchy($context)
}

proc plotter:saveSession {context} {
    
    global mainContext
    set context $mainContext

    plotter:setGeometrySession $context [winfo width $context] [winfo height $context]
    plotter:setMainContextSession $context
    plotter:setGraphListSession $context 
    plotter:setPlottersSession $context
    plotter:setGraphSession $context
}

proc plotter:setMainContextSession {context} {
    upvar #0 plotter:autoSaveSession autoSaveSession
    Project:setResource PlotterGlobalConfAutoSaveSession $autoSaveSession
}

proc plotter:getMainContextSession {context} {
    global plotter:autoSaveSession
    set autoSave [Project:getResource PlotterGlobalConfAutoSaveSession]
    if {$autoSave == 1 || $autoSave == 2} {
	set plotter:autoSaveSession $autoSave
    }     
}

proc plotter:setGeometrySession {context w h} {
    if {$w > 1 && $h > 1} {
	Project:setResource PlotterGeometry [list $w $h]
    }
}

proc plotter:getGeometrySession {context} {
    set geometry [Project:getResource PlotterGeometry]
    if {$geometry == ""} {
	set geometry [list 670 720]
    }
    return $geometry
}

proc plotter:setGraphListSession {context} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:plotters plotters
    
    set clist {}
    foreach i $plotters {
	set paneList [$i.panedw panes]
	foreach j $paneList {
	    lappend clist $i [plotter:addDots $j $i]
	}
    }
    
    set graphList {}
    
    foreach {i j} $clist {
	set name [list [lindex $properties($i) 0] [lindex $properties($j) 0]]
	if {([lindex $properties($j) 4] == "") || ([lindex $properties($j) 2] != "time")}  {
	    set key Plotter${name}Compound
	    Project:setResource $key ""
	    lappend graphList $name
	} else {
	    foreach k [lindex $properties($j) 4] {
		set thisName [list [lindex $properties($i) 0] [lindex $properties($k) 0]]
		set key Plotter${thisName}Compound
		Project:setResource $key $name
		lappend graphList $thisName
	    }
	}
    }
    Project:setResource PlotterGraphList $graphList
}

proc plotter:getGraphListSession {context} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    upvar #0 plotter:eltOfCmpd eltOfCmpd
    upvar #0 plotter:eltName2CmpdName eltName2CmpdName
    upvar #0 plotter:cmpdName2Cont cmpdName2Cont
    
    upvar #0 plotter:compound compound
    upvar #0 plotter:color color
    
    
    set graphList [Project:getResource PlotterGraphList]

    if {$graphList == ""} {
	return ""
    }

    set nameList {}
    set id [array startsearch hierarchy]
    while {[array anymore hierarchy $id]} {
	set el [array nextelement hierarchy $id]
	if {[plotter:pathDepth $el] == 3} {
	    set name [list [lindex $properties($invertedHierarchy($el)) 0] \
			  [lindex $properties($el) 0]]
	    set name2Cont($name) $el
	    lappend nameList $name
	}
    }
    array donesearch hierarchy $id
    
    set eltOfCmpd {}
    foreach i $graphList {
	set key Plotter${i}Compound
	set cmpd [Project:getResource $key]
	if {$cmpd != ""} {
	    lappend eltOfCmpd $i
	    set eltName2CmpdName($i) $cmpd 
	    set cmpdName2Cont($cmpd) "" 
	}
    }

    set contList {}
    set parentList {}

    foreach i $graphList {
	if {[lsearch -exact $nameList $i] != -1} {
	    set parent $invertedHierarchy($name2Cont($i))
	    if {[lsearch -exact $eltOfCmpd $i] != -1} {
		set cmpd $eltName2CmpdName($i)
		if {$cmpdName2Cont($cmpd) == ""} {
		    set cmpdName2Cont($cmpd) [TkRequest $parent BuildCompound]
		    lappend compound $cmpdName2Cont($cmpd)
		    set cont $cmpdName2Cont($cmpd)
		    TkRequest $cont AddToCmpd $name2Cont($i)
		    TkRequest $cont SetCompoundTitle [lindex [lindex $cmpd 1] 0]
		    set properties($cont) \
			[TkRequest $cont GetProperties]
		    lappend contList $cont
		    plotter:updateFunctionForCmpd $cont
		} else {
		    TkRequest $cmpdName2Cont($cmpd) AddToCmpd $name2Cont($i)
		    set properties($cmpdName2Cont($cmpd)) \
			[TkRequest $cmpdName2Cont($cmpd) GetProperties]
		    plotter:updateFunctionForCmpd $cmpdName2Cont($cmpd)
		}
	    } else {
		lappend contList $name2Cont($i)
	    }
	    plotter:ladd parentList $parent
	}
    }
    return [concat $parentList $contList]
}

proc plotter:dynamicGraphSession {context newCont} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    upvar #0 plotter:eltOfCmpd eltOfCmpd
    upvar #0 plotter:eltName2CmpdName eltName2CmpdName
    upvar #0 plotter:cmpdName2Cont cmpdName2Cont

    upvar #0 plotter:color color
    upvar #0 plotter:compound compound

    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects 
    
    if {! [info exists eltOfCmpd]} {
	return
    }
    
    set parent $invertedHierarchy($newCont)
    set name [list [lindex $properties($parent) 0] [lindex $properties($newCont) 0]]

    if {[lsearch -exact $eltOfCmpd $name] != -1} {
	set cmpd $eltName2CmpdName($name)
	if {$cmpdName2Cont($cmpd) == ""} {
	    set cmpdName2Cont($cmpd) [TkRequest $parent BuildCompound]
	    lappend compound $cmpdName2Cont($cmpd)
	    set cont $cmpdName2Cont($cmpd)
	    TkRequest $cont AddToCmpd $newCont
	    TkRequest $cont SetCompoundTitle [lindex [lindex $cmpd 1] 0]
	    set properties($cont) \
		[TkRequest $cont GetProperties]
	    plotter:updateFunctionForCmpd $cont
	    
	    set parentList {}
	    set cList {}
	    foreach i $plotters {
		lappend parentList $i
		foreach j $objects($i) {
		    lappend cList $j
		}
	    }
	    lappend cList $cont
	    plotter:ladd parentList $parent
	    plotter:display $context [concat $parentList $cList]
	} else {
	    if {[lsearch -exact $compound $cmpdName2Cont($cmpd)] != -1} {
		TkRequest $newCont FakeSetDisplay
		TkRequest $cmpdName2Cont($cmpd) AddToCmpd $newCont
		set properties($cmpdName2Cont($cmpd)) \
		    [TkRequest $cmpdName2Cont($cmpd) GetProperties]
		plotter:updateFunctionForCmpd $cmpdName2Cont($cmpd)
	    }
	}
    }
}

proc plotter:setPlottersSession {context} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:tMin tMin
    upvar #0 plotter:tMax tMax
    global mainContext
    
    set plotterList {}

    foreach i $hierarchy($mainContext) {
	set name [lindex $properties($i) 0]
	set el [lindex $hierarchy($i) 0]
	if {[lindex $properties($el) 2] == "time"} {
	    set key Plotter${name}TimeBounds
	    Project:setResource $key [list $tMin($i) $tMax($i)]
	    set key Plotter${name}GlobalConfiguration
	    upvar #0 hbar:linked linked \
		plotter:colorAuto colorAuto
	    set confList [list [TkRequest $i GetConf] $linked($i) $colorAuto($i)]
	    Project:setResource $key $confList
	}
    }
}

proc plotter:getPlottersSession {context newCont} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:tMin tMin
    upvar #0 plotter:tMax tMax
    upvar #0 plotter:hierarchy hierarchy
    
    set name [lindex $properties($newCont) 0]
    set key Plotter${name}TimeBounds
    
    set timeBounds [Project:getResource $key]
    if {$timeBounds != ""} {
	if {[lindex $properties($newCont) 1] == "time"} {
	    set tMax($newCont) [expr $tMin($newCont) + [lindex $timeBounds 1] - [lindex $timeBounds 0]]
	}
    }

    set key Plotter${name}GlobalConfiguration
    set confList [Project:getResource $key]
    if {[lindex $properties($newCont) 1] == "time"} {
	upvar #0 hbar:linked linked \
	    plotter:colorAuto colorAuto
	if {$confList != ""} {
	    set linked($newCont) [lindex $confList 1]
	    set colorAuto($newCont) [lindex $confList 2]
	    TkRequest $newCont SetConf [lindex $confList 0]
	    if {[lindex $confList 0]} {
		upvar #0 plotter:plotterState state
		set state($newCont,compress) 1
	    }
	} else {
	    set linked($newCont) 0
	    set colorAuto($newCont) 1
	}
    }
}

proc plotter:setGraphSession {context} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:hierarchy hierarchy
    upvar #0 plotter:color color
    global mainContext
    
    foreach i $hierarchy($mainContext) {
	foreach j $hierarchy($i) {
	    # ignore compounds
	    if {([lindex $properties($j) 4] == "") || ([lindex $properties($j) 2] != "time")}  {
		set name [list [lindex $properties($i) 0] [lindex $properties($j) 0]]
		# color
		set key Plotter${name}Color
		Project:setResource $key $color($j)

		# breakpoints 
		set key Plotter${name}Breakpoints
		Project:setResource $key [TkRequest $j GetBreakpointList]
		
		#local conf
		set confList [TkRequest $j GetConf]
		set key Plotter${name}LocalConfiguration
		Project:setResource $key $confList
	    }
	}
    }
}

proc plotter:getGraphSession {context newCont} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    upvar #0 plotter:color color    

    set name [list [lindex $properties($invertedHierarchy($newCont)) 0] \
		  [lindex $properties($newCont) 0]]
    set key Plotter${name}Color
    
    set thisColor [Project:getResource $key]
    
    if {$thisColor != ""} {
	set color($newCont) $thisColor
    } else {
	set color($newCont) #000080
    }

    set key Plotter${name}Breakpoints
    set breakList [Project:getResource $key]
    foreach i $breakList {
	set list [TkRequest $newCont SetBreakpoint $i]
    }

    set key Plotter${name}LocalConfiguration
    set confList [Project:getResource $key]
    if {$confList != ""} {
	eval TkRequest $newCont SetConf $confList    
    }
}

proc plotter:popdown {context} {
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects 
    
    wm withdraw $context

    pushEvent Application:event PlotterHiddenEvent
    foreach i $plotters {
	foreach j $objects($i) {
	    TkRequest $j ProtoSetTempConceal
	}
    }
}

proc plotter:destroy {context} {
    # perform cleanup actions here
    upvar #0 plotter:plotters plotters
    upvar #0 plotter:objects objects 
    upvar #0 plotter:hierarchy hierarchy

    set objectsToDestroy {}
    foreach i $plotters {
	foreach j $objects($i) {
	    lappend objectsToDestroy $j
	}
    }
    
    plotter:cleanUp $context $objectsToDestroy $plotters

    catch "unset objects"
    catch "unset hierarchy"

    global plotter:started
    if {[info exists plotter:started]} {
	unset plotter:started
    }

    global plotter:tCur
    if {[info exists plotter:tCur]} {
	unset plotter:tCur
    }
    
    destroy $context
    font delete plotter:axis \
	plotter:vAxis \
	plotter:vAxisComp
}

# TODO: heavy, very heavy...
proc plotter:setDisplayedContext {context contextList} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    set display $contextList
    # adds the parent contexts
    foreach i $contextList {
	if {[lsearch -exact $display $invertedHierarchy($i)] == -1} {
	    if {$invertedHierarchy($i) != ""} {
		set display [linsert $display 0 $invertedHierarchy($i)]
	    }
	}
    }

    if {[lsearch -exact $display $context] == -1 && $display != ""} {
	set display [linsert $display 0 $context]
    }

    return $display
}