<gh_stars>1-10
% ----------------------------------------------------------------------------
\typeout{--------------- appendix: Tcl-I/O example -----------------}
\chapter{Tcl-I/O Example}
\label{Tcl-I/O}
\index{Tcl-I/O}

This appendix contains a very simple example of interfacing Soar to an external environment,
using Soar I/O functions written in Tcl. In this case, the external environment consists of a 
single Tcl variable "color", which the Soar agent can affect by issuing the "paint" command
on its output link. Hopefully, this example is simple enough that it may be used as a template
on which to build more interesting environments. To use this code, this file would be \soar{source}'d
along with Soar code implementing an agent to interact with this environment.

A few words about Tcl syntax:\footnote{For more help on Tcl, see \emph{Tcl and the Tk Toolkit}
\cite{Ousterhout94} or \emph{Practical
Programming in Tcl and Tk} \cite{Welch95}}

\begin{description}
\item[Tcl procedures:] The syntax for defining a new Tcl procedure is \\
			\soar{proc } \emph{name} \soar{ \{ } \emph{arguments} \soar{ \} \{ } 
			\emph{ statements } \soar{ \} } \\
			Arguments are separated by spaces, and statements may be separated by newline or semicolon.			
\item[Comments:] Comments in Tcl begin with the character \soar{\#}.
\item[Tcl variables:] To access the value of a Tcl variable named x, use \soar{\$x}. \\
                     To set x to the value 10, use \soar{set x 10}. \\
                     To set x to the value stored in y, use \soar{set x \$y}. \\
                     To check the value of variable x, use \soar{set x}. \\
                     To eliminate the variable x, use \soar{unset x}.
\item[info exists ...] A Tcl variable does not need to be declared; it is created the first time it is
			\soar{set} to a value. The \soar{info exists} command checks whether a variable of the
			given name exists, ie-
			
			\paragraph{Example}
			\begin{verbatim}
			soar> set x
			can't read ``x'': no such variable
			soar> info exists x
			0
			soar> set x 1
			1
			soar> info exists x
			1
			soar> unset x
			soar> info exists x
			0
			\end{verbatim}

\item[Global variables:] Although a Tcl variable needn't be declared before use, it does need to be declared
			within a procedure if it is to have global scope. Therefore, Tcl procedures often begin
			with the \soar{global} command, followed by a list of global variables that the procedure
			will use. For instance, in the code below, \soar{updateInputLink} and \soar{removeInputLink}
			access the same \soar{ColorWME} variable.
\end{description}

Before reading this code, you may wish to review \ref{SYNTAX-io}, for an overview of Soar I/O.

\footnotesize
\begin{verbatim}

###############################################################
# File: paint-io.tcl

# Initialize the world
set initial_color "blue"
set color $initial_color


###############################################################
# The input function.
#
# Find the Soar agent's I/O ids, if the agent has just been initialized.
# Then call procedure to update WMEs on the input-link.

proc manageInputLink {mode} {
     global ioID inID outID
 
     switch $mode {
       top-state-just-created {
             output-strings-destination -push -append-to-result
             set topStateID [lindex [wmes {(* ^superstate nil)}] 1]
             set ioID [lindex [wmes "($topStateID ^io *)"] 3]
 
             set ioID [string trimright $ioID ")"]
             set inID  [lindex [wmes "($ioID ^input-link *)"] 3]
             set inID [string trimright $inID ")"]
 
             set outID [lindex [wmes "($ioID ^output-link *)"] 3]
             set outID [string trimright $outID ")"]
             output-strings-destination -pop
             setupInputLink
         }
 
        normal-input-cycle {
             updateInputLink
        }
        
        top-state-just-removed {
             removeInputLink
        }
    }	
}

# The next two procedures translate Tcl environment variables into
#  WMEs on the Soar agent's input-link.

proc setupInputLink {} {
       global ColorWME color old_color inID  # ColorWME holds the timetag of the color wme
                                             # which is needed for the remove-wme command

       set ColorWME [add-wme-and-get-timetag $inID ^color $color]
       set old_color $color
}

 

proc updateInputLink {} {
       global ColorWME color old_color inID     

 # If the color hasn't changed, it is unnecessary to remove and reinsert an identical
 #  input WME. Doing so will cause productions that test that input WME to retract
 #  and refire, which is probably not the desired behavior.
   

       if ![string match $old_color $color] {
          remove-wme $ColorWME
          set ColorWME [add-wme-and-get-timetag $inID ^color $color]
          set old_color $color
       }
 }
 

# Clean-up routine. Called at an init-soar.

proc removeInputLink {} {
       global ColorWME color initial_color

       catch "unset ColorWME"
       set color $initial_color
       catch "unset old_color"
}
 

proc add-wme-and-get-timetag { id attr value } {

       scan [add-wme $id $attr $value]   "%d" timetag
       return $timetag
}
 

#####################################################################
# The output function. 
#
# 'Outputs' is a list of WMEs under the output-link ID (plus the 
#  output-link augmentation of the io-link). This list is computed by
#  Soar and handed to the output function. In this example, a list of the form:
#  (I1 ^output-link I3) (I3 ^paint P1) (P1 ^color green)
#  is expected. 

proc manageOutputLink {mode outputs} {    

       switch $mode {
         added-output-command {
            applyCommands $outputs
         } 
         
         modified-output-command {
            applyCommands $outputs    
         }
 
         removed-output-command {
            catch "unset completedWME"
         }
       }
}


# Simulates the motor command.
# In this case, sets the Tcl 'color' variable to whatever
#  color the Soar agent has placed on the output link.
# Adding ^status complete to the command on the output-link
#  signals to Soar that the command has been performed successfully.

proc applyCommands { outputs } {
        global color outID completedWME

        set paintID [getOutputValue $outputs $outID "paint"]
        if ![string match $paintID ""] {
           set color [getOutputValue $outputs $paintID "color"]
           set completedWME [add-wme-and-get-timetag $paintID ^status complete]
        }
}


# Helper procedure for processing 'outputs' list.
# Scans list for wme with 'id' and 'attr' and returns corresponding 'value'

proc getOutputValue {outputs id attr} {
        foreach wme $outputs {
           if {(($id == "") || [string match $id [lindex $wme 0]]) && \
               (($attr == "") || [string match $attr [lindex $wme 1]])} {
                    return [lindex $wme 2]
           }
        }
        return ""
}



###########################################
# Registering I/O functions
#
# Finally, register the I/O functions with Soar, so that they will be executed
#   during the input and output phases.
#
# You can't add the same input-function twice without first deleting it.  So, to
#   avoid this problem (when re-source-ing, for example) the io functions are first
#   deleted and then reinstalled.
 

scan [io -list -input] "%s" old_input
scan [io -list -output] "%s" old_output
if [info exists old_input] {
      io -delete -input $old_input
}
if [info exists old_output] {
      io -delete -output $old_output
}
io -add -input manageInputLink input-test
io -add -output manageOutputLink output-link

 

 \end{verbatim}