#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# vperl.tcl
# prototype perl testing program
#
global verbose ; set verbose 1
global ownwindow ; set ownwindow 1
global version ; set version 1.0
#
if {$verbose>=1} {
    puts "    vperl version $version          David J C MacKay 2000"
    puts "                                    written under tcl 8 on linux"
    puts "Shortcodes: C-d / Return and C-c"
}
if {$ownwindow>=1} {
    wm geometry . +10+10
    wm title . "vperl"
    wm iconname . "vperl"
}

frame .text -background "#008877" -width 6i -height 5i
pack .text -fill both
set  w .text
frame $w.but
pack $w.but -side top -fill x -expand 1
button $w.dismiss -text Quit -command "destroy ."
button $w.help -text Help -command "help"

 button .di -text Doit -command "doit" 
 button .di2 -text Doit -command "doit" 
pack $w.dismiss .di2 $w.help -in $w.but -side left -fill x -expand 1 -anchor w
pack .di -side bottom -anchor w  -fill x -expand 1

set w .text
global EDstatus_old ; set EDstatus_old 0 
set EDstatus encoding
# label $w.msg -wraplength 4i -justify left -textvariable EDstatus
# pack $w.msg -side top
# input output and perl program
set wi $w.i ;  set wo $w.o ; set wp $w.p
set wpr [frame $w.problock]
set we $w.p.e
frame $wi ;  frame $wo; frame $wp ; frame $we 
set font "Courier 13"
set back "gray90"

label $wp.t -text "Program: " -width 9 -justify right
label $wi.t -text "Input: " -width 9 -justify right
label $wo.t -text "Output: " -width 9 -justify right
label $we.t -text "Errors: " -width 9 -justify right

frame $w.status
pack $w.status $w.i  $w.p $w.o  -side left -fill x

set size(input) 32
set size(output) 32
set size(error) 6
set size(preprogram) 5
set size(program) 8
set size(postprogram) 4
set width 35

# large blocks of text: 
foreach i {input output error} { 
    frame $w.$i
    set s $w.$i
    text $s.text -width $width -height $size($i) -yscrollcommand "$s.scroll set"  -xscrollcommand "$s.scrollx set" -wrap none -background white -insertofftime 0 -font $font  -borderwidth 1 
    scrollbar $s.scroll -command "$s.text yview"  -borderwidth 1  -width 5
    scrollbar $s.scrollx -orient horiz  -command "$s.text xview"   -borderwidth 1  -width 3
    pack $s.scroll -side right -fill y
    pack $s.scrollx -side bottom -fill x
    pack  $s.text -side left
#    set command "pack "
#    append command " \$w.$i"
#    append command " -side top -fill x"
#    eval $command
}
# small blocks of text: 
foreach i {preprogram program postprogram} { 
    frame $w.$i
    set s $w.$i
#    puts "text object will be in $s.text \n"
    text $s.text -width $width -height $size($i) \
	    -yscrollcommand "$s.scroll set"  -xscrollcommand "$s.scrollx set" \
	    -wrap none -background  "#74efdd" -insertofftime 0  -font $font  -borderwidth 1 
    scrollbar $s.scroll -command "$s.text yview"  -borderwidth 1  -width 5
    pack $s.scroll -side right -fill y
    scrollbar $s.scrollx -orient horiz  -command "$s.text xview"  -borderwidth 1  -width 3
    pack $s.scrollx -side bottom -fill x
    pack $s.text -side left
    set command "pack "
    append command " \$w.$i"
    append command " -in $w.problock -side top -fill x"
    eval $command
}

pack $wp.t $w.problock  -in $wp -side top -anchor n
pack $wi.t $w.input    -in $wi -side top -anchor n
pack $wo.t $w.output -in $wo  -side top -anchor n
pack $we.t $w.error -in $we  -side top -anchor n
#pack $wo.l $wo.labels $wo.lb -side right
#pack $wi.l $wi.labels $wi.lb -side right

set name(i) input
set name(o) output
set name(e) error
set name(p) program
set filee ERRORS

pack $we -in $wp -side bottom

foreach i { i } {
    set s [frame $w.$i.file]
    set file$i [set name($i)].dat
    entry $s.file -width 11 -textvariable file$i -background "#ffff00"  -font $font 
    checkbutton $s.butc -padx 1 -pady 1 -text "Clobber" -variable clobber
    button $s.butw -text "Save" -padx 1 -pady 1 -command "writetofile file$i $i"
    button $s.butr -text "Read" -padx 1 -pady 1 -command "loadFile file$i $i ; set clobber 0"
    pack $s.butc  $s.butw $s.file $s.butr -side left -in $s
    pack $s
}
foreach i { p } {
    set s [frame $w.$i.file]
    set sr1 [frame $w.$i.file.row1]
    set sr2 [frame $w.$i.file.row2]
    set file$i [set name($i)].p
    entry $s.file -width 11 -textvariable file$i -background "#ffff00"  -font $font 
    entry $s.options -width 21 -textvariable options  -background "#ffff00"  -font $font 
    button $s.butw -text "Save" -padx 1 -pady 1 -command "writetofile file$i $i"
    button $s.butr -text "Read" -padx 1 -pady 1 -command "loadFile file$i $i "
    label $s.optionsl -text "Command line: " -width 12 -justify right
    
    pack   $s.butw $s.file $s.butr -side left  -in $sr1
    pack   $s.optionsl $s.options -side left -in $sr2
    pack $s -side top
    pack $sr1 $sr2 -side top
#    append command " $s"
}
foreach i { o } {
    set s [frame $w.$i.file]
    set file$i [set name($i)].dat
    entry $s.file -width 11 -textvariable file$i -background "#ffff00"  -font $font 
    button $s.butw -text "Save" -padx 1 -pady 1 -command "writetofile file$i $i "
    pack   $s.butw $s.file  -side left 
    pack $s
#    append command " $s"
}
foreach i { e } {
    set s [frame $w.efile]
    pack $s -in $we -side bottom
    set file$i [set name($i)].dat
    entry $s.file -width 11 -textvariable file$i -background "#ffff00"  -font $font 
    pack    $s.file  -side bottom  
#    append command " $s"
}
set clobber 1

proc doit { } {
    global clobber options filep filei fileo filee
    if {$clobber} {
	writetofile filei i
    } else { loadFile  filei i }
    writetofile filep p
    exec chmod 755 $filep  
    if {[string length $options]} {
#	set a [split $options { }]
#	puts [lindex $a 0]
#	puts [lindex $a 1]
#	puts [lindex $a 2]
	eval "exec $filep  $options  < $filei > $fileo 2> $filee"
    } else {
	exec $filep < $filei > $fileo 2>  $filee
    }
    loadFile fileo o
    loadFile filee e
}
set preprogram "#!/usr/local/bin/perl -w \n"
append preprogram {eval "\$$1=\$2" while @ARGV && $ARGV[0]=~ /^(\w+)=(.*)/ && shift;}
append preprogram "\nwhile (<>) \{  \n" 
set program "    s/e/E/g; \n  " 
set postprogram "    print ; \n\} \n" ;
.text.preprogram.text  insert end $preprogram
.text.program.text  insert end $program
.text.postprogram.text  insert end $postprogram

proc loadFile { file t } {
    global name
    global $file
    set text .text.[set name($t)].text
    $text delete 1.0 end
#    puts "opening the file whose name is in $file, which is [set $file]"
    set thefile [set $file]
    if {[file readable $thefile]} {
	set f [open $thefile]
	while {![eof $f]} {
	    $text insert end [read $f 1000]
	}
	close $f
    } else {
	puts "can't read from file $thefile"
    }
}
# Save
proc	writetofile  { file t } {
    global name
    global $file
    set text .text.[set name($t)].text
    set thefile [set $file]
    set ok [file writable $thefile]
    if {$ok} {
	set fp [open $thefile w]
	global $text
	set c "" 
	if { $t=="p" } {
	    append c [.text.preprogram.text  get 0.0 end]
	    append c [$text get 0.0 end]
	    append c [.text.postprogram.text  get 0.0 end]
	} else {
	    append c [$text get 0.0 end]
	}
	puts -nonewline $fp $c ;# to file
	close $fp
    } else {
	puts "can't write to file $thefile"
    }
} 

####################################################
# keyboard shortcuts
####################################################
set bindplace .
bind $bindplace <Control-x> "doit"
bind $bindplace <Control-s> "doit"
bind $bindplace <Control-z> "doit"
bind $bindplace <Control-a> "doit"
bind $bindplace <Control-d> "doit"
bind $bindplace <Control-c> "destroy ."
bind $bindplace <Control-q> "destroy ."
bind .text.input.text <Return> "doit"
bind .text.program.text <Return> "doit"
bind .text.postprogram.text <Return> "doit"
bind .text.preprogram.text <Return> "doit"
bind .text.i.file <Return> ".text.i.butr invoke; doit"

proc help { } {
    set w .help
    catch {destroy $w}
    toplevel $w
frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m -expand 1
button $w.buttons.dismiss -text Dismiss -command "destroy $w"
pack $w.buttons.dismiss  -side left -fill x -expand 1


    text $w.t -relief sunken -setgrid 1

    $w.t insert 0.0 \
	    {This is a prototype perl-testing program.

Warning: this program overwrites files without checking.

If clobber=1 then the input window contents are written
to the specified filename
every time the program is invoked.

If you want to use a particular file as input, set clobber to 0 and
put its name in the place of input.dat.

If clobber=0 then the file, which had better exist, is used as the
input file, and is not overwritten (it will be read into the window for
ease of reference.

When you explicitly read in a file by pressing read, clobber is set to 0, for safety.

In normal usage you will not use the Save or Read button for the input window.
You will not normally use the Save button of the Program or the Output
window either. (Since those two objects are saved there everytime "do it"
is invoked.)
}
  pack $w.t
}