summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2001-10-29 16:23:32 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2001-10-29 16:23:32 (GMT)
commit0f7f254616e3bbed160bf140e85cce32d98f30bc (patch)
tree8a5f5fa5cf16889cdca31d56195ee53ffdaffa3f
parent4430b6a1941111541c5adea2408b1b05bf7f6c14 (diff)
downloadtk-0f7f254616e3bbed160bf140e85cce32d98f30bc.zip
tk-0f7f254616e3bbed160bf140e85cce32d98f30bc.tar.gz
tk-0f7f254616e3bbed160bf140e85cce32d98f30bc.tar.bz2
Improvements to the demo scripts, mostly up-ported from 8.3.4
-rw-r--r--ChangeLog13
-rw-r--r--library/demos/rmt35
-rw-r--r--library/demos/tcolor280
-rw-r--r--library/demos/timer35
4 files changed, 198 insertions, 165 deletions
diff --git a/ChangeLog b/ChangeLog
index 07a7216..4e1dbdd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2001-10-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * library/demos/tcolor: Changes up-ported from core-8-3-1-branch
+ to make the script compliant with current good practise, as well
+ as extensive use of the new labelframe widget.
+
+ * library/demos/timer: Changes up-ported from core-8-3-1-branch to
+ make the script look and work better.
+
+ * library/demos/rmt: Changes up-ported from core-8-3-1-branch to
+ use more 8.* features and make the demo script more generally
+ useful to people.
+
2001-10-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tkCursor.c (Tk_GetCursorFromData): Fixed uninit nextPtr
diff --git a/library/demos/rmt b/library/demos/rmt
index 1ed865b..2dcb47b 100644
--- a/library/demos/rmt
+++ b/library/demos/rmt
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
# Tk applications. It allows you to select an application and
# then type commands to that application.
#
-# RCS: @(#) $Id: rmt,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# RCS: @(#) $Id: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $
wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
@@ -32,22 +32,21 @@ set lastCommand ""
# Create menu bar. Arrange to recreate all the information in the
# applications sub-menu whenever it is cascaded to.
-frame .menu -relief raised -bd 2
-pack .menu -side top -fill x
-menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
-menu .menu.file.m
-.menu.file.m add cascade -label "Select Application" \
- -menu .menu.file.m.apps -underline 0
-.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
-menu .menu.file.m.apps -postcommand fillAppsMenu
-pack .menu.file -side left
+. configure -menu [menu .menu]
+menu .menu.file
+menu .menu.file.apps -postcommand fillAppsMenu
+.menu add cascade -label "File" -underline 0 -menu .menu.file
+.menu.file add cascade -label "Select Application" -underline 0 \
+ -menu .menu.file.apps
+.menu.file add command -label "Quit" -command "destroy ." -underline 0
# Create text window and scrollbar.
text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
scrollbar .s -command ".t yview"
-pack .s -side right -fill both
-pack .t -side left
+grid .t .s -sticky nsew
+grid rowconfigure . 0 -weight 1
+grid columnconfigure . 0 -weight 1
# Create a binding to forward commands to the target application,
# plus modify many of the built-in bindings so that only information
@@ -123,6 +122,7 @@ proc tkTextInsert {w s} {
$w see insert
}
+.t configure -font {Courier 12}
.t tag configure bold -font {Courier 12 bold}
# The procedure below is used to print out a prompt at the
@@ -193,13 +193,18 @@ proc newApp appName {
# of all the applications that currently exist.
proc fillAppsMenu {} {
- catch {.menu.file.m.apps delete 0 last}
+ set m .menu.file.apps
+ catch {$m delete 0 last}
foreach i [lsort [winfo interps]] {
- .menu.file.m.apps add command -label $i -command [list newApp $i]
+ $m add command -label $i -command [list newApp $i]
}
- .menu.file.m.apps add command -label local -command {newApp local}
+ $m add command -label local -command {newApp local}
}
set app [winfo name .]
prompt
focus .t
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/tcolor b/library/demos/tcolor
index 4eeb893..ae3cad0 100644
--- a/library/demos/tcolor
+++ b/library/demos/tcolor
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
#
-# RCS: @(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $
+# RCS: @(#) $Id: tcolor,v 1.3 2001/10/29 16:23:32 dkf Exp $
wm title . "Color Editor"
@@ -41,67 +41,70 @@ set updating 0
set autoUpdate 1
set name ""
+if {$tcl_platform(platform) eq "unix"} {
+ option add *Entry.background white
+}
+
# Create the menu bar at the top of the window.
-frame .menu -relief raised -borderwidth 2
-pack .menu -side top -fill x
-menubutton .menu.file -text File -menu .menu.file.m -underline 0
-menu .menu.file.m
-.menu.file.m add radio -label "RGB color space" -variable colorSpace \
+. configure -menu [menu .menu]
+menu .menu.file
+.menu add cascade -menu .menu.file -label File -underline 0
+.menu.file add radio -label "RGB color space" -variable colorSpace \
-value rgb -underline 0 -command {changeColorSpace rgb}
-.menu.file.m add radio -label "CMY color space" -variable colorSpace \
+.menu.file add radio -label "CMY color space" -variable colorSpace \
-value cmy -underline 0 -command {changeColorSpace cmy}
-.menu.file.m add radio -label "HSB color space" -variable colorSpace \
+.menu.file add radio -label "HSB color space" -variable colorSpace \
-value hsb -underline 0 -command {changeColorSpace hsb}
-.menu.file.m add separator
-.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
+.menu.file add separator
+.menu.file add radio -label "Automatic updates" -variable autoUpdate \
-value 1 -underline 0
-.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
+.menu.file add radio -label "Manual updates" -variable autoUpdate \
-value 0 -underline 0
-.menu.file.m add separator
-.menu.file.m add command -label "Exit program" -underline 0 \
- -command "destroy ."
-pack .menu.file -side left
+.menu.file add separator
+.menu.file add command -label "Exit program" -underline 0 -command {exit}
# Create the command entry window at the bottom of the window, along
# with the update button.
-frame .bot -relief raised -borderwidth 2
-pack .bot -side bottom -fill x
-label .commandLabel -text "Command:"
-entry .command -relief sunken -borderwidth 2 -textvariable command \
+labelframe .command -text "Command:" -padx {1m 0}
+entry .command.e -relief sunken -borderwidth 2 -textvariable command \
-font {Courier 12}
-button .update -text Update -command doUpdate
-pack .commandLabel -in .bot -side left
-pack .update -in .bot -side right -pady .1c -padx .25c
-pack .command -in .bot -expand yes -fill x -ipadx 0.25c
+button .command.update -text Update -command doUpdate
+pack .command.update -side right -pady .1c -padx {.25c 0}
+pack .command.e -expand yes -fill x -ipadx 0.25c
+
# Create the listbox that holds all of the color names in rgb.txt,
# if an rgb.txt file can be found.
-frame .middle -relief raised -borderwidth 2
-pack .middle -side top -fill both
-foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
- /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
- /usr/openwin/lib/X11/rgb.txt} {
- if ![file readable $i] {
+grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}
+
+grid columnconfigure . {1 2} -weight 1
+grid rowconfigure . 0 -weight 1
+foreach i {
+ /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
+ /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
+ /usr/openwin/lib/X11/rgb.txt
+} {
+ if {![file readable $i]} {
continue;
}
set f [open $i]
- frame .middle.left
- pack .middle.left -side left -padx .25c -pady .25c
- listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
+ labelframe .names -text "Select:" -padx .1c -pady .1c
+ grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
+ grid columnconfigure . 0 -weight 1
+ listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
-relief sunken -borderwidth 2 -exportselection false
- bind .names <Double-1> {
- tc_loadNamedColor [.names get [.names curselection]]
+ bind .names.lb <Double-1> {
+ tc_loadNamedColor [.names.lb get [.names.lb curselection]]
}
- scrollbar .scroll -orient vertical -command ".names yview" \
+ scrollbar .names.s -orient vertical -command ".names.lb yview" \
-relief sunken -borderwidth 2
- pack .names -in .middle.left -side left
- pack .scroll -in .middle.left -side right -fill y
+ pack .names.lb .names.s -side left -fill y -expand 1
while {[gets $f line] >= 0} {
- if {[llength $line] == 4} {
- .names insert end [lindex $line 3]
+ if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
+ .names.lb insert end $col
}
}
close $f
@@ -111,35 +114,33 @@ foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
# Create the three scales for editing the color, and the entry for
# typing in a color value.
-frame .middle.middle
-pack .middle.middle -side left -expand yes -fill y
-frame .middle.middle.1
-frame .middle.middle.2
-frame .middle.middle.3
-frame .middle.middle.4
-pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes
-pack .middle.middle.4 -side top -expand yes -fill x
+frame .adjust
foreach i {1 2 3} {
- label .label$i -textvariable label$i
+ label .adjust.l$i -textvariable label$i -pady 0
+ labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
-command tc_scaleChanged
- pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
+ pack .scale$i -in .adjust.$i
+ pack .adjust.$i
}
-label .nameLabel -text "Name:"
-entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
+grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c
+
+labelframe .name -text "Name:" -padx 1m -pady 1m
+entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \
-font {Courier 12}
-pack .nameLabel -in .middle.middle.4 -side left
-pack .name -in .middle.middle.4 -side right -expand 1 -fill x
-bind .name <Return> {tc_loadNamedColor $name}
+pack .name.e -side right -expand 1 -fill x
+bind .name.e <Return> {tc_loadNamedColor $name}
+grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
# Create the color display swatch on the right side of the window.
-frame .middle.right
-pack .middle.right -side left -pady .25c -padx .25c -anchor s
-frame .swatch -width 2c -height 5c -background $color
-label .value -textvariable color -width 13 -font {Courier 12}
-pack .swatch -in .middle.right -side top -expand yes -fill both
-pack .value -in .middle.right -side bottom -pady .25c
+labelframe .sample -text "Color:" -padx 1m -pady 1m
+frame .sample.swatch -width 2c -height 5c -background $color
+label .sample.value -textvariable color -width 13 -font {Courier 12}
+pack .sample.swatch -side top -expand yes -fill both
+pack .sample.value -side bottom -pady .25c
+grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2
+
# The procedure below is invoked when one of the scales is adjusted.
# It propagates color information from the current scale readings
@@ -147,19 +148,21 @@ pack .value -in .middle.right -side bottom -pady .25c
proc tc_scaleChanged args {
global red green blue colorSpace color updating autoUpdate
- if $updating {
+ if {$updating} {
return
}
- if {$colorSpace == "rgb"} {
- set red [format %.0f [expr [.scale1 get]*65.535]]
- set green [format %.0f [expr [.scale2 get]*65.535]]
- set blue [format %.0f [expr [.scale3 get]*65.535]]
- } else {
- if {$colorSpace == "cmy"} {
+ switch $colorSpace {
+ rgb {
+ set red [format %.0f [expr {[.scale1 get]*65.535}]]
+ set green [format %.0f [expr {[.scale2 get]*65.535}]]
+ set blue [format %.0f [expr {[.scale3 get]*65.535}]]
+ }
+ cmy {
set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
- } else {
+ }
+ hsb {
set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
[expr {[.scale2 get]/1000.0}] \
[expr {[.scale3 get]/1000.0}]]
@@ -169,8 +172,8 @@ proc tc_scaleChanged args {
}
}
set color [format "#%04x%04x%04x" $red $green $blue]
- .swatch config -bg $color
- if $autoUpdate doUpdate
+ .sample.swatch config -bg $color
+ if {$autoUpdate} doUpdate
update idletasks
}
@@ -182,16 +185,18 @@ proc tc_scaleChanged args {
proc tc_setScales {} {
global red green blue colorSpace updating
set updating 1
- if {$colorSpace == "rgb"} {
- .scale1 set [format %.0f [expr $red/65.535]]
- .scale2 set [format %.0f [expr $green/65.535]]
- .scale3 set [format %.0f [expr $blue/65.535]]
- } else {
- if {$colorSpace == "cmy"} {
- .scale1 set [format %.0f [expr (65535-$red)/65.535]]
- .scale2 set [format %.0f [expr (65535-$green)/65.535]]
- .scale3 set [format %.0f [expr (65535-$blue)/65.535]]
- } else {
+ switch $colorSpace {
+ rgb {
+ .scale1 set [format %.0f [expr {$red/65.535}]]
+ .scale2 set [format %.0f [expr {$green/65.535}]]
+ .scale3 set [format %.0f [expr {$blue/65.535}]]
+ }
+ cmy {
+ .scale1 set [format %.0f [expr {(65535-$red)/65.535}]]
+ .scale2 set [format %.0f [expr {(65535-$green)/65.535}]]
+ .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]]
+ }
+ hsb {
set list [rgbToHsv $red $green $blue]
.scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
.scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
@@ -209,14 +214,14 @@ proc tc_loadNamedColor name {
global red green blue color autoUpdate
if {[string index $name 0] != "#"} {
- set list [winfo rgb .swatch $name]
+ set list [winfo rgb .sample.swatch $name]
set red [lindex $list 0]
set green [lindex $list 1]
set blue [lindex $list 2]
} else {
- case [string length $name] {
- 4 {set format "#%1x%1x%1x"; set shift 12}
- 7 {set format "#%2x%2x%2x"; set shift 8}
+ switch [string length $name] {
+ 4 {set format "#%1x%1x%1x"; set shift 12}
+ 7 {set format "#%2x%2x%2x"; set shift 8}
10 {set format "#%3x%3x%3x"; set shift 4}
13 {set format "#%4x%4x%4x"; set shift 0}
default {error "syntax error in color name \"$name\""}
@@ -224,14 +229,14 @@ proc tc_loadNamedColor name {
if {[scan $name $format red green blue] != 3} {
error "syntax error in color name \"$name\""
}
- set red [expr $red<<$shift]
- set green [expr $green<<$shift]
- set blue [expr $blue<<$shift]
+ set red [expr {$red<<$shift}]
+ set green [expr {$green<<$shift}]
+ set blue [expr {$blue<<$shift}]
}
tc_setScales
set color [format "#%04x%04x%04x" $red $green $blue]
- .swatch config -bg $color
- if $autoUpdate doUpdate
+ .sample.swatch config -bg $color
+ if {$autoUpdate} doUpdate
}
# The procedure below is invoked when a new color space is selected.
@@ -240,26 +245,28 @@ proc tc_loadNamedColor name {
proc changeColorSpace space {
global label1 label2 label3
- if {$space == "rgb"} {
- set label1 Red
- set label2 Green
- set label3 Blue
- tc_setScales
- return
- }
- if {$space == "cmy"} {
- set label1 Cyan
- set label2 Magenta
- set label3 Yellow
- tc_setScales
- return
- }
- if {$space == "hsb"} {
- set label1 Hue
- set label2 Saturation
- set label3 Brightness
- tc_setScales
- return
+ switch $space {
+ rgb {
+ set label1 "Adjust Red:"
+ set label2 "Adjust Green:"
+ set label3 "Adjust Blue:"
+ tc_setScales
+ return
+ }
+ cmy {
+ set label1 "Adjust Cyan:"
+ set label2 "Adjust Magenta:"
+ set label3 "Adjust Yellow:"
+ tc_setScales
+ return
+ }
+ hsb {
+ set label1 "Adjust Hue:"
+ set label2 "Adjust Saturation:"
+ set label3 "Adjust Brightness:"
+ tc_setScales
+ return
+ }
}
}
@@ -271,20 +278,18 @@ proc changeColorSpace space {
proc rgbToHsv {red green blue} {
if {$red > $green} {
- set max $red.0
- set min $green.0
+ set max [expr {double($red)}]
+ set min [expr {double($green)}]
} else {
- set max $green.0
- set min $red.0
+ set max [expr {double($green)}]
+ set min [expr {double($red)}]
}
if {$blue > $max} {
- set max $blue.0
- } else {
- if {$blue < $min} {
- set min $blue.0
- }
+ set max [expr {double($blue)}]
+ } elseif {$blue < $min} {
+ set min [expr {double($blue)}]
}
- set range [expr $max-$min]
+ set range [expr {$max-$min}]
if {$max == 0} {
set sat 0
} else {
@@ -297,16 +302,14 @@ proc rgbToHsv {red green blue} {
set gc [expr {($max - $green)/$range}]
set bc [expr {($max - $blue)/$range}]
if {$red == $max} {
- set hue [expr {.166667*($bc - $gc)}]
+ set hue [expr {($bc - $gc)/6.0}]
+ } elseif {$green == $max} {
+ set hue [expr {(2 + $rc - $bc)/6.0}]
} else {
- if {$green == $max} {
- set hue [expr {.166667*(2 + $rc - $bc)}]
- } else {
- set hue [expr {.166667*(4 + $gc - $rc)}]
- }
+ set hue [expr {(4 + $gc - $rc)/6.0}]
}
if {$hue < 0.0} {
- set hue [expr $hue + 1.0]
+ set hue [expr {$hue + 1.0}]
}
}
return [list $hue $sat [expr {$max/65535}]]
@@ -319,27 +322,28 @@ proc rgbToHsv {red green blue} {
# Computer Graphics" by Foley and Van Dam.
proc hsbToRgb {hue sat value} {
- set v [format %.0f [expr 65535.0*$value]]
+ set v [format %.0f [expr {65535.0*$value}]]
if {$sat == 0} {
return "$v $v $v"
} else {
- set hue [expr $hue*6.0]
+ set hue [expr {$hue*6.0}]
if {$hue >= 6.0} {
set hue 0.0
}
scan $hue. %d i
- set f [expr $hue-$i]
+ set f [expr {$hue-$i}]
set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
- case $i \
- 0 {return "$v $t $p"} \
- 1 {return "$q $v $p"} \
- 2 {return "$p $v $t"} \
- 3 {return "$p $q $v"} \
- 4 {return "$t $p $v"} \
+ switch $i {
+ 0 {return "$v $t $p"}
+ 1 {return "$q $v $p"}
+ 2 {return "$p $v $t"}
+ 3 {return "$p $q $v"}
+ 4 {return "$t $p $v"}
5 {return "$v $p $q"}
- error "i value $i is out of range"
+ default {error "i value $i is out of range"}
+ }
}
}
@@ -356,3 +360,7 @@ proc doUpdate {} {
}
changeColorSpace hsb
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/timer b/library/demos/timer
index 5ac504c..5255403 100644
--- a/library/demos/timer
+++ b/library/demos/timer
@@ -5,36 +5,43 @@ exec wish "$0" "$@"
# timer --
# This script generates a counter with start and stop buttons.
#
-# RCS: @(#) $Id: timer,v 1.2 1998/09/14 18:23:30 stanton Exp $
+# RCS: @(#) $Id: timer,v 1.3 2001/10/29 16:23:33 dkf Exp $
-label .counter -text 0.00 -relief raised -width 10
+label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m
button .start -text Start -command {
- if $stopped {
+ if {$stopped} {
set stopped 0
+ set startMoment [clock clicks -milliseconds]
tick
+ .stop configure -state normal
+ .start configure -state disabled
}
}
-button .stop -text Stop -command {set stopped 1}
+button .stop -text Stop -state disabled -command {
+ set stopped 1
+ .stop configure -state disabled
+ .start configure -state normal
+}
pack .counter -side bottom -fill both
pack .start -side left -fill both -expand yes
pack .stop -side right -fill both -expand yes
-set seconds 0
-set hundredths 0
+set startMoment {}
+
set stopped 1
proc tick {} {
- global seconds hundredths stopped
- if $stopped return
+ global startMoment stopped
+ if {$stopped} {return}
after 50 tick
- set hundredths [expr $hundredths+5]
- if {$hundredths >= 100} {
- set hundredths 0
- set seconds [expr $seconds+1]
- }
- .counter config -text [format "%d.%02d" $seconds $hundredths]
+ set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}]
+ .counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]]
}
bind . <Control-c> {destroy .}
bind . <Control-q> {destroy .}
focus .
+
+# Local Variables:
+# mode: tcl
+# End: