Widget Demo: Replaced the deprecated "trace variable" invocations with "trace add variable"; several further improvements.

8 files changed, 60 insertions, 49 deletions

diff --git a/library/demos/anilabel.tcl b/library/demos/anilabel.tcl
index 366bded..a9b967f 100644
--- a/library/demos/anilabel.tcl
+++ b/library/demos/anilabel.tcl
@@ -66,10 +66,10 @@ proc animateLabelText {w text interval} {
 ## Next, a similar pair of procedures to animate a GIF loaded into a
 ## photo image.
 proc SelectNextImageFrame {w interval} {
-    global animationCallbacks
+    global animationCallbacks image zoomFactor
     set animationCallbacks($w) \
 	    [after $interval SelectNextImageFrame $w $interval]
-    set image [$w cget -image]
+    set image2 [$w cget -image]
 
     # The easy way to animate a GIF!
     set idx -1
@@ -80,15 +80,23 @@ proc SelectNextImageFrame {w interval} {
     }]} then {
 	$image configure -format "GIF -index 0"
     }
+    $image2 copy $image -zoom $zoomFactor
 }
 proc animateLabelImage {w imageData interval} {
-    global animationCallbacks
+    global animationCallbacks image zoomFactor
 
     # Create a multi-frame GIF from base-64-encoded data
     set image [image create photo -format GIF -data $imageData]
 
-    # Install the image into the widget
-    $w configure -image $image
+    # Create a copy of the image just created, magnified according to the
+    # display's DPI scaling level.  Since the zooom factor must be an integer,
+    # the copy will only be effectively magnified if $tk::scalingPct >= 200.
+    set image2 [image create photo]
+    set zoomFactor [expr {int($tk::scalingPct / 100.0)}]
+    $image2 copy $image -zoom $zoomFactor
+
+    # Install the image copy into the widget
+    $w configure -image $image2
 
     # Schedule the start of the animation loop
     set animationCallbacks($w) \
diff --git a/library/demos/check.tcl b/library/demos/check.tcl
index cbb3833..96ff251 100644
--- a/library/demos/check.tcl
+++ b/library/demos/check.tcl
@@ -65,7 +65,7 @@ proc tristate_check {n1 n2 op} {
     set in_check 0
 }
 
-trace variable wipers w tristate_check
-trace variable brakes w tristate_check
-trace variable sober  w tristate_check
-trace variable safety w tristate_check
+trace add variable wipers write tristate_check
+trace add variable brakes write tristate_check
+trace add variable sober  write tristate_check
+trace add variable safety write tristate_check
diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl
index ac5e79a..f3daac4 100644
--- a/library/demos/floor.tcl
+++ b/library/demos/floor.tcl
@@ -1375,4 +1375,4 @@ if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk]
 }
 bind $c <Destroy> "unset currentRoom"
 set currentRoom ""
-trace variable currentRoom w "roomChanged $c"
+trace add variable currentRoom write "roomChanged $c"
diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl
index 2959063..0a8ef54 100644
--- a/library/demos/goldberg.tcl
+++ b/library/demos/goldberg.tcl
@@ -140,22 +140,22 @@ proc DoCtrlFrame {w} {
     ttk::button $w.about -text About -command [list About $w]
 
     grid $w.start -in $w.ctrl -row 0 -sticky ew
-    grid rowconfigure $w.ctrl 1 -minsize 10
+    grid rowconfigure $w.ctrl 1 -minsize 7.5p
     grid $w.pause -in $w.ctrl -row 2 -sticky ew
     grid $w.step  -in $w.ctrl -sticky ew -pady 1.5p
     grid $w.bstep -in $w.ctrl -sticky ew
     grid $w.reset -in $w.ctrl -sticky ew -pady 1.5p
-    grid rowconfigure $w.ctrl 10 -minsize 18
+    grid rowconfigure $w.ctrl 10 -minsize 13.5p
     grid $w.details -in $w.ctrl -row 11 -sticky ew
-    grid rowconfigure $w.ctrl 11 -minsize 20
+    grid rowconfigure $w.ctrl 11 -minsize 15p
     $w.details configure -labelwidget $w.details.cb
     grid [ttk::frame $w.details.b -height 1]	;# Work around minor bug
     raise $w.details
     raise $w.details.cb
     grid rowconfigure $w.ctrl 50 -weight 1
-    trace variable ::S(mode) w	  [list ActiveGUI $w]
-    trace variable ::S(details) w [list ActiveGUI $w]
-    trace variable ::S(speed) w	  [list ActiveGUI $w]
+    trace add variable ::S(mode) write	  [list ActiveGUI $w]
+    trace add variable ::S(details) write [list ActiveGUI $w]
+    trace add variable ::S(speed) write	  [list ActiveGUI $w]
 
     grid $w.message -in $w.ctrl -row 98 -sticky ew -pady 3p
     grid $w.message.e -sticky nsew
diff --git a/library/demos/paned1.tcl b/library/demos/paned1.tcl
index 75b6035..829988a 100644
--- a/library/demos/paned1.tcl
+++ b/library/demos/paned1.tcl
@@ -29,4 +29,4 @@ pack $w.pane -side top -expand yes -fill both -pady 1.5p -padx 2m
 label $w.pane.left  -text "This is the\nleft side"  -fg black -bg yellow
 label $w.pane.right -text "This is the\nright side" -fg black -bg cyan
 
-$w.pane add $w.pane.left $w.pane.right
+$w.pane add $w.pane.left $w.pane.right -stretch always
diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl
index 2d11f20..73af21d 100644
--- a/library/demos/paned2.tcl
+++ b/library/demos/paned2.tcl
@@ -71,4 +71,4 @@ grid rowconfigure    $f 0 -weight 1
 $f.text insert 1.0 "This is just a normal text widget"
 
 # Now add our contents to the paned window
-$w.pane add $w.pane.top $w.pane.bottom
+$w.pane add $w.pane.top $w.pane.bottom -stretch always
diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl
index 212373b..d76a1ec 100644
--- a/library/demos/pendulum.tcl
+++ b/library/demos/pendulum.tcl
@@ -25,8 +25,8 @@ pack $btns -side bottom -fill x
 
 # Create some structural widgets
 pack [panedwindow $w.p] -fill both -expand 1
-$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"]
-$w.p add [labelframe $w.p.l2 -text "Phase Space"]
+$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"] -stretch always
+$w.p add [labelframe $w.p.l2 -text "Phase Space"] -stretch always
 
 # Create the canvas containing the graphical representation of the
 # simulated system.
@@ -50,18 +50,21 @@ for {set i 90} {$i>=0} {incr i -10} {
     $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
 }
 
-$w.k create text 0 0 -anchor ne -text "θ" -tags label_theta
+$w.k create text 0 0 -anchor ne -text "θ"  -tags label_theta
 $w.k create text 0 0 -anchor ne -text "δθ" -tags label_dtheta
 pack $w.k -in $w.p.l2 -fill both -expand true
 
 # Initialize some variables
-set points  {}
-set Theta    45.0
-set dTheta    0.0
-set pi        3.1415926535897933
-set scaling [tk scaling]
-set length  [expr {112.5*$scaling}]
-set home    [expr {120*$scaling}]
+set points {}
+set Theta  45.0
+set dTheta  0.0
+set pi      3.1415926535897933
+set tkScl  [tk scaling]
+set length [expr {round(111*$tkScl)}]			;# 111p -> pixels
+set xHome  [expr {round(120*$tkScl)}]			;# 120p -> pixels
+set yHome  [expr {round( 18*$tkScl)}]			;#  18p -> pixels
+set rBob   [expr {round( 12*$tkScl)}]			;#  12p -> pixels
+set rPivot [expr {round(  3*$tkScl)}]			;#   3p -> pixels
 
 # This procedure makes the pendulum appear at the correct place on the
 # canvas. If the additional arguments "at $x $y" are passed (the 'at'
@@ -70,23 +73,22 @@ set home    [expr {120*$scaling}]
 # length and angle are computed in reverse from the given location
 # (which is taken to be the centre of the pendulum bob.)
 proc showPendulum {canvas {at {}} {x {}} {y {}}} {
-    global Theta dTheta pi length home scaling
+    global Theta dTheta pi length xHome yHome rBob
 
-    if {$at eq "at" && ($x!=$home || $y!=18*$scaling)} {
+    if {$at eq "at" && ($x!=$xHome || $y!=$yHome)} {
 	set dTheta 0.0
-	set x2 [expr {$x - $home}]
-	set y2 [expr {$y - 18*$scaling}]
+	set x2 [expr {$x - $xHome}]
+	set y2 [expr {$y - $yHome}]
 	set length [expr {hypot($x2, $y2)}]
 	set Theta  [expr {atan2($x2, $y2) * 180/$pi}]
     } else {
 	set angle [expr {$Theta * $pi/180}]
-	set x [expr {$home + $length*sin($angle)}]
-	set y [expr {18*$scaling + $length*cos($angle)}]
+	set x [expr {$xHome + $length*sin($angle)}]
+	set y [expr {$yHome + $length*cos($angle)}]
     }
-    $canvas coords rod $home 18p $x $y
-    set r [expr {12*$scaling}]
-    $canvas coords bob \
-	    [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]
+    $canvas coords rod $xHome $yHome $x $y
+    $canvas coords bob [expr {$x - $rBob}] [expr {$y - $rBob}] \
+		       [expr {$x + $rBob}] [expr {$y + $rBob}]
 }
 showPendulum $w.c
 
@@ -95,9 +97,9 @@ showPendulum $w.c
 # respect to time.)
 proc showPhase {canvas} {
     global Theta dTheta points psw psh
-    set scaleFactor [expr {$tk::scalingPct / 100.0}]
+    set sclFactor [expr {$tk::scalingPct / 100.0}]
 
-    lappend points [expr {$Theta+$psw}] [expr {-20*$scaleFactor*$dTheta+$psh}]
+    lappend points [expr {$Theta + $psw}] [expr {-20*$sclFactor*$dTheta + $psh}]
     if {[llength $points] > 100} {
 	set points [lrange $points end-99 end]
     }
@@ -105,7 +107,7 @@ proc showPhase {canvas} {
 	set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]]
 	if {[llength $list] >= 4} {
 	    $canvas coords graph$i $list
-	    $canvas scale graph$i $psw $psh $scaleFactor $scaleFactor
+	    $canvas scale graph$i $psw $psh $sclFactor $sclFactor
 	}
     }
 }
@@ -132,16 +134,17 @@ bind $w.c <ButtonRelease-1> {
 }
 bind $w.c <Configure> {
     %W coords plate 0 18p %w 18p
-    set home [expr {%w/2}]
-    %W coords pivot [expr {$home-3*$scaling}] 15p [expr {$home+3*$scaling}] 21p
+    set xHome [expr {%w/2}]
+    %W coords pivot [expr {$xHome - $rPivot}] 15p [expr {$xHome + $rPivot}] 21p
 }
 bind $w.k <Configure> {
     set psh [expr {%h/2}]
     set psw [expr {%w/2}]
-    %W coords x_axis 1.5p $psh [expr {%w-1.5*$scaling}] $psh
-    %W coords y_axis $psw [expr {%h-1.5*$scaling}] $psw 1.5p
-    %W coords label_dtheta [expr {$psw-3*$scaling}] 4.5p
-    %W coords label_theta [expr {%w-4.5*$scaling}] [expr {$psh+3*$scaling}]
+    %W coords x_axis	   1.5p $psh [expr {%w - round(1.5*$tkScl)}] $psh
+    %W coords y_axis	   $psw [expr {%h - round(1.5*$tkScl)}] $psw 1.5p
+    %W coords label_dtheta [expr {$psw - round(3*$tkScl)}] 4.5p
+    %W coords label_theta  [expr {%w - round(4.5*$tkScl)}] \
+			   [expr {$psh + round(3*$tkScl)}]
 }
 
 # This procedure is the "business" part of the simulation that does
diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl
index 9df4932..cb76afe 100644
--- a/library/demos/twind.tcl
+++ b/library/demos/twind.tcl
@@ -37,7 +37,7 @@ ttk::scrollbar $w.scroll -command "$t yview"
 pack $w.scroll -side right -fill y
 panedwindow $w.pane
 pack $w.pane -expand yes -fill both
-$w.pane add $w.f
+$w.pane add $w.f -stretch always
 # Import to raise given creation order above
 raise $w.f
 
@@ -350,7 +350,7 @@ proc textSplitWindow {textW} {
 	    set t [$textW peer create $w.peer \
 	      -yscrollcommand "$w.scroll set"]
 	    $t tag configure peer_warning -font boldFont
-	    $w.pane add $t
+	    $w.pane add $t -stretch always
 	}
     } else {
         return