#!/usr/local/bin/wish4.2
#
# $Source: /home/nlfm/Working/Griddler/RCS/griddler,v $
# $Date: 1997/06/04 13:05:15 $
# $Revision: 1.1 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 1997 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
proc columnup {n1 n2 op} {
    upvar #0 $n1 col
    grid columnconfigure .gr [string range $n1 6 end] $n2 $col($n2)
}
#
proc rowup {n1 n2 op} {
    upvar #0 $n1 col
    grid rowconfigure .gr [string range $n1 3 end] $n2 $col($n2)
}
#
proc grup {n1 n2 op} {
    upvar #0 $n1 gr
    grid .gr.$n2 -$n1 $gr($n2)
}
#
proc stup {n1 n2 op} {
    global n s e w
    grid .gr.$n2 -sticky $n($n2)$s($n2)$e($n2)$w($n2)
}
#
proc ctlFrame {nm} {
    global row rowspan column columnspan ipadx ipady padx pady
    foreach {x y} [grid info .gr.$nm] {
	switch -glob -- $x {
	-in {}
	-sticky { foreach j [split $y {}] {
		    global $j
		    set ${j}($nm) $j
		}
	   }
	-* {set [string range $x 1 end]($nm) $y}
	}
    }
    set f [frame .ctl.ct$nm -relief groove -borderwidth 2]
    grid columnconfigure $f 1 -weight 1
    grid columnconfigure $f 3 -weight 1
    grid [entry $f.ltxt -textvariable ltxt($nm) -bg $nm -width 20] - - - -pady 5
    grid [frame $f.st] - - - -sticky ew
    label $f.st.l -text sticky
    foreach x {n s e w} {
	global $x
	if ![info exists ${x}($nm)] { set ${x}($nm) {} }
	checkbutton $f.st.$x -text $x -variable ${x}($nm) -off {} -on $x
	trace variable ${x}($nm) w stup
    }
    grid $f.st.l $f.st.n $f.st.s $f.st.e $f.st.w -sticky ew -padx 5
    foreach {x y} {row rowspan column columnspan ipadx ipady padx pady} {
	label $f.l$x -text $x
	entry $f.e$x -textvariable ${x}($nm) -width 4
	trace variable ${x}($nm) w grup
	label $f.l$y -text $y
	entry $f.e$y -textvariable ${y}($nm) -width 4
	grid $f.l$x $f.e$x $f.l$y $f.e$y -sticky nsew
	trace variable ${y}($nm) w grup
    }
}
#
proc pick {nm} {
   global current
   grid remove .ctl.ct$current
   grid .ctl.ct$nm - - - -row 4 -sticky nsew
   .ctl.$current configure -relief raised
   .gr.$current configure -relief flat
   set current $nm
   .ctl.$nm configure -relief sunken
   .gr.$current configure -relief raised
}
#
proc gcframe {name indx what} {
    global ${what}$indx
    array set ${what}${indx} [grid ${what}configure .gr $indx]
    set f [frame $name.$what$indx]
    label $f.label -text "$what $indx"
    frame $f.data
    foreach x [array names ${what}$indx] {
	label $f.data.l$x -text [string range $x 1 end]
	entry $f.data.e$x -width 4 -textvariable ${what}${indx}($x)
	trace variable ${what}${indx}($x) w ${what}up
	grid $f.data.l$x $f.data.e$x
    }
    switch $what row { grid $f.label $f.data } \
      column { grid $f.label ; grid $f.data }
    return $f
}
#
wm withdraw .
#
toplevel .gr
wm title .gr Griddler
set colours {red yellow orange blue white green pink skyBlue lavender}
foreach x $colours {
    set ltxt($x) "$x label"
    label .gr.$x -bg $x -textvariable ltxt($x)
}

foreach {x y z} $colours { grid .gr.$x .gr.$y .gr.$z }

toplevel .ctl
wm resizable .ctl 0 0
wm title .ctl {Griddler Control Panel}
grid x [gcframe .ctl 0 column] [gcframe .ctl 1 column] [gcframe .ctl 2 column]
grid [gcframe .ctl 0 row] -row 1 -column 0 -pady 4
grid [gcframe .ctl 1 row] -row 2 -column 0 -pady 4
grid [gcframe .ctl 2 row] -row 3 -column 0 -pady 4
set rx 0
foreach {x y z} $colours {
    button .ctl.$x -width 2 -background $x -command "pick $x" \
      -highlightthickness 0
    button .ctl.$y -width 2 -background $y -command "pick $y" \
      -highlightthickness 0
    button .ctl.$z -width 2 -background $z -command "pick $z" \
      -highlightthickness 0
    grid x .ctl.$x .ctl.$y .ctl.$z -row [incr rx] -sticky nsew
    ctlFrame $x
    ctlFrame $y
    ctlFrame $z
}
set current white
grid .ctl.ctwhite - - - -row 4 -sticky nsew
.ctl.white configure -relief sunken
.gr.white configure -relief raised
grid [button .ctl.quit -text Quit -width 10 -command exit] - - -
