view release on metacpan or  search on metacpan

bin/consult  view on Meta::CPAN

	.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