#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}

# Stuart Cassoff
# November 2008

namespace eval gub {

package provide gub 0.1



#
#
#
proc gub {wheat} {
	set rg {}

	array set N {b -1 l -1 t -1 c -1 s -1 > -1 < -1 ^ -1 v -1 f -1 o -1 e -1}

	array set W [list \
		b button \
		l label \
		t text \
		c canvas \
		s scrollbar \
		f frame \
		o listbox \
		e entry \
	]

	array set C {}
	array set R {}

	set toprocess {}
	foreach l [split $wheat \n] {
		if {$l eq ""} { continue }
		if {[string index $l 0] eq "."} {
			set i [string first " " $l]
			set P([string range $l 1 $i-1]) [string range $l $i end]
		} elseif {[string index $l 0] eq ":"} {
			set i [string first " " $l]
			set G([string range $l 1 $i-1]) [string range $l $i end]
		} elseif {[string index $l 0] eq "|"} {
			set i [string first " " $l]
			set v [string range $l $i end]
			if {$v eq ""} { set v "-weight 1" }
			set C([string range $l 1 $i-1]) $v
		} elseif {[string index $l 0] eq "-"} {
			set i [string first " " $l]
			set v [string range $l $i end]
			if {$v eq ""} { set v "-weight 1" }
			set R([string range $l 1 $i-1]) $v
		} else {
			lappend toprocess $l
		}
	}


	set fr {}
	foreach l $toprocess {
		set zl {grid}
		if {[string length $l] % 2 != 0} { append l " " }
		set start 1
		foreach {c m} [split $l ""] {
			if {$c eq " " && $m eq " "} { set start 0;continue } elseif {$start} { set fr {} }
			set start 0
			set d {[}
			#set cc $c
			#switch -exact -- $c { < - > - ^ - v { set c s }	}
			lappend d $W($c)
			lappend d { $w.} $fr
			lappend d $c
			lappend d [set n [incr N($c)]]
			array unset p
			array set p {}
			if {[info exists P($c)]} {
				array set p $P($c)
			}
			if {[info exists P($c$n)]} {
				array set p $P($c$n)
			}
			if {$m ne "" && $m ne " " && [info exists P($c$m)]} {
				array set p $P($c$m)
			}
			lappend d { }
			lappend d [array get p]
			lappend d {]}

			if {[info exists G($c$m)]} {
				lappend d $G($c$m)
			}

			if {[llength $d] > 0} { lappend zl [join $d ""]; set d {} }

			if {$c eq "f"} { set fr $c$n.; lappend rg [join $zl]; set zl grid }
		}
		if {[llength $zl] > 1} { lappend rg [join $zl] }
	}

	lappend rg {}

	foreach {n v} [array get C] {
		lappend rg "grid columnconfigure \$w$n $v"
	}

	foreach {n v} [array get R] {
		lappend rg "grid rowconfigure \$w$n $v"
	}

	return [join $rg \n]
}
###


}; # End of gub namespace

# EOF

#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}

# Stuart Cassoff
# November 2008

namespace eval tkgub {

package require Tk
package require gub


#
#
#
proc gui {} {
	variable gui

	set w [set gui(w) {}]
	set W [set gui(W) $w.]

	foreach t {in out} {
		grid [set gui($t) [text $w.$t -height 10]] -sticky news
		bind $gui($t) <Control-Return> [namespace current]::run\;break
	}

	bind a <Key> [namespace current]::gubrun
	bind a <Control-Return> [namespace current]::gubrun\;break
	bind b <Control-Return> [namespace current]::run\;break
	bindtags $gui(in)  [linsert [bindtags $gui(in)] end a]
	bindtags $gui(out) [linsert [bindtags $gui(in)] end b]

	bind $W <Control-q> exit; bind $W <Control-Q> exit

	grid columnconfigure $W 0 -weight 1
	grid rowconfigure $W 0 -weight 1
	grid rowconfigure $W 1 -weight 1

	focus $gui(in)
}
###



#
#
#
proc gubrun {} {
	variable gui
	$gui(out) delete 1.0 end

	if {[catch {
		$gui(out) insert end [gub::gub [$gui(in) get 1.0 end]]
		run
	} err]} {
		$gui(out) delete 1.0 end
		$gui(out) insert end $::errorInfo
	}
	after 20 [list focus $gui(in)]
}
###


#
#
#
proc run {} {
	variable gui

	catch {destroy [set w $gui(w).test]}
	toplevel $w; bind $w <Control-q> exit; bind $w <Control-Q> exit

	eval [$gui(out) get 1.0 end-1c]
	after 20 [list focus $gui(out)]
}
###


gui


}; # End of gub namespace

# EOF