#!/bin/sh
# \
exec wish8.0 $0 $@

# This is an experimental abc helper app for the netscape browser. It
# expects a file name on its command line, which will generally be in
# /tmp/, and whose contents are abc code.
#
# It presents a number of options and pushbuttons and the  like,  and
# knows  how  to invoke abc2ps to format the abc into postscript, and
# then run ghostview to display the music.  The abc code is displayed
# in  a text widget, which you can edit and save into a local file if
# you wish.
#
# Now if I could only figure out how to replicate abc2ps's output  on
# on a tk canvas ...
#
# Author: John Chambers <jc@trillian.mit.edu>

set basename ?
set a2pcmd {jcabc2ps +n +F_80}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc abc2ps {} {
	global D me errmsg pscmd psname dir basename
	if {$D} {puts "$me/abc2ps: basename=\"$basename\" pscmd=\"$pscmd\""}
	set errmsg {}
	busy "exec $pscmd"
	if ![file exists $psname] {set errmsg "$psname doesn't exists"}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Routine to produce a "busy" cursor while doing something.
proc busy {cmds} {
	global errorInfo
	set busy {.app .root}
	set list [winfo children .]
	while {$list != ""} {
		set next {}
		foreach w $list {
			set class [winfo class $w]
			set cursor [lindex [$w config -cursor] 4]
			if {[winfo toplevel $w] == $w || $cursor != ""} {
				lappend busy [list $w $cursor]
			}
			set next [concat $next [winfo children $w]]
		}
		set list $next
	}
	foreach w $busy {
		catch {[lindex $w 0] config -cursor watch}
	}
	update idletasks
	set error [catch {uplevel eval [list $cmds]} result]
	set ei $errorInfo
	foreach w $busy {
		catch {[lindex $w 0] config -cursor [lindex $w 1]}
	}
	if $error {
		error $result $ei
	} else {
		return $result
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc chnam {n} {
	global D me a2pcmd filename dir dspcmd errmsg pscmd psname basename suf
	if {$D} {puts "$me/chnam: n=\"$n\""}
	set filename $n
	if [regexp {(.*)\.([A-Za-z0-9_]*)$} $filename {} basename suf] {
	} else {
		set basename $filename
		set suf {}
	}
	if {$D} {puts "$me/chnam: basename=\"$basename\" suf=\"$suf\""}
	if {$basename != {}} {
		set psname $basename.ps
		set pscmd "$a2pcmd $filename > $psname"
	}
	load
	if ![file exists $psname] {set errmsg "$psname doesn't exists"}
	set dspcmd "ghostview $psname"
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc dirmenu {X Y} {
	global D me dir
	if {$D} {puts "$me/dirmenu: X=$X Y=$Y"}
	set cmd "ls -Ca1F $dir"
	if [catch {open "| $cmd"} p] {
		if {$D} {puts "$me: Can't run \"$cmd\" ($p)"}
		return
	}
	if [winfo exists .dirmenu] {destroy .dirmenu}
	menu .dirmenu -tearoff no -activeborderwidth 0
	while {![eof $p]} {
		set line [gets $p]
		if [regexp {(.*)\/$} $line {} d] {
			.dirmenu add command -label $d -command "newdir $d"
		}
	}
	tk_popup .dirmenu $X $Y
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc display {} {
	global D E me dspcmd
	eval exec $dspcmd &
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc edit {} {
	global D E me filename
	exec xterm -e $E $filename &
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Find {} {
	global D P errmsg me srchlen srchndx srchval
	if {$D>2} {puts "$me: Find \"$srchval\" at $srchndx"}
	if ![winfo exists .abc.txt] {mktxt}
	set srchndx [.abc.txt search -nocase -count srchlen -regexp $srchval $srchndx]
	if {$srchndx != {}} {
		if {$D>2} {puts "$me: Found at srchndx=$srchndx len=$srchlen"}
		set errmsg {}
		.abc.txt tag remove sel 1.0 end
		.abc.txt tag add sel $srchndx "$srchndx + $srchlen char"
		.abc.txt see $srchndx
		set srchndx [.abc.txt index "$srchndx + $srchlen char"]
	} else {
		set srchndx 1.0
		set errmsg {Not found}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Read in an abc file.
proc load {} {
	global D dir errmsg filename me curL
	if {$D>1} {puts "$me/load: filename=\"$filename\""}
	if ![winfo exists .abc.txt] {mktxt}
	.abc.txt delete 1.0 end
	if [catch {open $filename r} f] {
		if {$D>1} {puts "$me: Can't load $filename ($f)"}
		set errmsg $f
		return
	}
	set curL 0
	while {[gets $f line] >= 0} {
		incr curL
		if {$D>4} {puts "$me/load: Line $curL \"$line\""}
		.abc.txt insert end "$line\n"
	}
	close $f
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc gif {args} {
	global D E errmsg me gspath basename gifres pnmcrop ppmtogif
	set cmd "$gspath -q -DNOPAUSE -sDEVICE=ppmraw -r${gifres} -sOutputFile=\"|$pnmcrop|$ppmtogif $args >$basename.gif\" -- $basename.eps"
	if {$D>1} {puts "$me/gif: cmd=\"$cmd\""}
	if [catch {eval exec $cmd} err] {
		set errmsg $err
	} else {
		exec xv $basename.gif &
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc mktxt {} {
	global B D EC me FB
	eval frame .abc $FB
	eval frame .abc.s -bd 0
	eval pack .abc.s -in .abc -side right -fill y
	eval text .abc.txt $FB $EC -width 60 -height 10 -bd 0 -relief ridge \
			-yscrollcommand {{.abc.s.y set}} \
			-xscrollcommand {{.abc.sbx set}} \
			-wrap none -bd 3 -relief flat
	eval scrollbar .abc.s.y -command {{.abc.txt yview}} -bd 1 -width 10 -orient vertical
	eval scrollbar .abc.sbx -command {{.abc.txt xview}} -bd 1 -width 10 -orient horizontal
	eval button    .abc.s.x -command {{puts *}} -bd 0 -text * -padx 0 -pady 0
	eval pack .abc.s.x -in .abc.s -side bottom -fill x
	eval pack .abc.s.y -in .abc.s -side top -fill y -expand 1
	eval pack .abc.sbx -in .abc -side bottom -fill x
	eval pack .abc.txt -in .abc -side left -expand 1 -fill both
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc nammenu {X Y} {
	global D me dir
	if {$D} {puts "$me/nammenu: X=$X Y=$Y"}
	set files [lsort [glob $dir/*]]
	if {$D>4} {puts "$me/nammenu: files={$files}"}
	if [winfo exists .nammenu] {destroy .nammenu}
	set M .nammenu
	set l 0
	menu $M -tearoff no -activeborderwidth 0
	$M add cascade -label {MORE ...} -menu $M.x
	menu $M.x -tearoff no -activeborderwidth 0
	foreach d [split $files " "] {
		if [regexp {.*/(.*)$} $d {} n] {
			$M add command -label $n -command "chnam $n"
			if {[incr l] > 25} {
				if {$D>4} {puts "$me/nammenu: l=$l > 25; cascade ..."}
				set l 0
				set M $M.x
				$M add cascade -label {MORE ...} -menu $M.x
				menu $M.x -tearoff no -activeborderwidth 0
				if {$D>4} {puts "$me/nammenu: Cascade is $M"}
			}
		}
	}
	tk_popup .nammenu $X $Y
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc newdir {new} {
	global D me dir errmsg
	if {$D>2} {puts "$me/newdir: dir=\"$dir\" new=\"$new\""}
	set d $dir/$new/
	if [catch {cd $d}] {
		set errmsg "Can't cd to \"$d\""
		if {$D>0} {puts "$me/newdir: $errmsg"}
	} else {
		set dir $d
		if {$D>2} {puts "$me/newdir:     dir=\"$dir\""}
		if [set m [regsub -all {//} $dir / dir]] {	;### LOOPS HERE ###
			if {$D>2} {puts "$me/newdir: m=$m dir=\"$dir\" (/)"}
		}
		if {$D>2} {puts "$me/newdir: m=$m dir=\"$dir\""}
		if [set m [regsub -all {/[^/]+/\.\./} $dir / dir]] {
			if {$D>2} {puts "$me/newdir: m=$m dir=\"$dir\" (..)"}
		}
		if {$D>2} {puts "$me/newdir: m=$m dir=\"$dir\""}
	}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc print {} {
	global D E me
	exec lpr $psname &
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc save {} {
	global D me dir filename
	if {$D} {puts "$me/save: filename=\"$filename\""}
	if ![winfo exists .abc.txt] {mktxt}
	if [catch {open $filename w} f] {
		if {$D} {puts "$me/save: $filename $f"}
		return
	}
	set l 1
	set e [.abc.txt index end]
	while {$l < $e} {
		set line [.abc.txt get $l.0 $l.end]
		if {$D} {puts "$me/save: line $l: \"$line\""}
		puts $f $line
		incr l
	}
	close $f
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc saveas {} {
	global D me dir filename
	if {$D} {puts "$me/saveas: filename=\"$filename\""}
	if ![winfo exists .saveas] {
		toplevel .saveas
		entry  .saveas.f -textvariable filename -width 0
		pack   .saveas.f -in .saveas -side top -fill x -expand 1
		frame  .saveas.b
		button .saveas.b.save -text save -command {save; destroy .saveas}
		button .saveas.b.cancel -text cancel -command {destroy .saveas}
		pack   .saveas.b.save .saveas.b.cancel -in .saveas.b -side left -expand 1
		pack   .saveas.b -in .saveas -side bottom
	}
	wm deiconify .saveas
	raise .saveas
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Stopped {} {
	global D me xx yy
	if {$D>2} {puts "$me/Stopped at xx,yy=$xx,$yy."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
set me [lindex [wm title .] 0]
set H [exec hostname]
wm title . "$me on $H"
if [info exists env(D_$me)] {set D $env(D_$me)} else {set D 0}
if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 3}
if [info exists env(R_$me)] {set R $env(R_$me)} else {set R ridge}
if [info exists env(P_$me)] {set P $env(P_$me)} else {set P 2}	;# Padding.
if [info exists env(S_$me)] {set S $env(S_$me)} else {set S 6}	;# Scale size.
if [info exists env(EDITOR)] {set E $env(EDITOR)} else {set E vi}

# Set up some Help-key bindings, if we can find Help.w:
foreach d [split $env(PATH) :] {if [file exists $d/Source.w] {source $d/Source.w;break}}
Source Help.w

if ![info exists env(SHELL)] {set env(SHELL) /bin/sh}

# Some common args:
set PP {-padx 0 -pady 0}
set R ridge
set BR "-bd $B -relief $R"
set BC "-bd $B -bg grey40 -fg yellow -activebackground yellow -activeforeground navy $PP"
set LC {-bg grey30 -fg green}
set EC {-bg grey30 -fg yellow}
set XC {-bg navy -fg green}
set BW {-width 5}
set FB {-bd 0 -relief ridge}
set EX {-expand 1 -fill x}
set EB "-bd $B -relief ridge $EC"
set MC {-bg navy -fg green -bd 4 -relief ridge}

set gspath   gs;		# [exec which gs]
set pnmcrop  pnmcrop;	# [exec which pnmcrop]
set ppmtogif ppmtogif;	# [exec which ppmtogif]

eval entry  .e $EB -textvariable errmsg
eval frame  .b $FB	;# Frame to hold a row of pushbuttons:
eval frame  .f $FB	;# Frame for file access.

eval menubutton .b.cmds $MC -text Cmds -menu .b.cmds.menu
eval pack   .b.cmds -in .b -side left -expand 1
eval menu   .b.cmds.menu  -activeborderwidth 0
.b.cmds.menu add command -label Load -command load
.b.cmds.menu add command -label Save -command save
.b.cmds.menu add command -label {Save as ...} -command saveas
.b.cmds.menu add command -label Print -command print
.b.cmds.menu add command -label Quit -command exit

eval button .b.show $BC -text {format+display} -command {{abc2ps;display}}
eval pack   .b.show -in .b -side left -expand 1
eval button .b.load $BC -text load -command load
eval pack   .b.load -in .b -side left -expand 1
eval button .b.edit $BC -text edit -command edit
eval pack   .b.edit -in .b -side left -expand 1
eval button .b.save $BC -text save -command save
eval pack   .b.save -in .b -side left -expand 1
eval button .b.exit $BC -text exit -command exit
eval pack   .b.exit -in .b -side right -expand 1

eval frame .b.dbg -bd 2 -relief ridge
eval menubutton .b.dbg.l $MC -text Dbg -menu .b.dbg.l.menu
eval menu .b.dbg.l.menu $MC -activeborderwidth 0
.b.dbg.l.menu add command -label Up    -command {incr D}
.b.dbg.l.menu add command -label Down  -command {incr D -1}
.b.dbg.l.menu add command -label Clear -command {set D 0}
eval entry .b.dbg.v -textvariable D -width 0
eval pack .b.dbg.l .b.dbg.v -in .b.dbg -side left
eval pack .b.dbg -in .b -side right

set gifres 100
eval frame .b.gif -bd 2 -relief ridge
eval menubutton .b.gif.l $MC -text gif -menu .b.gif.l.menu
eval menu .b.gif.l.menu $MC
.b.gif.l.menu add command -label plain  -command {gif}
.b.gif.l.menu add command -label interlace  -command {gif -interlace}
eval entry .b.gif.v -textvariable gifres -width 0
eval pack .b.gif.l .b.gif.v -in .b.gif -side left
eval pack .b.gif -in .b -side right

set cwd [exec pwd]
if [file isdir $cwd/abc] {
	if {$D>2} {puts "$me: $cwd/abc is directory."}
	set dir $cwd/abc/
} elseif [file isdir $cwd/music/abc] {
	if {$D>2} {puts "$me: $cwd/music/abc is directory."}
	set dir $cwd/music/abc/
} elseif [file isdir $cwd/music] {
	if {$D>2} {puts "$me: $cwd/music is directory."}
	set dir $cwd/music/
} else {
	if {$D>2} {puts "$me: $cwd is default directory."}
	set dir $cwd/
}

eval frame .f.dir $FB
eval pack  .f.dir -in .f -fill x
eval label .f.dir.lbl $MC -width 9 -text Directory
bind .f.dir.lbl <1> {dirmenu %X %Y}
eval entry .f.dir.val $EB -textvariable dir
eval pack  .f.dir.lbl -in .f.dir -side left
eval pack  .f.dir.val -in .f.dir -side right $EX

eval frame .f.nam $FB
eval pack  .f.nam -in .f $EX
eval label .f.nam.lbl $MC -width 9 -text File
bind .f.nam.lbl <1> {nammenu %X %Y}
eval entry .f.nam.val $EB -textvariable filename
eval pack  .f.nam.lbl -in .f.nam -side left
eval pack  .f.nam.val -in .f.nam -side right $EX

eval frame  .f.cmd $FB
eval pack   .f.cmd -in .f $EX
eval button .f.cmd.but $BC -width 9 -text Format -command abc2ps
eval entry  .f.cmd.val $EB -textvariable pscmd
eval pack   .f.cmd.but -in .f.cmd -side left
eval pack   .f.cmd.val -in .f.cmd -side right $EX

eval frame  .f.dsp $FB
eval pack   .f.dsp -in .f $EX
eval button .f.dsp.but $BC -width 9 -text Display -command display
eval entry  .f.dsp.val $EB -textvariable dspcmd
eval pack   .f.dsp.but -in .f.dsp -side left
eval pack   .f.dsp.val -in .f.dsp -side right $EX

eval frame  .f.srch -bd $B -relief $R
eval pack   .f.srch -fill x
eval button .f.srch.lbl $BC -width 9 -text Find -command Find
eval entry  .f.srch.val -textvariable srchval
eval pack   .f.srch.lbl -in .f.srch -side left
eval pack   .f.srch.val -in .f.srch -side left -fill x -expand 1
bind .f.srch.val <Return> Find
set srchlen 0
set srchndx 1.0
set srchval {}

mktxt

pack  .b -fill x
pack  .e -fill x
pack  .f -fill x
pack  .abc -expand 1 -fill both

if {$D>1} {puts "$me: argv={$argv}"}
set filnam [lindex $argv 0]
if {$D>1} {puts "$me: filnam=\"$filnam\""}

chnam $filnam