#!/afs/ece/usr/tcl/bin/wish -f

# To run this program, you should make sure the top line reflects the location
# of wish on your system, and the following variables represent the locations
# of beth and an rgb.txt file to look at.

# File with list of colors in format "[red][green][blue]	[name]"
set color_file "/usr/lib/X11/rgb.txt"
# Location of Beth source directory.
set beth_dir "/afs/ece/usr/svoboda/src/beth"

# Takes [-o starting_color] as an optional argument. Any other arguments get
# passed to Beth. If no starting color is given, defaults to first one in file.
# Tkcolors colors each line with its own color, until the end of the page.
# Scrolling the text re-does the coloring, so the screen is always full of
# colors. (this presents a virtual set of colors that may exceed the capacity
# of the current colormap). Note that the colors may not be updated uniformly
# through scrolls, so the user should press button 1 after a scroll to update
# the colors.

set index [lsearch $argv -o]
if {$index != -1} {
	set sc [expr $index + 1]
	set color_start [lindex $argv $sc]
	set argv [lreplace $argv $index $sc]
	incr argc -2
} else {set color_start ""}
set option $color_file
set configs "-b $argv"
set embedded 1
set dont_change_title 1
wm title . "TK Colors"
wm iconname . "TK Colors"
source $beth_dir/beth.tcl

# Wait until file starts coming in...
while {[string length [$text get 1.0 end]] == 0} {
	after 100
	update ; update idletasks
}

# Go to color specified by argv
if {($color_start != "")} {
	set char [string first "	$color_start\n" [$text get 1.0 end]]
	scan [$text index "1.0 +$char chars"] "%d" color_line
} else {set color_line 1}
$text mark set insert $color_line.0	; $text yview insert
set top_line $color_line.0

proc allocate_colors {t} {
	set line [$t index @0,0]
	set limit [lindex [$t configure -height] 4]
	for {set c 0} {$c <= $limit} {incr c} {
		set tabend "$line +[string last "	" [$t get $line "$line lineend"]] chars +1 chars"
		set tabstart "$tabend -2 chars"
		set color [$t get $tabend "$tabend lineend"]
		$t tag add tag$c $tabstart $tabend
		$t tag add Color $tabstart $tabend
		$t tag configure tag$c -background $color
		set line [$t index "$line +1 line"]
}}

proc deallocate_colors {t} {
	set color_tags ""
	set limit [lindex [$t configure -height] 4]
	for {set c 0} {$c <= $limit} {incr c} {
		lappend color_tags tag$c
	}
	eval $t tag delete $color_tags
}

proc redo_colors_and_scroll {args} {
	global text top_line frame
	eval .ts.s set $args
	if {$top_line != [$text index @0,0]} {
		set top_line [$text index @0,0]
		deallocate_colors $text
		allocate_colors $text
# At this point the display should be updated, but update doesn't seem to work.
}}

$text configure -width 50 -yscrollcommand "redo_colors_and_scroll"
allocate_colors $text
