#!/usr/bin/wish
# $Id: xagm,v 1.1 1998/03/08 22:46:24 fraserm Exp $
# $Log: xagm,v $
# Revision 1.1  1998/03/08 22:46:24  fraserm
# Initial revision
#

# divide word length by this to get default max number of words:
set maxwordsdivisor 5
# divide word length by this to get default average word length:
set avlengthdivisor 3
set wordwidth 30
set defaultwidth 80
set firstsearchnum 1
set readbytes 8
set defextend ".txt"

proc RunAgm {} {
    global quiet time width word remword srchtype wordcount partial avlength \
	    hard searchnum
    set command "agm -f"
    if { $quiet } {
	append command " -q"
    }
    if { $time } {
	append command " -t"
    }
    append command [format " -o%d" $width]
    if { [string compare $srchtype maxwords] == 0 } {
	append command [format " -c%d" $wordcount]
	if { $partial } {
	    append command " -p"
	}
    } else {
	append command [format " -l%d" $avlength]
	if { $hard } {
	    append command " -h"
	}
    }
    regsub -all {[ ]+} [$word get] "" word_nospace
    append command " " $word_nospace
    regsub -all {[ ]+} [$remword get] "" remove
    if { [string length $remove] > 0 } {
	append command "-" $remove
    }
    set sw [toplevel ".sw$searchnum"]
    wm title $sw "Search $searchnum (xagm)"
    incr searchnum
    set title [label $sw.title -text "Executing command: $command"]
    set textfr [frame $sw.textfr]
    set text [text $textfr.text -width $width -yscrollcommand "$textfr.scroll set"]
    set textbar [scrollbar $textfr.scroll -command "$textfr.text yview"]
    pack $text -side left -fill both -expand 1
    pack $textbar -side left -fill y
    set pctcmplt [scale $sw.pctcmplt$searchnum -from 0 -to 100 -label "% complete" -orient horizontal -length 250 -showvalue true -tickinterval 25]
    set butfrm [frame $sw.butfrm]
    set stop [button $butfrm.stop -text "Stop" -state disabled]
    set save [button $butfrm.save -text "Save" -state disabled -command "SaveText $text"]
    set close [button $butfrm.close -text "Close" -command "destroy $sw" -state disabled]
    pack $stop $save $close -side left
    pack $title -side top
    pack $textfr -side top -fill both -expand 1
    pack $pctcmplt -side top
    pack $butfrm -side top
    if { [catch { open "|$command" r } ch] } {
	$text insert end "Unable to start command $command\n"
	$stop configure -text "Close" -state enabled -command "destroy $sw"
    }
    fconfigure $ch -buffering none -blocking 0
    fileevent $ch readable "ProcessOutput $ch $text $sw $stop $save $close $pctcmplt"
    $stop configure -state normal -command "StopCommand $ch $text $sw $stop $save $close $pctcmplt"
}

proc SaveText { text } {
    global defextend
    set types [list [list {Text files} {*.txt}] [list {All Files} {*}]]
    set filename [tk_getSaveFile -defaultextension $defextend -filetypes $types -title "Save Anagrams"]
    if { [string length $filename] > 0 } {
	if [catch { open $filename w } ch] {
	    tk_messageBox -icon error -type ok -message "Unable to save in file $filename"
	} else {
	    puts -nonewline $ch [$text get 1.0 end]
	}
	close $ch
    }
}

proc ProcessOutput { ch text win stopbut savebut closebut pc } {
    if { [eof $ch] } {
	$pc set 100
	StopCommand $ch $text $win $stopbut $savebut $closebut $pc
    } else {
	if [catch {read $ch} instuff] {
	    $pc set 100
	    StopCommand $ch $text $win $stopbut $savebut $closebut $pc
	} else {
	    if {[regexp "^(.*)(\[0-9\]\[0-9\])\b\b(.*)\$" $instuff dummy stuff pct rest] == 1} {
		# do percent thing
		$pc set $pct
		set stuff "$stuff$rest"
	    } else {
		set stuff $instuff
	    }
	    regsub -all "\[0-9\]\[0-9\]\b\b" $stuff "" outline
	    $text insert end $outline
	    $text yview end
	    update idletasks
	}
    }
}

proc StopCommand { ch text win stopbut savebut closebut pc } {
    catch { close $ch }
    $text yview end
    $stopbut configure -state disabled
    $savebut configure -state normal
    $closebut configure -state normal
}

proc StateAv { relief state } {
    global avlenlab avlenmenu avhard
    $avlenlab configure -relief $relief
    $avlenmenu configure -state $state
    $avhard configure -state $state
}

proc StateMax { relief state } {
    global maxwordslab maxwordsmenu maxpartial
    $maxwordslab configure -relief $relief
    $maxwordsmenu configure -state $state
    $maxpartial configure -state $state
}

proc SelAv {} {
    StateAv raised normal
    StateMax flat disabled
}

proc SelMax {} {
    StateAv flat disabled
    StateMax raised normal
}

proc SetDefaultValues {} {
    global maxwordsdivisor avlengthdivisor word remword wordcount avlength
    set wordcount [expr ([string length [$word get]] - [string length [$remword get]]) / $maxwordsdivisor]
    set avlength [expr ([string length [$word get]] - [string length [$remword get]]) / $avlengthdivisor]
}

wm title . "Control (xagm)"
set global [frame .global]
set checks [frame $global.checks]
set quietbut [checkbutton $checks.quiet -text "Quiet Mode" -variable quiet]
set timebut [checkbutton $checks.time -text "Time statistics" -variable time]
pack $quietbut $timebut -side top -anchor w
set widthscale [scale $global.width -label "Output Width" -from 20 -to 160 \
	-length 200 -resolution 5 -showvalue 1 -tickinterval 20 -orient horizontal -variable width]
pack $checks -side left -anchor w
pack $widthscale -side left
pack $global -side top
set search [frame .search]
set wordlab [label $search.wordlab -text "Search phrase:"]
set word [entry $search.word -width $wordwidth]
bind $word <Key-Return> SetDefaultValues
pack $word -side right -fill x -expand 1
pack $wordlab -side right
set search2 [frame .search2]
set remlab [label $search2.remlab -text "Remove these words first:"]
set remword [entry $search2.remword -width $wordwidth]
bind $remword <Key-Return> SetDefaultValues
pack $remword -side right -fill x -expand 1
pack $remlab -side right
pack $search $search2 -side top -fill x -expand 1
set baselab [label .baselab -text "Base search on:"]
pack $baselab -side top
set opts [frame .opts]
set maxopts [frame $opts.maxopts]
set maxbut [radiobutton $maxopts.selected -text "Maximum number of words" -value "maxwords" -variable srchtype -command "SelMax"]
set maxwords [frame $maxopts.words]
set maxwordslab [label $maxwords.lab -text "Max. # of words:"]
set maxwordsmenu [winfo parent [tk_optionMenu $maxwords.words wordcount 1 2 3 4 5 6 7 8 9 10]]
pack $maxwordslab $maxwordsmenu -side left
set maxpartial [checkbutton $maxopts.partial -text "Allow partial anagrams" -variable partial]
pack $maxbut $maxwords $maxpartial -side top -anchor w
set avopts [frame $opts.avopts]
set avbut [radiobutton $avopts.selected -text "Average word length" -value "avwords" -variable srchtype -command "SelAv"]
set avlen [frame $avopts.avlen]
set avlenlab [label $avlen.lab -text "Average word length:"]
set avlenmenu [winfo parent [tk_optionMenu $avlen.length avlength 1 2 3 4 5 6 7 8 9 10]]
pack $avlenlab $avlenmenu -side left
set avhard [checkbutton $avopts.hard -text "Minimum (not average) word length" -variable hard]
pack $avbut $avlen $avhard -side top -anchor w
pack $maxopts $avopts -side left
pack $opts -side top
set butts [frame .butts]
set go [button $butts.go -text "Go" -command "RunAgm"]
set quit [button $butts.quit -text "Quit" -command "exit"]
pack $go $quit -side left
pack $butts -side top


set width $defaultwidth
set srchtype maxwords
set searchnum $firstsearchnum
SelMax