diff options
Diffstat (limited to 'library')
-rw-r--r-- | library/demos/rmt | 35 | ||||
-rw-r--r-- | library/demos/tcolor | 280 | ||||
-rw-r--r-- | library/demos/timer | 35 |
3 files changed, 185 insertions, 165 deletions
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: |