plotter.tcl

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

		    }

		    set plotter:histoDisplay($i) [lindex $properties($i) 3]
		    set plotter:histoView($i) [lindex $properties($i) 4]

		    set img [fetchImage histo]

		} else {
		    if { ![plotter:lempty [lindex $properties($i) 4]] } {
			set local $fLocalCMPD
			if {[lindex $properties($i) 1] == "state"} {
			    set img [fetchImage sdiagrams]
			} else {
			    set img [fetchImage tgraphes]
			}
		    } else {
			if {[lindex $properties($i) 1] == "float" } {
			    set local $fLocalTG
			    set img [fetchImage tgraph]
			} else {
			    set local $fLocalTS
			    set img [fetchImage sdiagram]
			}	
		    }	 
		    foreach name $local {
			set arg [plotter:argConfigForMenu $i $name]
			if {[string length $arg] != 0} {
			    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]
			}
		    }
		}

		set title [makeCompoundImage [plotter:titleFormat $i] $img]
		$p.canvas.title configure -image $title
		lappend newObjectsList $i
		
		set currentPaneList($invertedHierarchy($i)) \
		    [$invertedHierarchy($i).panedw panes]
	    }
    
	    plotter:ladd toResize $invertedHierarchy($i)
	    lappend objects($invertedHierarchy($i)) $i

	    set prevPane [plotter:removeDots $i]
	}
    }

    upvar #0 selection:fastContext fastContext \
	selection:fastStarted fastStarted

    if {[info exists fastStarted]} {
	if {$fastStarted} {
	    if {[lsearch -exact $oldObjectsList $fastContext] != -1} {
		selection:fastStop $fastContext \
		    [plotter:getWidgetFromContext $fastContext localCanvas]
	    }
	}
    }
    
    
    # remove all the widgets that shouldn't be displayed anymore
    # you'd better do the clean up by yourself and not let tix handle the 
    # destruction of all the children widgets.
    plotter:cleanUp $context $oldObjectsList $oldPlotters

    upvar #0 plotter:compound compound
    foreach i $oldObjectsList {
	set plotter:isMapped($i) 0
	if {[lindex $properties($i) 2] != "histo"} {
	    TkRequest $i ProtoSetConceal
	    if {[lsearch -exact $compound $i] != -1} {
		plotter:lremove compound $i
	    }
	}
    }

    foreach i $newObjectsList {
	if {[lindex $properties($i) 2] != "histo"} {
	    TkRequest $i ProtoSetDisplay
	}
    }
    foreach i $plotters {
	foreach j $objects($i) {
	    TkRequest $j ForceSetDisplay
	}
    }

    foreach i $oldPlotters {
	set plotter:isMapped($i) 0
    }
	    
    foreach i $newPlottersList {
	if {[lindex $properties($i) 2] == "time"} {
	    plotter:setMax $i [TkRequest $i SetCurrentTime] $tMax($i)
	}
    }
    
    # make sure all the canvases are visible
    while {![plotter:lempty $toResize]} { 
	set c [FIFOget toResize]

	if {! [winfo ismapped $c]} {
	    bind $c <Map> "plotter:panedSetSizeWhenMapped $c"
	} else {
	    plotter:panedSetSizeWhenMapped $c
	}
    }	    
    
    if {[llength $oldPlotters] == 0} {
	wm deiconify $context
    }

    if {[plotter:lempty $display]} {
	global plotter:reloaded
	if {${plotter:reloaded} == "true"} {
	    # perhaps the user wants to discard the currently saved
	    # session -- we should ask him now because he will not
	    # be able to do it after we have popped the plotter down
	    # (unless using the auto-save mode, but this is a non-obvious
	    # trick)
	    set answer [tk_messageBox -parent $context \
			    -message "Do you want to discard the previously saved session information?" \
			    -type yesno -icon warning -title Warning]
	    if {$answer == "yes"} {
		plotter:saveSession $context
	    }
	}
	plotter:popdown $context
    }

    # useful only to see the windows before the points are added. 
    # Can be removed (it speeds up the treatment)
    #update
    global plotter:readyForPoints
    set plotter:readyForPoints 1

}

proc plotter:cleanUp {context objects plotters} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    
    foreach i $objects {
	destroy [$invertedHierarchy($i).panedw subwidget [plotter:removeDots $i]].canvas
	$invertedHierarchy($i).panedw delete [plotter:removeDots $i] 
    }
    foreach i $plotters { 
	set master [$context.nb subwidget [plotter:removeDots $i]] 
	destroy $i 
	destroy $master.vbar 
	destroy $master.hbar 
	toolbar:destroy $master 
	$context.nb delete [plotter:removeDots $i] 
    }
}

proc plotter:initDrawPlot {context canvas} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    upvar #0 plotter:color color

    panesdragndrop:init $context $canvas
    reticle:init $context $canvas
    selection:init $context $canvas
    breakpoint:init $context $canvas

    global mainContext 
    bind $canvas <ButtonPress-2> \
	"selection:end $context $canvas ; selection:fastStop $context $canvas ; breakpoint:end $context $canvas"
    bind $mainContext <Escape> \
	"selection:end $context $canvas ; selection:fastStop $context $canvas ; breakpoint:end $context $canvas"
    
    bind $canvas <Map> ""
    bind $canvas <Configure> "plotter:reDrawPlot $context %W"

    global plotter:isMapped
    set plotter:isMapped($context) 1
    
    plotter:drawPlot $context $canvas {}
    hbar:linkToCanvas $context $canvas

    set width [winfo width $canvas]
    set height [winfo height $canvas]
    $canvas create window [expr $width / 2] [expr $height - 5] -window $canvas.title \
	-anchor s -tags $context:title 

    breakpoint:initAll $context $canvas
}

proc plotter:reDrawPlot {context canvas} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy

    $canvas delete $context:all
    plotter:drawPlot $context $canvas {}
    breakpoint:updateAll $context $canvas
    selection:updateAll $context $canvas
    set width [winfo width $canvas]
    set height [winfo height $canvas]
    $canvas coords $context:dnd $width 0
    $canvas coords $context:title [expr $width / 2] [expr $height - 5]
}

proc plotter:reDrawPlotWithPts {context pointsList} {
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    
    if {[plotter:lempty $pointsList]} {
	return
    }

    set canvas [$invertedHierarchy($context).panedw subwidget [plotter:removeDots $context]].canvas
    $canvas delete $context:all
    plotter:drawPlot $context $canvas $pointsList
    set width [winfo width $canvas]
    $canvas coords $context:dnd $width 0
}

proc plotter:drawPlot {context canvas pointsList} {
    global plotter:isMapped
    
    if {![set plotter:isMapped($context)]} {
	return
    }

    upvar #0 plotter:invertedHierarchy invertedHierarchy
    upvar #0 plotter:leftb leftb
    upvar #0 plotter:rightb rightb
    upvar #0 plotter:topb topb 
    upvar #0 plotter:bottomb bottomb
    upvar #0 plotter:properties properties
    upvar #0 plotter:color color
    upvar #0 plotter:xleft xleft
    upvar #0 plotter:xright xright
    upvar #0 plotter:roundedXMax roundedXMax
    upvar #0 plotter:axisColor axisColor
    
    set width [winfo width $canvas]
    set height [winfo height $canvas]

    set xmax [expr $width - ($rightb + $leftb)]
    set ymax [expr $height - ($bottomb + $topb)]

    # if pointsList is empty request the points
    if {[plotter:lempty $pointsList]} {
	set pointsList [TkRequest $context GetPointsToDisplay $xmax $ymax $leftb $topb]
    }

    set xleft($context) 0
    set xright($context) 0
    if {[llength $pointsList] > 0} {
	if {[lindex $properties($context) 2] == "histo"} {
	    set xleft($context) [FIFOget pointsList]
	    set xright($context) [FIFOget pointsList]
	    if {[llength $pointsList] > 1} {
		eval $canvas create polygon $pointsList \
		    -tags \[list $context:all $context:plot\] \
		    -fill $color($context) -outline $color($context)
	    }
	} else {
	    if {[plotter:lempty [lindex $properties($context) 4]]} {
		set pointsList [lindex $pointsList 0]
		foreach {x0 y0 x1 y1} $pointsList {
		    $canvas create line $x0 $y0 $x1 $y1 -tags [list $context:all $context:plot] \
			-fill $color($context) 
		}
	    } else {
		set cList [lindex $properties($context) 4]
		if {[llength $cList] != [llength $pointsList]} {
		    set pointsList [TkRequest $context GetPointsToDisplay $xmax $ymax $leftb $topb]
		}
		foreach plot $pointsList {
		    set cont [FIFOget cList]
		    if {[llength $plot] > 0} {
			foreach {x0 y0 x1 y1} $plot {
			    $canvas create line $x0 $y0 $x1 $y1 -tags [list $context:all $cont:plot] \
				-fill $color($cont) 
			}
		    }
		}
	    }
	}
    }

    # axis
    $canvas create line [expr $leftb + $xleft($context)] [expr $topb + $ymax] \
	[expr $leftb + $xleft($context)] \
	[expr $topb - 15] -arrow last -tags $context:all -width 3 -fill $axisColor
    $canvas create line [expr $xleft($context) + $leftb] [expr $topb + $ymax - 1] \
	[expr $roundedXMax($context) + $leftb - $xright($context)] \
	[expr $topb + $ymax - 1] -tags $context:all -width 3 -fill $axisColor

    $canvas create line [expr $roundedXMax($context) + $leftb - $xright($context)] \
	[expr $topb + $ymax - 1] [expr $width - 10 - $xright($context) ] \
	[expr $topb + $ymax - 1] -tags $context:all -width 3 -arrow last \
	-stipple gray50 -fill $axisColor

    set yAxisInfo [TkRequest $context GetYAxisInfo]
    foreach {name y} $yAxisInfo {
	$canvas create text [expr $leftb - 4 + $xleft($context)] $y -text $name\
	    -tags [list $context:all $context:yaxis]\
	    -font plotter:vAxis -anchor e \
	    -fill $axisColor
    }

    if {[lindex $properties($context) 2] == "histo"} {
	set xAxisInfo [TkRequest $context GetXAxisHisto]
	$canvas create text [expr $leftb + $xleft($context)] \
	    [expr $height - $bottomb + 7] \
	    -text [lindex $xAxisInfo 0] \
	    -tags $context:all -font plotter:axis -anchor nw \
	    -fill $axisColor
	$canvas create text [expr $width - $rightb - $xright($context)] \
	    [expr $height - $bottomb + 7] \
	    -text [lindex $xAxisInfo 1] \
	    -tags $context:all -font plotter:axis -anchor ne \
	    -fill $axisColor
    }

}

proc plotter:addToPlot {context pointsList args} {
    global plotter:isMapped
    if {![set plotter:isMapped($context)]} {
	return
    }

    if {[plotter:lempty $pointsList]} {
	return
    }

    upvar #0 plotter:properties properties
    upvar #0 plotter:invertedHierarchy invertedHierarchy
    upvar #0 plotter:color color

    set canvas [$invertedHierarchy($context).panedw subwidget [plotter:removeDots $context]].canvas

    if {[lindex $properties($context) 2] == "histo"} {
	eval $canvas create polygon $pointsList -tags \[list $context:all $context:plot\] \
	    -outline $color($context)
    } else {
	if {[plotter:lempty [lindex $properties($context) 4]]} {
	    foreach {x0 y0 x1 y1} $pointsList {
		$canvas create line $x0 $y0 $x1 $y1 -tags [list $context:all $context:plot] \
		    -fill $color($context) 
	    }
	} else {
	    set cont [lindex $args 0]
	    foreach {x0 y0 x1 y1} $pointsList {
		$canvas create line $x0 $y0 $x1 $y1 -tags [list $context:all $cont:plot] \
		    -fill $color($cont) 
	    }
	}

    }
}

proc plotter:initDrawXAxis {context canvas} {
    upvar #0 plotter:properties properties
    upvar #0 plotter:leftb leftb
    upvar #0 plotter:rightb rightb
    upvar #0 plotter:tMaxDisplay tMaxDisplay  
    upvar #0 plotter:tMin tMin
    upvar #0 plotter:tMax tMax \
	plotter:axisColor axisColor

    #make sure that canvases are mapped
    update idletasks 

    $canvas create window $leftb 3 -window $canvas.x -anchor nw -tags $context:axis \
	-width [expr [winfo width $canvas] - $leftb - $rightb] \
	-height [expr [winfo height $canvas] - 6]

    $canvas create window $leftb 3 -window $canvas.display -anchor nw -tags $context:displayAxis \
	-width [expr [winfo width $canvas] - $leftb - $rightb] \
	-height [expr [winfo height $canvas] - 6]

    update idletasks 

    bind $canvas <Map> ""
    bind $canvas <Configure> "plotter:reDrawXAxis $context %W 1"

    global plotter:isMapped
    set plotter:isMapped($context) 1

    $canvas.display create line 0 14 [expr [winfo width $canvas] - $leftb - $rightb] 14 \
	-tags [list $context:xaxis $context:xaxisLine]  -width 3 -fill $axisColor

    plotter:drawXAxis $context $canvas 0 \
	[expr 1 - (($tMax($context) - $tMin($context)) / $tMaxDisplay($context))]
}

proc plotter:reDrawXAxis {context canvas isResize} {

    upvar #0 plotter:leftb leftb \
	plotter:rightb rightb \
	plotter:tMin tMin \
	plotter:tMaxDisplay tMaxDisplay \
	plotter:axisColor axisColor

    $canvas.display delete $context:xaxis

    $canvas itemconfigure $context:displayAxis -width [expr [winfo width $canvas] - $leftb - $rightb]
    raise $canvas.display $canvas.x

    $canvas.display create line 0 14 [expr [winfo width $canvas] - $leftb - $rightb] 14 \
	-tags [list $context:xaxis $context:xaxisLine]  -width 3 -fill $axisColor

    plotter:simpleReDrawXAxis $context $canvas $isResize
}

proc plotter:simpleReDrawXAxis {context canvas isResize} {
    upvar #0 plotter:leftb leftb \
	plotter:rightb rightb \
	plotter:tMin tMin \
	plotter:tMaxDisplay tMaxDisplay 
    
    $canvas itemconfigure $context:axis -width [expr [winfo width