''[MGS] [[2004/03/19]]'' - A quick implementation of the X11 '''xcolors''' program. #!/bin/sh # \ if (test -z "$WISH"); then export WISH=wish; fi # \ exec "$WISH" "$0" -name wish ${1+"$@"} # ==================================================================== # # xcolors.tcl -- # Display all X colors. # Version : 0.0.1 # Author : Mark G. Saye # Email : markgsaye@yahoo.com # Copyright : Copyright (C) 2004 # Date : March 19, 2004 # See the file "license.txt" or "LICENSE.html" for information on usage # and distribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ==================================================================== # proc bg {c t} { set name [lindex [$c itemcget current -tags] 0] $t configure -bg $name } # ==================================================================== # proc fg {c t} { set name [lindex [$c itemcget current -tags] 0] $t configure -fg $name } # ==================================================================== # proc import {file} { global rgb global rgbs catch {array unset rgb} set rgbs [list] if { [catch {open $file r} f] } { puts stderr "\[$::errorCode\] $f" return } while { [gets $f line] > -1 } { if { [string match !* $line] } { continue } foreach {r g b} [string range $line 0 10] { break } set name [string trim [string range $line 11 end]] set rgb($name) [list $r $g $b] lappend rgbs $name } close $f } # ==================================================================== # proc resize {c w h} { global rgb global rgbs global width if { $width == $w } { return } set width $w $c delete all set t 10 set dx 4 set dy 4 set x 0 set y $dy set i -1 foreach name $rgbs { incr i incr x $dx set text [$c create text 0 0 \ -text $name \ -anchor nw \ -font $c \ -tags [list $name] \ ] foreach {W N E S} [$c bbox $text] { break } set tw [expr {$E - $W}] set th [expr {$S - $N}] set x1 [expr {$x+$t/2}] set y1 [expr {$y+$t/2}] set x2 [expr {$x1 + $tw + $t}] set y2 [expr {$y1 + $th + $t}] if { [expr {$x2+$t/2}] > $w } { set x $dx foreach {W N E S} [$c bbox all] { break } set y [expr {$S+$dy}] set x1 [expr {$x+$t/2}] set y1 [expr {$y+$t/2}] set x2 [expr {$x1 + $tw + $t}] set y2 [expr {$y1 + $th + $t}] } $c create rectangle $x1 $y1 $x2 $y2 \ -width $t -outline $name \ -tags [list $name] $c move $text [expr {$x1+$t/2}] [expr {$y1+$t/2}] set x [expr {$x2+$t/2}] # if { $i >= 2 } { break } } foreach {N W S E} [$c bbox all] { break } $c configure -scrollregion [list 0 0 $S $E] } # ==================================================================== # proc main {args} { global width ; set width 0 if { [llength $args] } { set file [lindex $args 0] } else { set file /usr/X11R6/lib/X11/rgb.txt } text .t -height 3 .t insert end \ "Button 1 sets the text color, button 2 sets the background. Press q to quit. You can also type new text here." canvas .c -yscrollcommand [list .y set] scrollbar .y -orient vertical -command [list .c yview] font create .c -family courier -size 7 pack .t -side top -expand 0 -fill x pack .y -side left -expand 0 -fill y pack .c -side right -expand 1 -fill both import $file bind . exit bind .c [list resize .c %w %h] .c bind all [list fg .c .t] .c bind all [list bg .c .t] } # ==================================================================== # if { [info exists argv0] && [string equal [info script] $argv0] } { eval [linsert $argv 0 main] } return # ==================================================================== # ---- See also: * [colors] * [Named Colors] * [Xlib]