summaryrefslogtreecommitdiffstats
path: root/library/graph.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/graph.tcl')
-rw-r--r--library/graph.tcl842
1 files changed, 842 insertions, 0 deletions
diff --git a/library/graph.tcl b/library/graph.tcl
new file mode 100644
index 0000000..8c4fd8d
--- /dev/null
+++ b/library/graph.tcl
@@ -0,0 +1,842 @@
+
+namespace eval ::blt::legend {
+ variable _private
+ array set _private {
+ afterId ""
+ scroll 0
+ space off
+ drag 0
+ x 0
+ y 0
+ }
+}
+
+namespace eval ::blt::ZoomStack {
+ variable _private
+ array set _private {
+ afterId ""
+ scroll 0
+ space off
+ drag 0
+ x 0
+ y 0
+ }
+}
+
+option add *zoomOutline.dashes 4
+option add *zoomOutline.lineWidth 2
+option add *zoomOutline.xor yes
+option add *zoomTitle.anchor nw
+option add *zoomTitle.coords "-Inf Inf"
+option add *zoomTitle.font "Arial 14"
+option add *zoomTitle.foreground yellow3
+option add *zoomTitle.shadow yellow4
+
+# ----------------------------------------------------------------------
+#
+# Initialize --
+#
+# Invoked by internally by Treeview_Init routine. Initializes
+# the default bindings for the treeview widget entries. These
+# are local to the widget, so they can't be set through the
+# widget's class bind tags.
+#
+# ----------------------------------------------------------------------
+proc blt::LegendSelections { w } {
+ if 0 {
+ #
+ # Active entry bindings
+ #
+ $w legend bind all <Enter> {
+ %W entry highlight current
+ }
+ $w legend bind all <Leave> {
+ %W entry highlight ""
+ }
+ }
+
+ #
+ # ButtonPress-1
+ #
+ # Performs the following operations:
+ #
+ # 1. Clears the previous selection.
+ # 2. Selects the current entry.
+ # 3. Sets the focus to this entry.
+ # 4. Scrolls the entry into view.
+ # 5. Sets the selection anchor to this entry, just in case
+ # this is "multiple" mode.
+ #
+
+ $w legend bind all <ButtonPress-1> {
+ blt::legend::SetSelectionAnchor %W current
+ set blt::legend::_private(scroll) 1
+ }
+
+ #
+ # B1-Motion
+ #
+ # For "multiple" mode only. Saves the current location of the
+ # pointer for auto-scrolling. Resets the selection mark.
+ #
+ $w legend bind all <B1-Motion> {
+ set blt::legend::_private(x) %x
+ set blt::legend::_private(y) %y
+ set elem [%W legend get @%x,%y]
+ if { $elem != "" } {
+ if { [%W legend cget -selectmode] == "multiple" } {
+ %W legend selection mark $elem
+ } else {
+ blt::legend::SetSelectionAnchor %W $elem
+ }
+ }
+ }
+
+ #
+ # ButtonRelease-1
+ #
+ # For "multiple" mode only.
+ #
+ $w legend bind all <ButtonRelease-1> {
+ if { [%W legend cget -selectmode] == "multiple" } {
+ %W legend selection anchor current
+ }
+ after cancel $blt::legend::_private(afterId)
+ set blt::legend::_private(scroll) 0
+ }
+
+ #
+ # Shift-ButtonPress-1
+ #
+ # For "multiple" mode only.
+ #
+
+ $w legend bind all <Shift-ButtonPress-1> {
+ if { [%W legend cget -selectmode] == "multiple" &&
+ [%W legend selection present] } {
+ if { [%W legend get anchor] == "" } {
+ %W legend selection anchor current
+ }
+ set elem [%W legend get anchor]
+ %W legend selection clearall
+ %W legend selection set $elem current
+ } else {
+ blt::legend::SetSelectionAnchor %W current
+ }
+ }
+ $w legend bind all <Shift-Double-ButtonPress-1> {
+ # do nothing
+ }
+ $w legend bind all <Shift-B1-Motion> {
+ # do nothing
+ }
+ $w legend bind all <Shift-ButtonRelease-1> {
+ after cancel $blt::legend::_private(afterId)
+ set blt::legend::_private(scroll) 0
+ }
+
+ #
+ # Control-ButtonPress-1
+ #
+ # For "multiple" mode only.
+ #
+ $w legend bind all <Control-ButtonPress-1> {
+ if { [%W legend cget -selectmode] == "multiple" } {
+ set elem [%W legend get current]
+ %W legend selection toggle $elem
+ %W legend selection anchor $elem
+ } else {
+ blt::legend::SetSelectionAnchor %W current
+ }
+ }
+ $w legend bind all <Control-Double-ButtonPress-1> {
+ # do nothing
+ }
+ $w legend bind all <Control-B1-Motion> {
+ # do nothing
+ }
+ $w legend bind all <Control-ButtonRelease-1> {
+ after cancel $blt::legend::_private(afterId)
+ set blt::legend::_private(scroll) 0
+ }
+
+ $w legend bind all <Control-Shift-ButtonPress-1> {
+ if { [%W legend cget -selectmode] == "multiple" &&
+ [%W legend selection present] } {
+ if { [%W legend get anchor] == "" } {
+ %W selection anchor current
+ }
+ if { [%W legend selection includes anchor] } {
+ %W legend selection set anchor current
+ } else {
+ %W legend selection clear anchor current
+ %W legend selection set current
+ }
+ } else {
+ blt::legend::SetSelectionAnchor %W current
+ }
+ }
+ $w legend bind all <Control-Shift-Double-ButtonPress-1> {
+ # do nothing
+ }
+ $w legend bind all <Control-Shift-B1-Motion> {
+ # do nothing
+ }
+ $w legend bind all <KeyPress-Up> {
+ blt::legend::MoveFocus %W previous.row
+ if { $blt::legend::_private(space) } {
+ %W legend selection toggle focus
+ }
+ }
+ $w legend bind all <KeyPress-Down> {
+ blt::legend::MoveFocus %W next.row
+ if { $blt::legend::_private(space) } {
+ %W legend selection toggle focus
+ }
+ }
+ $w legend bind all <KeyPress-Left> {
+ blt::legend::MoveFocus %W previous.column
+ if { $blt::legend::_private(space) } {
+ %W legend selection toggle focus
+ }
+ }
+ $w legend bind all <KeyPress-Right> {
+ blt::legend::MoveFocus %W next.column
+ if { $blt::legend::_private(space) } {
+ %W legend selection toggle focus
+ }
+ }
+ $w legend bind all <KeyPress-space> {
+ if { [%W legend cget -selectmode] == "single" } {
+ if { [%W legend selection includes focus] } {
+ %W legend selection clearall
+ } else {
+ %W legend selection clearall
+ %W legend selection set focus
+ }
+ } else {
+ %W legend selection toggle focus
+ }
+ set blt::legend::_private(space) on
+ }
+
+ $w legend bind all <KeyRelease-space> {
+ set blt::legend::_private(space) off
+ }
+ $w legend bind all <KeyPress-Return> {
+ blt::legend::MoveFocus %W focus
+ set blt::legend::_private(space) on
+ }
+ $w legend bind all <KeyRelease-Return> {
+ set blt::legend::_private(space) off
+ }
+ $w legend bind all <KeyPress-Home> {
+ blt::legend::MoveFocus %W first
+ }
+ $w legend bind all <KeyPress-End> {
+ blt::tv::MoveFocus %W last
+ }
+}
+
+proc blt::legend::SetSelectionAnchor { w tagOrId } {
+ set elem [$w legend get $tagOrId]
+ # If the anchor hasn't changed, don't do anything
+ if { $elem != [$w legend get anchor] } {
+ $w legend selection clearall
+ $w legend focus $elem
+ $w legend selection set $elem
+ $w legend selection anchor $elem
+ }
+}
+
+# ----------------------------------------------------------------------
+#
+# MoveFocus --
+#
+# Invoked by KeyPress bindings. Moves the active selection to
+# the entry <where>, which is an index such as "up", "down",
+# "prevsibling", "nextsibling", etc.
+#
+# ----------------------------------------------------------------------
+proc blt::legend::MoveFocus { w elem } {
+ catch {$w legend focus $elem} result
+ puts stderr "result=$result elem=$elem"
+ if { [$w legend cget -selectmode] == "single" } {
+ $w legend selection clearall
+ $w legend selection set focus
+ $w legend selection anchor focus
+ }
+}
+
+
+proc Blt_ActiveLegend { g } {
+ $g legend bind all <Enter> [list blt::ActivateLegend $g ]
+ $g legend bind all <Leave> [list blt::DeactivateLegend $g]
+ $g legend bind all <ButtonPress-1> [list blt::HighlightLegend $g]
+}
+
+proc Blt_Crosshairs { g } {
+ blt::Crosshairs $g
+}
+
+proc Blt_ResetCrosshairs { g state } {
+ blt::Crosshairs $g "Any-Motion" $state
+}
+
+proc Blt_ZoomStack { g args } {
+ array set params {
+ -mode click
+ }
+ array set params $args
+ if { $params(-mode) == "click" } {
+ blt::ZoomStack::ClickClick $g
+ } else {
+ blt::ZoomStack::ClickRelease $g
+ }
+}
+
+proc Blt_PrintKey { g } {
+ blt::PrintKey $g
+}
+
+proc Blt_ClosestPoint { g } {
+ blt::ClosestPoint $g
+}
+
+#
+# The following procedures that reside in the "blt" namespace are
+# supposed to be private.
+#
+
+proc blt::ActivateLegend { g } {
+ set elem [$g legend get current]
+ $g legend activate $elem
+}
+proc blt::DeactivateLegend { g } {
+ set elem [$g legend get current]
+ $g legend deactivate $elem
+}
+
+proc blt::HighlightLegend { g } {
+ set elem [$g legend get current]
+ if { $elem != "" } {
+ set relief [$g element cget $elem -legendrelief]
+ if { $relief == "flat" } {
+ $g element configure $elem -legendrelief raised
+ $g element activate $elem
+ } else {
+ $g element configure $elem -legendrelief flat
+ $g element deactivate $elem
+ }
+ }
+}
+
+proc blt::Crosshairs { g {event "Any-Motion"} {state "on"}} {
+ $g crosshairs $state
+ bind crosshairs-$g <$event> {
+ %W crosshairs configure -position @%x,%y
+ }
+ bind crosshairs-$g <Leave> {
+ %W crosshairs off
+ }
+ bind crosshairs-$g <Enter> {
+ %W crosshairs on
+ }
+ $g crosshairs configure -color red
+ if { $state == "on" } {
+ blt::AddBindTag $g crosshairs-$g
+ } elseif { $state == "off" } {
+ blt::RemoveBindTag $g crosshairs-$g
+ }
+}
+
+proc blt::PrintKey { g {event "Shift-ButtonRelease-3"} } {
+ bind print-$g <$event> { Blt_PostScriptDialog %W }
+ blt::AddBindTag $g print-$g
+}
+
+proc blt::ClosestPoint { g {event "Control-ButtonPress-2"} } {
+ bind closest-point-$g <$event> {
+ blt::FindElement %W %x %y
+ }
+ blt::AddBindTag $g closest-point-$g
+}
+
+proc blt::AddBindTag { widget tag } {
+ set oldTagList [bindtags $widget]
+ if { [lsearch $oldTagList $tag] < 0 } {
+ bindtags $widget [linsert $oldTagList 0 $tag]
+ }
+}
+
+proc blt::RemoveBindTag { widget tag } {
+ set oldTagList [bindtags $widget]
+ set index [lsearch $oldTagList $tag]
+ if { $index >= 0 } {
+ bindtags $widget [lreplace $oldTagList $index $index]
+ }
+}
+
+proc blt::FindElement { g x y } {
+ array set info [$g element closest $x $y -interpolate yes]
+ if { ![info exists info(name)] } {
+ beep
+ return
+ }
+ # --------------------------------------------------------------
+ # find(name) - element Id
+ # find(index) - index of closest point
+ # find(x) find(y) - coordinates of closest point
+ # or closest point on line segment.
+ # find(dist) - distance from sample coordinate
+ # --------------------------------------------------------------
+ set markerName "bltClosest_$info(name)"
+ catch { $g marker delete $markerName }
+ $g marker create text -coords { $info(x) $info(y) } \
+ -name $markerName \
+ -text "$info(name): $info(dist)\nindex $info(index)" \
+ -font "Arial 6" \
+ -anchor center -justify left \
+ -yoffset 0 -bg {}
+
+ set coords [$g invtransform $x $y]
+ set nx [lindex $coords 0]
+ set ny [lindex $coords 1]
+
+ $g marker create line -coords "$nx $ny $info(x) $info(y)" \
+ -name line.$markerName
+
+ blt::FlashPoint $g $info(name) $info(index) 10
+ blt::FlashPoint $g $info(name) [expr $info(index) + 1] 10
+}
+
+proc blt::FlashPoint { g name index count } {
+ if { $count & 1 } {
+ $g element deactivate $name
+ } else {
+ $g element activate $name $index
+ }
+ incr count -1
+ if { $count > 0 } {
+ after 200 blt::FlashPoint $g $name $index $count
+ update
+ } else {
+ eval $g marker delete [$g marker names "bltClosest_*"]
+ }
+}
+
+
+proc blt::ZoomStack::Init { g } {
+ variable _private
+ set _private($g,interval) 100
+ set _private($g,afterId) 0
+ set _private($g,A,x) {}
+ set _private($g,A,y) {}
+ set _private($g,B,x) {}
+ set _private($g,B,y) {}
+ set _private($g,stack) {}
+ set _private($g,corner) A
+}
+
+proc blt::ZoomStack::ClickClick { g {start "ButtonPress-1"} {reset "ButtonPress-3"} } {
+ variable _private
+
+ Init $g
+
+ bind zoom-$g <Enter> "focus %W"
+ bind zoom-$g <KeyPress-Escape> { blt::ZoomStack::Reset %W }
+ bind zoom-$g <${start}> { blt::ZoomStack::SetPoint %W %x %y }
+ bind zoom-$g <${reset}> {
+ if { [%W inside %x %y] } {
+ blt::ZoomStack::Reset %W
+ }
+ }
+ blt::AddBindTag $g zoom-$g
+}
+
+proc blt::ZoomStack::ClickRelease { g } {
+ variable _private
+
+ Init $g
+ bind zoom-$g <Enter> "focus %W"
+ bind zoom-$g <KeyPress-Escape> { blt::ZoomStack::Reset %W }
+ bind zoom-$g <ButtonPress-1> { blt::ZoomStack::DragStart %W %x %y }
+ bind zoom-$g <B1-Motion> { blt::ZoomStack::DragMotion %W %x %y }
+ bind zoom-$g <ButtonRelease-1> { blt::ZoomStack::DragFinish %W %x %y }
+ bind zoom-$g <ButtonPress-3> {
+ if { [%W inside %x %y] } {
+ blt::ZoomStack::Reset %W
+ }
+ }
+ blt::AddBindTag $g zoom-$g
+}
+
+proc blt::ZoomStack::GetCoords { g x y index } {
+ variable _private
+ if { [$g cget -invertxy] } {
+ set _private($g,$index,x) $y
+ set _private($g,$index,y) $x
+ } else {
+ set _private($g,$index,x) $x
+ set _private($g,$index,y) $y
+ }
+}
+
+proc blt::ZoomStack::MarkPoint { g index } {
+ variable _private
+
+ if { [llength [$g xaxis use]] > 0 } {
+ set x [$g xaxis invtransform $_private($g,$index,x)]
+ } else if { [llength [$g x2axis use]] > 0 } {
+ set x [$g x2axis invtransform $_private($g,$index,x)]
+ }
+ if { [llength [$g yaxis use]] > 0 } {
+ set y [$g yaxis invtransform $_private($g,$index,y)]
+ } else if { [llength [$g y2axis use]] > 0 } {
+ set y [$g y2axis invtransform $_private($g,$index,y)]
+ }
+ set marker "zoomText_$index"
+ set text [format "x=%.4g\ny=%.4g" $x $y]
+
+ if [$g marker exists $marker] {
+ $g marker configure $marker -coords { $x $y } -text $text
+ } else {
+ $g marker create text -coords { $x $y } -name $marker \
+ -font "mathmatica1 10" \
+ -text $text -anchor center -bg {} -justify left
+ }
+}
+
+proc blt::ZoomStack::DestroyTitle { g } {
+ variable _private
+
+ if { $_private($g,corner) == "A" } {
+ catch { $g marker delete "zoomTitle" }
+ }
+}
+
+proc blt::ZoomStack::Pop { g } {
+ variable _private
+
+ set zoomStack $_private($g,stack)
+ if { [llength $zoomStack] > 0 } {
+ set cmd [lindex $zoomStack 0]
+ set _private($g,stack) [lrange $zoomStack 1 end]
+ eval $cmd
+ TitleLast $g
+ blt::busy hold $g
+ update
+ blt::busy release $g
+ after 2000 [list blt::ZoomStack::DestroyTitle $g]
+ } else {
+ catch { $g marker delete "zoomTitle" }
+ }
+}
+
+# Push the old axis limits on the stack and set the new ones
+
+proc blt::ZoomStack::Push { g } {
+ variable _private
+
+ eval $g marker delete [$g marker names "zoom*"]
+ if { [info exists _private($g,afterId)] } {
+ after cancel $_private($g,afterId)
+ }
+ set x1 $_private($g,A,x)
+ set y1 $_private($g,A,y)
+ set x2 $_private($g,B,x)
+ set y2 $_private($g,B,y)
+
+ if { ($x1 == $x2) || ($y1 == $y2) } {
+ # No delta, revert to start
+ return
+ }
+ set cmd {}
+ foreach axis [$g axis names] {
+ if { [$g axis cget $axis -hide] } {
+ continue
+ }
+ set min [$g axis cget $axis -min]
+ set max [$g axis cget $axis -max]
+ set logscale [$g axis cget $axis -logscale]
+ # Save the current scale (log or linear) so that we can restore it.
+ # This is for the case where the user changes to logscale while
+ # zooming. A previously pushed axis limit could be negative. It
+ # seems better for popping the zoom stack to restore a previous view
+ # (not convert the ranges).
+ set c [list $g axis configure $axis]
+ lappend c -min $min -max $max -logscale $logscale
+ append cmd "$c\n"
+ }
+
+ # This effectively pushes the command to reset the graph to the current
+ # zoom level onto the stack. This is useful if the new axis ranges are
+ # bad and we need to reset the zoom stack.
+ set _private($g,stack) [linsert $_private($g,stack) 0 $cmd]
+ foreach axis [$g axis names] {
+ if { [$g axis cget $axis -hide] } {
+ continue; # Don't set zoom on axes not displayed.
+ }
+ set type [$g axis type $axis]
+ if { $type == "x" } {
+ set min [$g axis invtransform $axis $x1]
+ set max [$g axis invtransform $axis $x2]
+ } elseif { $type == "y" } {
+ set min [$g axis invtransform $axis $y1]
+ set max [$g axis invtransform $axis $y2]
+ } else {
+ continue; # Axis is not bound to any margin.
+ }
+ if { ![SetAxisRanges $g $axis $min $max] } {
+ Pop $g
+ bell
+ return
+ }
+ }
+ blt::busy hold $g
+ update; # This "update" redraws the graph
+ blt::busy release $g
+}
+
+proc blt::ZoomStack::SetAxisRanges { g axis min max } {
+ if { $min > $max } {
+ set tmp $max; set max $min; set min $tmp
+ }
+ if { [catch { $g axis configure $axis -min $min -max $max }] != 0 } {
+ return 0
+ }
+ return 1
+}
+
+#
+# This routine terminates either an existing zoom, or pops back to
+# the previous zoom level (if no zoom is in progress).
+#
+proc blt::ZoomStack::Reset { g } {
+ variable _private
+
+ if { ![info exists _private($g,corner)] } {
+ Init $g
+ }
+ eval $g marker delete [$g marker names "zoom*"]
+
+ if { $_private($g,corner) == "A" } {
+ # Reset the whole axis
+ Pop $g
+ } else {
+ set _private($g,corner) A
+ blt::RemoveBindTag $g select-region-$g
+ }
+}
+
+proc blt::ZoomStack::TitleNext { g } {
+ variable _private
+
+ set level [expr [llength $_private($g,stack)] + 1]
+ if { [$g cget -invertxy] } {
+ set coords "Inf -Inf"
+ } else {
+ set coords "-Inf Inf"
+ }
+ $g marker create text -name "zoomTitle" -text "Zoom #$level" \
+ -coords $coords -bindtags "" -anchor nw
+}
+
+proc blt::ZoomStack::TitleLast { g } {
+ variable _private
+
+ set level [llength $_private($g,stack)]
+ if { $level > 0 } {
+ $g marker create text -name "zoomTitle" -anchor nw \
+ -text "Zoom #$level"
+ }
+}
+
+
+proc blt::ZoomStack::SetPoint { g x y } {
+ variable _private
+ if { ![info exists _private($g,corner)] } {
+ Init $g
+ }
+ GetCoords $g $x $y $_private($g,corner)
+ bind select-region-$g <Motion> {
+ blt::ZoomStack::GetCoords %W %x %y B
+ #blt::ZoomStack::MarkPoint $g B
+ blt::ZoomStack::Box %W
+ }
+ if { $_private($g,corner) == "A" } {
+ if { ![$g inside $x $y] } {
+ return
+ }
+ # First corner selected, start watching motion events
+
+ #MarkPoint $g A
+ TitleNext $g
+
+ blt::AddBindTag $g select-region-$g
+ set _private($g,corner) B
+ } else {
+ # Delete the modal binding
+ blt::RemoveBindTag $g select-region-$g
+ Push $g
+ set _private($g,corner) A
+ }
+}
+
+proc blt::ZoomStack::DragStart { g x y } {
+ variable _private
+ if { ![info exists _private($g,corner)] } {
+ Init $g
+ }
+ GetCoords $g $x $y A
+ if { ![$g inside $x $y] } {
+ return
+ }
+ set _private(drag) 1
+ TitleNext $g
+}
+
+proc blt::ZoomStack::DragMotion { g x y } {
+ variable _private
+
+ if { $_private(drag) } {
+ GetCoords $g $x $y B
+ set dx [expr abs($_private($g,B,x) - $_private($g,A,x))]
+ set dy [expr abs($_private($g,B,y) - $_private($g,A,y))]
+ Box $g
+ if { $dy > 10 && $dx > 10 } {
+ return 1
+ }
+ }
+ return 0
+}
+
+proc blt::ZoomStack::DragFinish { g x y } {
+ variable _private
+ if { [DragMotion $g $x $y] } {
+ Push $g
+ } else {
+ eval $g marker delete [$g marker names "zoom*"]
+ if { [info exists _private($g,afterId)] } {
+ after cancel $_private($g,afterId)
+ }
+ }
+ set _private(drag) 0
+}
+
+
+proc blt::ZoomStack::MarchingAnts { g offset } {
+ variable _private
+
+ incr offset
+ # wrap the counter after 2^16
+ set offset [expr $offset & 0xFFFF]
+ if { [$g marker exists zoomOutline] } {
+ $g marker configure zoomOutline -dashoffset $offset
+ set interval $_private($g,interval)
+ set id [after $interval [list blt::ZoomStack::MarchingAnts $g $offset]]
+ set _private($g,afterId) $id
+ }
+}
+
+proc blt::ZoomStack::Box { g } {
+ variable _private
+
+ if { $_private($g,A,x) > $_private($g,B,x) } {
+ set x1 [$g xaxis invtransform $_private($g,B,x)]
+ set y1 [$g yaxis invtransform $_private($g,B,y)]
+ set x2 [$g xaxis invtransform $_private($g,A,x)]
+ set y2 [$g yaxis invtransform $_private($g,A,y)]
+ } else {
+ set x1 [$g xaxis invtransform $_private($g,A,x)]
+ set y1 [$g yaxis invtransform $_private($g,A,y)]
+ set x2 [$g xaxis invtransform $_private($g,B,x)]
+ set y2 [$g yaxis invtransform $_private($g,B,y)]
+ }
+ set coords { $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1 }
+ if { [$g marker exists "zoomOutline"] } {
+ $g marker configure "zoomOutline" -coords $coords
+ } else {
+ set X [lindex [$g xaxis use] 0]
+ set Y [lindex [$g yaxis use] 0]
+ $g marker create line -coords $coords -name "zoomOutline" \
+ -mapx $X -mapy $Y
+ set interval $_private($g,interval)
+ set id [after $interval [list blt::ZoomStack::MarchingAnts $g 0]]
+ set _private($g,afterId) $id
+ }
+}
+
+
+proc Blt_PostScriptDialog { g } {
+ set top $g.top
+ toplevel $top
+
+ foreach var { center landscape maxpect preview decorations padx
+ pady paperwidth paperheight width height colormode } {
+ global $g.$var
+ set $g.$var [$g postscript cget -$var]
+ }
+ set row 1
+ set col 0
+ label $top.title -text "PostScript Options"
+ blt::table $top $top.title -cspan 7
+ foreach bool { center landscape maxpect preview decorations } {
+ set w $top.$bool-label
+ label $w -text "-$bool" -font "courier 12"
+ blt::table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
+ set w $top.$bool-yes
+ global $g.$bool
+ radiobutton $w -text "yes" -variable $g.$bool -value 1
+ blt::table $top $row,$col+1 $w -anchor w
+ set w $top.$bool-no
+ radiobutton $w -text "no" -variable $g.$bool -value 0
+ blt::table $top $row,$col+2 $w -anchor w
+ incr row
+ }
+ label $top.modes -text "-colormode" -font "courier 12"
+ blt::table $top $row,0 $top.modes -anchor e -pady { 2 0 } -padx { 0 4 }
+ set col 1
+ foreach m { color greyscale } {
+ set w $top.$m
+ radiobutton $w -text $m -variable $g.colormode -value $m
+ blt::table $top $row,$col $w -anchor w
+ incr col
+ }
+ set row 1
+ frame $top.sep -width 2 -bd 1 -relief sunken
+ blt::table $top $row,3 $top.sep -fill y -rspan 6
+ set col 4
+ foreach value { padx pady paperwidth paperheight width height } {
+ set w $top.$value-label
+ label $w -text "-$value" -font "courier 12"
+ blt::table $top $row,$col $w -anchor e -pady { 2 0 } -padx { 0 4 }
+ set w $top.$value-entry
+ global $g.$value
+ entry $w -textvariable $g.$value -width 8
+ blt::table $top $row,$col+1 $w -cspan 2 -anchor w -padx 8
+ incr row
+ }
+ blt::table configure $top c3 -width .125i
+ button $top.cancel -text "Cancel" -command "destroy $top"
+ blt::table $top $row,0 $top.cancel -width 1i -pady 2 -cspan 3
+ button $top.reset -text "Reset" -command "destroy $top"
+ #blt::table $top $row,1 $top.reset -width 1i
+ button $top.print -text "Print" -command "blt::ResetPostScript $g"
+ blt::table $top $row,4 $top.print -width 1i -pady 2 -cspan 2
+}
+
+proc blt::ResetPostScript { g } {
+ foreach var { center landscape maxpect preview decorations padx
+ pady paperwidth paperheight width height colormode } {
+ global $g.$var
+ set old [$g postscript cget -$var]
+ if { [catch {$g postscript configure -$var [set $g.$var]}] != 0 } {
+ $g postscript configure -$var $old
+ set $g.$var $old
+ }
+ }
+ $g postscript output "out.ps"
+ puts stdout "wrote file \"out.ps\"."
+ flush stdout
+}
generated by cgit v0.12 at 2024-11-04 21:13:35 (GMT)