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

################################################################################
# To do
# -----
# Save defaults for program to run, text colour etc
################################################################################

package require cmdline

################################################################################
# Some global variables
################################################################################

set display_information 1
set filehandle ""
set filename ""
set program "simpleshell"
set error ""
set choice ""

toplevel .askme
wm withdraw .askme

################################################################################
# The question asking dialog
################################################################################

proc ask_the_user {message argv} {
	# Restore the toplevel item so that we can 
	# put the dialog box together

	wm deiconify .askme
	wm title .askme "What I want to know is?"

	# Set the question text

	label .askme.l -text $message -padx 10 -pady 10 -wraplength 300
	pack .askme.l -side top -anchor n

	# The is where the users choice will go
	global choice
	set choice ""

	# Set up each button
	set counter 1
	foreach option $argv {
		button .askme.$counter -text $option -command [list set choice $counter]
		pack .askme.$counter -side top -anchor n -fill x
		incr counter
	}

	vwait choice

	# Our option has been set, now dismantel the 
	# contents of the toplevel so we can build it
	# up again from scratch next time.

	wm withdraw .askme
	destroy .askme.l
	set counter 1
	foreach option $argv {
		destroy .askme.$counter
		incr counter
	}

	return $choice
}

################################################################################
# Setting up the window
################################################################################

proc main {} {
	wm title . "Simple Inference Engine"
	wm geometry . 500x500

	# The top frame holds the buttons

	frame .top
	button .load -text "Load..." -command "do_load" -width 8 
	button .run  -text "Run"     -command "do_run"  -width 8 -state disabled
	button .save -text "Save..." -command "do_save" -width 8 -state disabled
	checkbutton .display -text "Display 'information' messages" -variable display_information -onvalue 1 -offvalue 0
	pack .load .run .save .display -side left -anchor n -in .top
	pack .top -anchor nw

	# A log of the output is written here

	text .text -yscrollcommand {.textscroll set}
	scrollbar .textscroll -orient vertical -command {.text yview}
	pack .text -side top -anchor w -fill both -expand 1 
	pack .textscroll -side right -fill y -in .text

	# Define some colours

	.text tag config is_status      -foreground blue
	.text tag config is_question    -foreground red
	.text tag config is_response    -foreground cyan
	.text tag config is_answer      -foreground green
	.text tag config is_information -foreground grey

	# A nice hello message

	status "Welcome to the Tcl/Tk expert system shell"
	status ""
	status "This program is used to call the command line"
	status "expert system called simpleshell and allows"
	status "you to interact with it via the gui"
	status ""
	status "First select a knowledgebase to load with the Load button"
	status "Then start a consultation with the Run button"
	status "You can rerun the consultation as many times as you like"
	status ""
	status "The Save button allows you to save the contents of the"
	status "session to a file"
	status ""
	status "The \"Display 'information' messages\" check box is used"
	status "to turn the grey information messages on and off. The "
	status "information messages tell you what the expert system is"
	status "up to and can be quite voluminous"
	status ""
	status "Have fun - Peter Hickman"
	status ""

	# Do we have a command line file

	global filename
	if {$filename != ""} {
		load_a_file $filename
	}
}

################################################################################
# Code to handle the buttons
################################################################################

proc do_load {} {
	status "Load a file..."

	set types {{{XML Files} {.xml}} {{All Files} *}}

	global filename
	set filename [tk_getOpenFile -filetypes $types -title "Load a knowledge base"]

	if {$filename != ""} {
		load_a_file $filename
	} {
		status "No file was selected"
	}
}

proc load_a_file {filename} {
	if {[file isfile $filename] == 0} {
		status "The file you selected is not really a file"
	} elseif {[file readable $filename] == 0} {
		status "The file you selected in not readable"
	} else {
		.run  configure -state normal
		status "Loading file $filename"
		status "The next step is to Run it..."

		wm title . [append newtitle "Simple Inference Engine: " [file tail $filename]]
	}
}

proc do_run {} {
	status "Run the file..."
	status "This may take a few moments to get started..."
	.save configure -state normal
	.run  configure -state disabled

	global filename
	global program
	set filehandle [open "|$program -t $filename" "r+"]

	set question ''
	set responses [list]

	.text delete 0.1 end

	while {![eof $filehandle]} {
		set text [gets $filehandle]

		if {[regexp {^status:(.*)} $text match newtext]} {
			status $newtext
		} elseif {[regexp {^question:(.*)} $text match newtext]} {
			set question $newtext
			set responses [list]
			question $newtext
		} elseif {[regexp {^response:(.*)} $text match newtext]} {
			if {$newtext != "*"} {
				lappend responses "$newtext"
				response "One possible answer is => $newtext"
			} else {
				set is [ask_the_user $question $responses]
				puts $filehandle $is
				flush $filehandle
				incr is -1
				set word [lindex $responses $is]
				answer "Your answer is => $word"
			}
		} elseif {[regexp {^information:(.*)} $text match newtext]} {
			information $newtext
		} elseif {[regexp {^explaination:(.*)} $text match newtext]} {
			status $newtext
		} else {
			status $text
		}
	}

	.run  configure -state normal
}

proc do_save {} {
	status "Save the output..."

	set types { {{Text Files} {.txt} } {{All Files} * } }

	set filename [tk_getSaveFile -filetypes $types -title "Save the results of a run" -initialfile "Results.txt"]

	if {$filename != ""} {
		if {[file isfile $filename] == 0} {
			status "The file you selected is not really a file"
		} elseif {[file writeable $filename] == 0} {
			status "The file you selected in not writeable"
		} else {
			status "Saving the output to $filename"
			set handle [open $filename "w"]
			puts $handle [.text get 0.1 end]
			close $handle
		}
	} {
		status "No file was selected"
	}
}

################################################################################
# Utility functions
################################################################################

proc status      {text} { mymessage $text is_status }
proc question    {text} { mymessage $text is_question }
proc response    {text} { mymessage $text is_response }
proc answer      {text} { mymessage $text is_answer }

proc information {text} {
	global display_information
	if {$display_information == 1} {
		mymessage $text is_information
	}
}

proc mymessage {text tag} {
	.text insert end "$text\n" $tag
	.text see end
	update
}

################################################################################
# The program starts here
################################################################################

# Was there a filename on the command line

set p_count 0

while {[set err [cmdline::getopt argv {f.arg p.arg} opt val]] > 0} {
	switch -- $opt {
		f {
			if {$filename == ""} {
				set filename $val
			} {
				set error "The $opt switch should only be used once"
			}
		}
		p {
			if {$p_count == 0} {
				set program $val
				incr p_count
				if {[file executable $program] != 1} {
					set error "The program '$program' is not runable"
				}
			} {
				set error "The $opt switch should only be used once"
			}
		}
	}
}

if {$err < 0} {
	puts "There was an error: $val"
	exit
}\
elseif {$error != ""} {
	puts "There was an error: $error"
	exit
}

main