Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Ancient Tk "pack" syntax?

48 views
Skip to first unread message

Dave

unread,
Jul 10, 2015, 3:02:31 PM7/10/15
to
I'm really slow...
I finally upgraded to 8.6 from 8.5 and was pleased to find that none of
my Tcl scripts needed updating.

While looking for a RGB:HSV conversion script, I ran across the code
below from 1992. What really surprised me is that it worked (I might
have made a trivial tweak but I don't remember) for both 8.5 >and< 8.6. Wow!

The syntax is totally recognizable with the exception of the "pack"
command. Here's the question: is there still an online copy of the
documentation for "pack" from ca. 1992?

Ancient script is:

#!/afs/net/project/tcl/wish -f
#
# Selcol lets you select a color by twiddling RGB and/or HSL values.
#
# $Id: selcol.tcl,v 1.2 1992/04/10 22:55:31 sls Exp $
#
# $Log: selcol.tcl,v $
# Revision 1.2 1992/04/10 22:55:31 sls
# Edit via HLS as well as RGB.
#
# Revision 1.1 1992/03/03 00:12:48 sls
# Initial revision
#
#

set blue 216
set green 236
set red 170
set hue 0
set sat 0
set light 0

proc make.scale {name var to title} {
frame $name
scale $name.scale -command "update.color $var" -to $to
global $var
$name.scale set [set $var]
label $name.label -text $title
pack append $name $name.label {} $name.scale {}
}

set flag 0
proc update.color {var value} {
global flag
if {$flag == 1} {return}
set flag 1
global $var red green blue hue sat light
set $var $value
set color [format "#%02x%02x%02x" $red $green $blue]
catch {.patch configure -background $color}
.value delete @0 end
.value insert 0 $color
if {$var == "red" || $var == "blue" || $var == "green"} {
rgb.changed
} else {
hsl.changed
}
set flag 0
}

proc min args {
set x [lindex $args 0]
foreach y $args {
if {$y < $x} {set x $y}
}
return $x
}

proc max args {
set x [lindex $args 0]
foreach y $args {
if {$y > $x} {set x $y}
}
return $x
}

proc floor {x} {
if {$x < 0} {set t [expr {0-$x}]} {set t $x}
set s [format %.0f $t]
if {$t != $x} {return "-$s"} {return $s}
}

# The code for translating from RGB to HSL and HSL to RGB is ripped
# off from Fundamentals of Computer Graphics, Foley & Van Dam.

proc rgb.changed {} {
global red green blue hue sat light
set MIN [min $red $green $blue]
set MAX [max $red $green $blue]
set light [expr {($MIN+$MAX)/2}]
if {$MIN == $MAX} {
set sat 0
set hue 0
} else {
if {$light < 128} {
set sat [expr {(256*($MAX-$MIN))/($MAX+$MIN)}]
} else {
set sat [expr {(256*($MAX-$MIN))/(512-$MAX-$MIN)}]
}
set d [expr {$MAX-$MIN}].0
set rc [expr {($MAX-$red)/$d}]
set gc [expr {($MAX-$green)/$d}]
set bc [expr {($MAX-$blue)/$d}]
if {$red == $MAX} {
set hue [expr {$bc-$gc}]
} else {
if {$green == $MAX} {
set hue [expr {2+$rc-$bc}]
} else {
set hue [expr {4+$gc-$rc}]
}
}
set hue [expr {$hue*60}]
if {$hue < 0} {set hue [expr {$hue+360}]}
}
set hue [format %.0f $hue]
.scales.hue.scale set $hue
.scales.sat.scale set $sat
.scales.light.scale set $light
}

proc value {n1 n2 hue} {
if {$hue > 360} {set hue [expr {$hue-360}]}
if {$hue < 0} {set hue [expr {$hue+360}]}
if {$hue < 60} {
set r [expr {$n1+($n2-$n1)*$hue/60}]
} else {
if {$hue < 180} {
set r $n2
} else {
if {$hue < 240} {
set r [expr {$n1+($n2-$n1)*(240-$hue)/60}]
} else {
set r $n1
}
}
}
set r [format %.0f [floor $r]]
return $r
}

proc hsl.changed {} {
global red green blue hue sat light
if {$light < 128} {
set m2 [expr {$light*(255+$sat)/256.0}]
} else {
set m2 [expr {$light+$sat-$light*$sat/256.0}]
}
set m1 [expr {2*$light-$m2}]
if {$sat == 0} {
set red $light
set green $light
set blue $light
}
set red [value $m1 $m2 [expr {$hue+120}]]
set green [value $m1 $m2 $hue]
set blue [value $m1 $m2 [expr {$hue-120}]]
.scales.red.scale set $red
.scales.green.scale set $green
.scales.blue.scale set $blue
}

frame .patch -width 100 -height 100
entry .value -width 12
bind .value <1> {%W select from @0; %W select to end; }

frame .scales
set flag 1
make.scale .scales.red red 255 "Red"
make.scale .scales.green green 255 "Green"
make.scale .scales.blue blue 255 "Blue"
make.scale .scales.hue hue 360 "Hue"
make.scale .scales.sat sat 255 "Saturation"
make.scale .scales.light light 255 "Lightness"
pack append .scales .scales.red {left} .scales.green {left} .scales.blue
{left}
pack append .scales .scales.hue {left} .scales.sat {left} .scales.light
{left}
set flag 0

button .quit -command {exit} -text "Quit"

pack append . .scales {} .value {fill} .patch {expand} .quit {fill expand}
update

.patch configure -width [winfo width .] -height 100

update.color red $red




--
computerjock AT mail DOT com

Gerald W. Lester

unread,
Jul 10, 2015, 3:56:27 PM7/10/15
to
On 7/10/15 2:02 PM, Dave wrote:
>...
> The syntax is totally recognizable with the exception of the "pack" command.
> Here's the question: is there still an online copy of the documentation for
> "pack" from ca. 1992?

The pack is still supported (along with the place command) -- the
recommendation is just to use the grid command as, in most cases, it is easier.


Here are the links:
http://www.tcl.tk/man/tcl8.6/TkCmd/pack.htm
http://www.tcl.tk/man/tcl8.6/TkCmd/place.htm

> ...

--
+------------------------------------------------------------------------+
| Gerald W. Lester, President, KNG Consulting LLC |
| Email: Gerald...@kng-consulting.net |
+------------------------------------------------------------------------+

Dave

unread,
Jul 10, 2015, 5:05:12 PM7/10/15
to
On 7/10/2015 2:56 PM, Gerald W. Lester wrote:
> On 7/10/15 2:02 PM, Dave wrote:
>> ...
>> The syntax is totally recognizable with the exception of the "pack"
>> command.
>> Here's the question: is there still an online copy of the
>> documentation for
>> "pack" from ca. 1992?
>
> The pack is still supported (along with the place command) -- the
> recommendation is just to use the grid command as, in most cases, it is
> easier.
>
>
> Here are the links:
> http://www.tcl.tk/man/tcl8.6/TkCmd/pack.htm
> http://www.tcl.tk/man/tcl8.6/TkCmd/place.htm
>
>> ...
>

I was curious about the old syntax, specifically to:

pack append .scales .scales.hue {left} .scales.sat {left} .scales.light
{left}

pack append . .scales {} .value {fill} .patch {expand} .quit {fill expand}

For any recent Tk, I don't see an equivalent "pack slave... options...
slave... options..." nor the options being a simple list being
documented now. I can make educated guesses, but I wondered if the
original documentation is still online so I could accurately translate
it to the more modern syntax.

Neil Madden

unread,
Jul 10, 2015, 5:21:22 PM7/10/15
to
On 10/07/2015 22:05, Dave wrote:
[snip]
> I was curious about the old syntax, specifically to:
>
> pack append .scales .scales.hue {left} .scales.sat {left} .scales.light
> {left}
>
> pack append . .scales {} .value {fill} .patch {expand} .quit {fill expand}
>
> For any recent Tk, I don't see an equivalent "pack slave... options...
> slave... options..." nor the options being a simple list being
> documented now. I can make educated guesses, but I wondered if the
> original documentation is still online so I could accurately translate
> it to the more modern syntax.
>

This appears to document the old syntax:
http://www6.uniovi.es/tcl/tk8.0b1/pack-old.n.html

-- Neil

Dave

unread,
Jul 10, 2015, 7:16:16 PM7/10/15
to
On 7/10/2015 4:21 PM, Neil Madden wrote:
> This appears to document the old syntax:
> http://www6.uniovi.es/tcl/tk8.0b1/pack-old.n.html
>
> -- Neil
>

That's exactly what I was looking for, thanks.

If anyone at all is interested, then in the spirit of closure, here are
the patches to the original script to bring it up-to-date with respect
to pack's modern syntax:

--- coloredit.tcl.orig 2015-07-10 16:38:55 -0500
+++ coloredit.tcl 2015-07-10 18:08:53 -0500
@@ -26,7 +26,7 @@
global $var
$name.scale set [set $var]
label $name.label -text $title
- pack append $name $name.label {} $name.scale {}
+ pack $name.label $name.scale -side top
}

set flag 0
@@ -162,17 +162,19 @@
make.scale .scales.hue hue 360 "Hue"
make.scale .scales.sat sat 255 "Saturation"
make.scale .scales.light light 255 "Lightness"
-pack append .scales .scales.red {left} .scales.green {left}
.scales.blue {left}
-pack append .scales .scales.hue {left} .scales.sat {left} .scales.light
{left}
set flag 0

+pack .scales.red .scales.green .scales.blue .scales.hue .scales.sat
.scales.light -side left
+
button .quit -command {exit} -text "Quit"

-pack append . .scales {} .value {fill} .patch {expand} .quit {fill expand}
+pack .scales -side top
+pack .value -side top -fill both
+pack .patch -side top -expand true
+pack .quit -side top -fill both -expand true
+
update

.patch configure -width [winfo width .] -height 100

update.color red $red
-
-


0 new messages