#!/dis/sh
# interactive demo. run with no arguments. picks up possible demos from
# the *.demo directories.
load tk

font=/fonts/lucida/latin1CW.10.font
nl='
'

fn shctl {
	echo ${quote $*} > /chan/shctl
}

# ${vbind block [var...]}
# give the named vars their current values when block
# comes to be executed.
subfn vbind {
	if {no $*} {
		echo 'usage: ${vbind block [var ...]}' >[1=2]
		raise usage
	}
	result = ''
	apply {
		result=$result^${quote $1}^':='^${quote $$1}^';'
	} ${tl $*}
	result = ${parse '{'^$result^${hd $*}^' $*}'}
}

# show a sequence of buttons, each an associated action.
# also allow typing at the console.
# it expects as its argument a list of (label, script) pairs.
# when script is evaluated, it should set $result to a string
# to be sent to the shell.
fn dodemo {
	load tk
	chan event kbd
	cmds := $*
	if {~ $#cmds 0} {
		raise 'no commands'
	}

	while {} {
		x := "{read}
		if {! ~ $x ''} {
			x=$x^$nl
		}
		send event $x
	} < /chan/shctl &

	while {} {
		getlines {
			send kbd $line^$nl
		}
		send kbd ''
	} &

	subfn valof {
		$*
	}
	
	{
		while {! ~ $#cmds 0} {
			(label cmd cmds) = $cmds
			cmd = ${valof $cmd}
			shctl clear
			shctl action $label $cmd
			chan := kbd
			while {~ $chan kbd} {
				(chan x) = ${alt event kbd}
				if {~ $chan event} {
					echo -n $x >[1=2]
					if {~ $x ''} {
						echo -n '' >[1=2]
					}
				}
				echo -n $x
			}
		}
		kill -g ${pid}
	} | $executor
}

{
	pctl newpgrp
	wid=${tk window 'Demos'}
	tk $wid update
	fn x { a := $*; or {tk $wid $a} {echo error on tk cmd $"a':' $status }}
	while {} {tk winctl $wid ${recv $wid}} &
	chan cmd
	tk namechan $wid cmd
	
	for (i in *.demo) {
		(name nil) := ${split '.' $i}
		x button .^$name -text ${tkquote $name} -command '{send cmd' ${vbind {
				(wm/sh
					-f $font
					-w 1000 -h 800
					-c {
						pctl forkns
						cd $i
						executor := {sh -i}
						run demo
					}
				)
			} i} '}'
		x pack .^$name -side top -anchor w -fill x
	}
	tk onscreen $wid
	x update
	while {} {
		${recv cmd}		# execute shell command sent by button
	}
} &