Text Adventures: Scott Adams-Style

Scott Beasley 2008-05-26: This was a weekend project from about 8 years ago. It's an ALMOST working Scott Adams Text adventure [1 ] game interpreter. I hope someone will find some good in it. Enjoy.

if 0 {
[A text adventure game engine]
[Scott Beasley] 2008-05-26
}
 # Game Engine - Save as TclAdamsEng.tcl

 #############################################################################
 ## TclAdamsEng.tcl
 ## Package to play Scott Adams Adventure game files in the TRS-80 format
 ## (ScottFree).
 ##
 ## Author: Scott Beasley ([email protected])
 ## Feel free to *itch, or send patches to the above address :-)
 ##
 #############################################################################

 # Declare and build some "noseeums" for the game.
 set dirs {N NO NOR NORTH\
           S SO SOU SOUTH\
           E EA EAS EAST\
           W WE WES WEST\
           U UP\
           D DO DOW DOWN}
 # Used to map direction letter to noun number.
 set dirmap {N 0 S 1 E 2 W 3 U 4 D 5}
 set dirnames [list NORTH SOUTH EAST WEST UP DOWN]

 proc GetRandomNumber { } {
    set inum [expr {int (rand()*101)}]
    return $inum
 }

 # Clean-up game dB read data.
 proc Clean {args} {
    foreach argval $args {
       upvar $argval ptr
       set ptr [string trim $ptr {" }]
    }      
 }

 # Read in all chars from a file, between two '"'
 # Note: This is a quick hack at it, feel free to replace :-)
 proc ReadQuotedMsg {fd} {
    set msg_buff {}
    set QuoteCnt 0

    set char {}   
    while {1} {
       if {$char == {"}} {
          incr QuoteCnt
          if {$QuoteCnt == 2} {
             break   
          }            
       } else {
           append msg_buff $char         
       }
      
       set char [read $fd 1]
    }

    return $msg_buff
 }

 proc CountCarriedInv {strGameInfo} {
    upvar $strGameInfo GameInfo

    set indx 0   
    foreach item_info $GameInfo(items) {
       if {[lindex $item_info 1] == -1} {
         incr indx         
      }
    }
   
    return $indx   
 }

 ## Return the verb number for a given verb string.
 proc GetVerbNo {strGameInfo verb} {
   upvar $strGameInfo GameInfo

   set verb_no 0
   set found_one 0
   
   set verb [string range $verb 0 [expr {$GameInfo(WordLen)-1}]]
   
   foreach verb_noun $GameInfo(words) {
      set WasSynonym 0
      set game_verb [lindex $verb_noun 0]
      if {[string index $game_verb 0] != "*"} {
         set curr_verb_no $verb_no
      } else {
        set game_verb [string range $game_verb 1 end]
        set WasSynonym 1         
      }         

      if {$verb == $game_verb} {
         set found_one 1
         if {$WasSynonym} {
            set verb_no $curr_verb_no
         }
         
         break   
      }
      
      incr verb_no
   }

   if {!$found_one} {
      return -1   
   }
   
   return $verb_no    
 }

 ## Return the noun number for a given noun string.
 proc GetNounNo {strGameInfo noun} {
   upvar $strGameInfo GameInfo

   set noun_no 0
   set found_one 0

   set noun [string range $noun 0 [expr {$GameInfo(WordLen)-1}]]
   
   foreach verb_noun $GameInfo(words) {
      set WasSynonym 0
      set game_noun [lindex $verb_noun 1]
      if {[string index $game_noun 0] != "*"} {
         set curr_noun_no $noun_no
      } else {
         set game_noun [string range $game_noun 1 end]
         set WasSynonym 1         
      }
      
      if {$noun == $game_noun} {
         set found_one 1         
         if {$WasSynonym} {
            set noun_no $curr_noun_no
         }
         
         break   
      }
      
      incr noun_no
   }

   if {!$found_one} {
      return -1   
   }
   
   return $noun_no    
 }

 proc Look {strGameInfo} {
   upvar $strGameInfo GameInfo
   global dirnames
   
   set room $GameInfo(CurrentRoom)

   # Get exits to location...
   set room_info [lindex $GameInfo(locations) $room]
   set GameInfo(RoomText) [lindex $room_info 6]
   if {[string index $GameInfo(RoomText) 0] == "*"} {
      set GameInfo(RoomText) [string range $GameInfo(RoomText) 1 end]
   }
   
   set dirs [lrange $room_info 0 5]
   set dir_txt {}    
   set dir_ndx 0   
   foreach dir $dirs {
      if {$dir != 0} {
         append dir_txt "[lindex $dirnames $dir_ndx] "
      }
 
      incr dir_ndx      
   }

   set GameInfo(RoomExits) $dir_txt

   ## Get Items at location...
   set GameInfo(ItemsInRoom) {}
   foreach item_info $GameInfo(items) {
      if {[lindex $item_info 1] == $room} {
         set item_desc [lindex [split [lindex $item_info 0] {/}] 0]
         lappend GameInfo(ItemsInRoom) $item_desc
      }      
   }
   
   return 0   
 }

 proc ItemLocationChange {strGameInfo item_no room} {
   upvar $strGameInfo GameInfo

   set item_info [lindex $GameInfo(items) $item_no]
   set GameInfo(items) [lreplace $GameInfo(items) $item_no \
                       $item_no [list [lindex $item_info 0] $room\
                       [lindex $item_info 2]]]
 }

 proc GetOrDrop {strGameInfo action item {static_ignore {}}} {
   upvar $strGameInfo GameInfo
   set iRet 4

   ## This will let us match it from the noun part of the table
   ## And handle the user typing syn's also.
   set noun_ndx [GetNounNo GameInfo $item]
   if {$noun_ndx > -1} {
      set item [lindex [lindex $GameInfo(words) $noun_ndx] 1]
   }

   # Get...   
   if {!$action} {      
      set item_ndx 0      
      foreach item_info $GameInfo(items) {
         set item_desc [lindex [split [lindex $item_info 0] {/}] 0]
         set item_name [string trim [lindex [split [lindex \
                        $item_info 0] {/}] 1]]
         set item_loc [lindex $item_info 1]         

         if {($item_name == $item && $item_loc == $GameInfo(CurrentRoom))} {
            if {[CountCarriedInv GameInfo] >= $GameInfo(MaxItemsCarry)} {
               set iRet 10
               break               
            }

            ## Is the item static?         
            if {$item_name == ""} {
               if {$static_ignore == ""} {               
                  set iRet 5
               }
               
               break            
            }

            ## See if we have it already...            
            if {$item_loc == -1} {
               set iRet 6
               break            
            }               
         
            set iRet 0
            ItemLocationChange GameInfo $item_ndx -1
            break            
         }
         
         incr item_ndx
      }      
   }

   ## Drop...
   if {$action} {      
      set item_ndx 0      
      foreach item_info $GameInfo(items) {
         set item_desc [lindex [split [lindex $item_info 0] {/}] 0]
         set item_name [string trim [lindex [split [lindex \
                        $item_info 0] {/}] 1]]
         set item_loc [lindex $item_info 1]

         ## Yet another hack fix.... 
         ## Doing this helps with Items that have the same name.
         ## Pirate's Cove was really bad about this.         
         if {$item_loc == 0} {
            incr item_ndx
            continue
         }
         
         if {$item_name == $item} {
            if {$item_loc == -1} {            
               set iRet 0
               ItemLocationChange GameInfo $item_ndx $GameInfo(CurrentRoom)
               break
            } else {
               set iRet 9
               break            
            }               
         }
         
         incr item_ndx
      }      
   }
   
   return $iRet
 }

 proc MoveInDirection {strGameInfo dir_no} {
   upvar $strGameInfo GameInfo

   set room_info [lindex $GameInfo(locations) $GameInfo(CurrentRoom)]
   set room [lindex $room_info $dir_no]
   if {$room} {
      set GameInfo(CurrentRoom) $room
   } else {
      return 3      
   }      

   return 0   
 }

 proc CheckConditions {strGameInfo conds_lst} {
   upvar $strGameInfo GameInfo

   ## Clear the param list here.   
   set GameInfo(param_lst) {}
   
   foreach condition $conds_lst {
      set cond 1      
      set cond_val [expr {$condition%20}]
      set arg_val [expr {$condition/20}]      

      ## Check for one of 19 condition types.      
      switch $cond_val {
         0 {
            lappend GameInfo(param_lst) $arg_val
         }

         1 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] != -1} {
               set cond 0
            }           
         }            
         
         2 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] != $GameInfo(CurrentRoom)} {
               set cond 0
            }
         }            
         
         3 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] != $GameInfo(CurrentRoom) && \
                [lindex $item_info 1] != -1} {
               set cond 0
            }           
         }            
         
         4 {
            if {$arg_val != $GameInfo(CurrentRoom)} {
               set cond 0
            }           
         }            
         
         5 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] == $GameInfo(CurrentRoom)} {
               set cond 0
            }           
         }            
         
         6 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] == -1} {
               set cond 0
            }           
         }            

         7 {
            if {$arg_val == $GameInfo(CurrentRoom)} {
               set cond 0
            }           
         }            
         
         8 {
            if {!$GameInfo(Flag-$arg_val)} {
               set cond 0
            }               
         }            
         
         9 {
            if {$GameInfo(Flag-$arg_val)} {
               set cond 0
            }
         }            
         
         10 {
            if {![CountCarriedInv GameInfo]} {
               set cond 0
            }               
         }            
         
         11 {
            if {[CountCarriedInv GameInfo]} {
               set cond 0
            }               
         }            

         12 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] == $GameInfo(CurrentRoom) || \
                [lindex $item_info 1] == -1} {
               set cond 0
            }           
         }            

         13 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {![lindex $item_info 1]} {
               set cond 0
            }           
         }            

         14 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1]} {
               set cond 0
            }           
         }            
        
         15 {
            if {[CountCarriedInv GameInfo] > $arg_val} {
               set cond 0
            }               
         }            

         16 {
            if {[CountCarriedInv GameInfo] <= $arg_val} {
               set cond 0
            }               
         }            

         17 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] != [lindex $item_info 2]} {
               set cond 0
            }           
         }            

         18 {
            set item_info [lindex $GameInfo(items) $arg_val]
            if {[lindex $item_info 1] == [lindex $item_info 2]} {
               set cond 0
            }           
         }            

         19 {
            if {$GameInfo(CurrentCounter) != $arg_val} {
               set cond 0      
            }               
         }         
      }
      
      if {!$cond} {
         set GameInfo(ConditionFailed) 1
         break      
      } else {
         set GameInfo(ConditionFailed) 0         
      }         
   }
   
   return $cond
 }

 proc DoActions {strGameInfo action_lls} {
   upvar $strGameInfo GameInfo

   set GameInfo(param_ndx) 0    
   foreach action $action_lls {
      if {!$action} {
         continue
      }
      
      ## Append any msg's to the current msg list.
      if {$action >= 1 && $action < 52} {
         lappend GameInfo(CurrentMsgs) [lindex $GameInfo(messages) $action]
         continue         
      }         

      if {$action > 101} {
         lappend GameInfo(CurrentMsgs) [lindex $GameInfo(messages) \
                 [expr {$action-50}]]
         continue                        
      }
      
      set arg_param [lindex $GameInfo(param_lst) $GameInfo(param_ndx)]
      ## See if it was another type of action.            
      switch $action {
         52 {
            if {[CountCarriedInv GameInfo] >= $GameInfo(MaxItemsCarry)} {
               lappend GameInfo(CurrentMsgs) "You are carrying to much!\n"
               break               
            }

            ItemLocationChange GameInfo $arg_param -1
            incr GameInfo(param_ndx)
            set GameInfo(DidGetOrDrop) 1
         }            

         53 {
            ItemLocationChange GameInfo $arg_param $GameInfo(CurrentRoom)
            incr GameInfo(param_ndx)
            set GameInfo(DidGetOrDrop) 1
         }
         
         54 {
            set GameInfo(CurrentRoom) $arg_param
            incr GameInfo(param_ndx)
         }            

         55 -
         59 {         
            ItemLocationChange GameInfo $arg_param 0
            incr GameInfo(param_ndx)
         }            
            
         56 {
            set GameInfo(IsDark) 1
            set GameInfo(Flag-15) 1
         }            

         57 {
            set GameInfo(IsDark) 0
            set GameInfo(Flag-15) 0
         }            
         
         58 -
         60 {
            set GameInfo(Flag-$arg_param) [expr {$action==60?0:1}]
            incr GameInfo(param_ndx)
         }            

         61 {
            set GameInfo(IsDead) 1
            set GameInfo(IsDark) 0
            set GameInfo(Flag-15) 0
            set GameInfo(CurrentRoom) [expr {$GameInfo(NumberOfRooms)-1}]
         }
         
         62 {
            incr GameInfo(param_ndx)
            set iroom [lindex $GameInfo(param_lst) $GameInfo(param_ndx)]
            ItemLocationChange GameInfo $arg_param $iroom
            incr GameInfo(param_ndx)
         }
         
         63 {
            set GameInfo(GameOver) 0
            if {$GameInfo(GameOverFunc) != ""} {
               eval $GameInfo(GameOverFunc)
            }
         }

         64 -
         76 {
            if {$GameInfo(LookFunc) != ""} {
               eval $GameInfo(LookFunc)
            }
         }            
         
         65 {
            set iTreasureCnt 0
            foreach item_info $GameInfo(items) {
               if {([lindex $item_info 1] == $GameInfo(TreasureRoom)) && \
                   [string index [lindex $item_info 0] 0] == "*"} {
                  incr iTreasureCnt
               }                  
            }
            
            set iScore [expr {$iTreasureCnt*100/$GameInfo(TotalTreasures)}]

            if {$GameInfo(TotalTreasures) == $iTreasureCnt} {
               lappend GameInfo(CurrentMsgs) "\nYou Win!"
            }
   
            lappend GameInfo(CurrentMsgs) "\nYou have stored away\
                    $iTreasureCnt of $GameInfo(TotalTreasures) total\
                    treasures." "Your score is $iScore."
         }
         
         66 {
            lappend GameInfo(CurrentMsgs) "\nYou are carrying:"
            if {![CountCarriedInv GameInfo]} {
               lappend GameInfo(CurrentMsgs) "Nothing."
            }

            set iLineLen 0
            set iDivder 0
            set InvLine {}                  
            foreach item_info $GameInfo(items) {
               if {[lindex $item_info 1] != -1} {
                  continue
               }
               
               set item [lindex [split [lindex $item_info 0] {/}] 0]               
               append InvLine "$item. "
       
               if {[expr {$iLineLen+[string length $item]+2}] >= \
                   $GameInfo(MaxDisplayWidth)} {
                  lappend GameInfo(CurrentMsgs) "$InvLine\n"
                  set iLineLen 0
                  set InvLine {}                  
               }
        
               incr iLineLen [expr {[string length $item]+2}]
            }
            
            lappend GameInfo(CurrentMsgs) "$InvLine\n"
         }

         67 {
            set GameInfo(Flag-0) 1
         }
         
         68 {
            set GameInfo(Flag-0) 0
         }
         
         69 {
            set GameInfo(LightCountDown) $GameInfo(TotalLightTime)
            ## Item number 9 is always the light source.
            ItemLocationChange GameInfo 9 -1            
            set GameInfo(IsDark) 0
            set GameInfo(Flag-15) 0
         }
         
         70 {
 ##            set GameInfo(CurrentMsgs) {}
            if {$GameInfo(ClearFunc) != ""} {
               eval $GameInfo(ClearFunc)
            }
         }
         
         71 {
            if {$GameInfo(SaveGameFunc) != ""} {
               eval $GameInfo(SaveGameFunc)
            }
         }
         
         72 {
            set item_no1 $arg_param
            incr GameInfo(param_ndx)
            set item_no2 [lindex $GameInfo(param_lst) $GameInfo(param_ndx)]
            set item_loc1 [lindex [lindex $GameInfo(items) $item_no1] 1]
            set item_loc2 [lindex [lindex $GameInfo(items) $item_no2] 1]
            ItemLocationChange GameInfo $item_no1 $item_loc2
            ItemLocationChange GameInfo $item_no2 $item_loc1
            incr GameInfo(param_ndx)
         }
         
         73 {
            set GameInfo(Continue) 1
         }
         
         74 {
            ItemLocationChange GameInfo $arg_param -1
            incr GameInfo(param_ndx)
         }
         
         75 {
            set item_no1 $arg_param
            incr GameInfo(param_ndx)
            set item_no2 [lindex $GameInfo(param_lst) $GameInfo(param_ndx)]
            set item_loc2 [lindex [lindex $GameInfo(items) $item_no2] 1]
            ItemLocationChange GameInfo $item_no1 $item_loc2
            incr GameInfo(param_ndx)
         }
         
         77 {
            if {$GameInfo(CurrentCounter) >= 0} {
               incr GameInfo(CurrentCounter) -1
            }
         }
         
         78 {
            lappend GameInfo(CurrentMsgs) $GameInfo(CurrentCounter)
         }
         
         79 {
            set GameInfo(CurrentCounter) $arg_param
            incr GameInfo(param_ndx)
         }
         
         80 {
            set iSwap $GameInfo(RoomNumberHold)
            set GameInfo(RoomNumberHold) $GameInfo(CurrentRoom)
            set GameInfo(CurrentRoom) $iSwap
         }

         81 {
            set iSwap $GameInfo(CurrentCounter)
            set GameInfo(CurrentCounter) $GameInfo(Counter-$arg_param)
            set GameInfo(Counter-$arg_param) $iSwap
            incr GameInfo(param_ndx)
         }
         
         82 {
            incr GameInfo(CurrentCounter) $arg_param
            incr GameInfo(param_ndx)
         }
         
         83 {
            set arg_val "-$arg_param"
            incr GameInfo(CurrentCounter) $arg_val
            incr GameInfo(param_ndx)
         }
         
         84 {
            lappend GameInfo(CurrentMsgs) $GameInfo(TypedNoun)
         }
         
         85 {
            lappend GameInfo(CurrentMsgs) $GameInfo(TypedNoun) "\n"
         }
         
         86 {
            lappend GameInfo(CurrentMsgs) "\n"
         }
         
         87 {
            set iSwap $GameInfo(CurrentRoom)
            set GameInfo(CurrentRoom) $GameInfo(RoomStack-$arg_param)
            set GameInfo(RoomStack-$arg_param) $iSwap
            incr GameInfo(param_ndx)
         }
         
         88 {
            after 2000
         }
         
         89 {
            incr GameInfo(param_ndx)
         }
      }
   }
 }   

 proc CheckActions {strGameInfo verb_no noun_no} {
   upvar $strGameInfo GameInfo
   set repeat 0
   set iWasAction 0
   
   ## Clear the param list counter here.   
   set GameInfo(param_ndx) 0

   ## Loop all the actions in the list and see if we have a hit.   
   foreach action_info $GameInfo(actions) {
      set vocab [lindex $action_info 0]
      set action_verb [expr {$vocab/150}]
      set action_noun [expr {$vocab%150}]
      set cond1 [lindex $action_info 1]
      set cond2 [lindex $action_info 2]
      set cond3 [lindex $action_info 3]
      set cond4 [lindex $action_info 4]
      set cond5 [lindex $action_info 5]
      
      if {($action_verb == $verb_no || !$action_verb) || ($repeat && !$action_verb)} {
         if {($action_noun == $noun_no || !$action_noun) || !$action_verb} {
            ## Code for conditions that are only checked n% of the time.            
            if {(!$action_verb && \
                ([GetRandomNumber] >= $action_noun)) && !$repeat} {
               continue                   
            }
            
            set condition [CheckConditions GameInfo [list $cond1 $cond2 \
                                           $cond3 $cond4 $cond5]]
                                         
            if {$condition} {
               set action1 [lindex $action_info 6]
               set action2 [lindex $action_info 7]
               set act0 [expr {$action1/150}]
               set act1 [expr {$action1%150}]
               set act2 [expr {$action2/150}]
               set act3 [expr {$action2%150}]

               DoActions GameInfo [list $act0 $act1 $act2 $act3]
               set iWasAction 1
               ## I guess this is right?               
               if {$GameInfo(Continue)} {               
                  set GameInfo(Continue) 0
                  set repeat 1                  
               }
               
               if {$action_verb && !$repeat} {
                  break
               }         
            }               
         }
      }

      if {$action_verb} {
         set repeat 0   
      }         
   }
   
   return $iWasAction
 }

 proc ParseUserInput {strGameInfo cmdln_in} {
   upvar $strGameInfo GameInfo
   global dirs dirmap

   set iVerbNo -1
   set iNounNo 0
   set iGetAll 0
   set iret 0
   set GameInfo(TypedNoun) {}
   set GameInfo(ConditionFailed) 0   
   set GameInfo(DidGetOrDrop) 0
   set GameInfo(WasHelp) 0
   incr GameInfo(TurnCnt)
   if {!$GameInfo(LightCountDown)} {
      set GameInfo(IsDark) 1
      set GameInfo(Flag-15) 1
      return 11      
   } else {
      incr GameInfo(LightCountDown) -1
   }      
   
   foreach {verb noun} [string trim [split $cmdln_in]] {}
   set GameInfo(TypedNoun) $noun
   set verb [string toupper $verb]   
   set noun [string toupper $noun]   

   if {$verb == {QUIT} || $verb == {EXIT} || $verb == {Q}} {
      set GameInfo(Playing) 0
      if {$GameInfo(GameOverFunc) != ""} {
         eval $GameInfo(GameOverFunc)
      }
      
      return 0
   }

   set iVerbNo [GetVerbNo GameInfo $verb]

   ## Check and see if it was a direction.   
   if {$iVerbNo == 1 && $noun == ""} {
      return 2     
   }

   if {$iVerbNo == 1 || $noun == ""} {
      if {$noun != ""} {
         set possiable_dir $noun
      } else {
         set possiable_dir $verb
      }         
      
      foreach dir [string trim [split $dirs]] {
         if {$possiable_dir == $dir} {
            set dir [string range $possiable_dir 0 0]
            set iVerbNo 1
            set iNounNo [string map $dirmap $dir]
            set iret [MoveInDirection GameInfo $iNounNo]
         }         
      }
   }
   
   ## Extra hack for 'Inventory'.
   if {$verb == {I}} {
      set iVerbNo [GetVerbNo GameInfo "INV"]
   }

   ## Extra hack for get/drop all.
   if {($iVerbNo == 10 || $iVerbNo == 18) && $noun == "ALL"} {
      set iGetAll 1      
   }
   
   ## Check for unknown command, or match a noun if there was one.
   if {$iVerbNo == -1} {
      return 7
   } else {
      if {$noun != "" && !$iGetAll} {
         set iNounNo [GetNounNo GameInfo $noun]
         if {$iNounNo == -1} {
            return 8
         }
      }
   }

   ## Check for any actions to perform.   
   set iWasAction [CheckActions GameInfo $iVerbNo $iNounNo]

   if {$verb == "HELP" && !$GameInfo(ConditionFailed)} {
      set GameInfo(WasHelp) 1
      if {$GameInfo(HelpFunc) != ""} {
         eval $GameInfo(HelpFunc)
      }
   }

   ## See if it was a 'GET' or 'DROP'.   
   if {($iVerbNo == 10 || $iVerbNo == 18) && \
      !$GameInfo(DidGetOrDrop) && $GameInfo(ConditionFailed)} {
      if {$noun == "ALL"} {
         foreach item_info $GameInfo(items) {
            if {[lindex $item_info 1] != $GameInfo(CurrentRoom)} {
               continue
            }
            set item [string trim [lindex [split [lindex \
                           $item_info 0] {/}] 1]]
            set iret [GetOrDrop GameInfo [expr {$iVerbNo==10?0:1}] $item 1]
            if {!$iret} {
               set item_desc [string trim [lindex [split [lindex \
                             $item_info 0] {/}] 0]]
               lappend GameInfo(CurrentMsgs) "$item_desc: O.K."
            }               
         }            
      } else {
         set iret [GetOrDrop GameInfo [expr {$iVerbNo==10?0:1}] $noun]
      }

      ## Hackish way to get certain events to happen.
      ## Maybe not the best place for it, but....      
      CheckActions GameInfo $iVerbNo $iNounNo
   }
   
   return $iret
 }

 proc ReadAdventureFile {strGameInfo gamefile} {
   upvar $strGameInfo GameInfo
   unset GameInfo
   
   ## Init the game play vars.
   set GameInfo(datfile) $gamefile
   set GameInfo(Playing) 1
   set GameInfo(GameOver) 0
   set GameInfo(Continue) 0
   set GameInfo(IsDark) 0
   set GameInfo(IsDead) 0
   set GameInfo(TurnCnt) 0
   set GameInfo(param_lst) {}
   set GameInfo(param_ndx) 0
   set GameInfo(BitFlags) 0
   set GameInfo(CurrentCounter) 0
   set GameInfo(CurrentMsgs) {}
   set GameInfo(CurrentUserMsgs) {}
   set GameInfo(TypedNoun) {}
   set GameInfo(RoomNumberHold) 0
   set GameInfo(DidGetOrDrop) 0
   set GameInfo(WasHelp) 0
   set GameInfo(SaveGameFunc) {}
   set GameInfo(ClearFunc) {}
   set GameInfo(LookFunc) {}
   set GameInfo(GameOverFunc) {}   
   set GameInfo(HelpFunc) {}
   set GameInfo(MaxDisplayWidth) 80
   set GameInfo(ConditionFailed) 0
   
   ## I go a little more on the counters and flags just for the future.
   for {set iNdx 0} {$iNdx < 32} {incr iNdx} {
      set GameInfo(Counter-$iNdx) 0
   }

   ## I do the flags like this... Because I can :-).
   for {set iNdx 0} {$iNdx < 32} {incr iNdx} {
      set GameInfo(Flag-$iNdx) 0
   }

   for {set iNdx 0} {$iNdx < 32} {incr iNdx} {
      set GameInfo(RoomStack-$iNdx) 0
   }
   
   set fd [open $GameInfo(datfile) "r"]
   fconfigure $fd -buffersize 256000

   ## Read in the Game file info, and store it.   
   set filler [gets $fd]
   set GameInfo(NumberOfItems) [string trim [gets $fd]]
   set GameInfo(NumberOfActions) [string trim [gets $fd]]
   set GameInfo(NumberOfWords) [string trim [gets $fd]] 
   set GameInfo(NumberOfRooms) [string trim [gets $fd]]
   set GameInfo(MaxItemsCarry) [string trim [gets $fd]]
   set GameInfo(StartingRoom) [string trim [gets $fd]]
   set GameInfo(TotalTreasures) [string trim [gets $fd]]
   set GameInfo(WordLen) [string trim [gets $fd]]
   set GameInfo(TotalLightTime) [string trim [gets $fd]]
   set GameInfo(NumberOfMsgs) [string trim [gets $fd]]
   set GameInfo(TreasureRoom) [string trim [gets $fd]]
   set GameInfo(CurrentRoom) $GameInfo(StartingRoom)
   set GameInfo(LightCountDown) $GameInfo(TotalLightTime)

   set ActCnt 0
   incr GameInfo(NumberOfActions)   
   while {$ActCnt < $GameInfo(NumberOfActions)} {
      set Vocab [gets $fd]
      set Condition1 [gets $fd]; set Condition2 [gets $fd]
      set Condition3 [gets $fd]; set Condition4 [gets $fd]
      set Condition5 [gets $fd]
      set Action1 [gets $fd]; set Action2 [gets $fd]
      Clean Vocab Condition1 Condition2 Condition3 \
            Condition4 Condition5 Action1 Action2      
      lappend GameInfo(actions) [list $Vocab $Condition1 $Condition2\
                                      $Condition3 $Condition4\
                                      $Condition5 $Action1 $Action2]
      incr ActCnt                                
   }

   set WordCnt 0
   incr GameInfo(NumberOfWords)   
   while {$WordCnt < $GameInfo(NumberOfWords)} {
      set Verb [gets $fd]; set Noun [gets $fd]
      Clean Verb Noun      
      lappend GameInfo(words) [list $Verb $Noun]
      incr WordCnt                                
   }

   set RoomCnt 0
   incr GameInfo(NumberOfRooms)
   while {$RoomCnt < $GameInfo(NumberOfRooms)} {
      set Exit1 [gets $fd]; set Exit2 [gets $fd]
      set Exit3 [gets $fd]; set Exit4 [gets $fd]
      set Exit5 [gets $fd]; set Exit6 [gets $fd]
      set Desc [ReadQuotedMsg $fd]
      ## Eat the extra space and nl after the room txt.      
      gets $fd
      Clean Exit1 Exit2 Exit3 Exit4 Exit5 Exit6 Desc
      
      lappend GameInfo(locations) [list $Exit1 $Exit2 $Exit3\
                                        $Exit4 $Exit5 $Exit6 $Desc]
      incr RoomCnt
   }
   
   set MsgCnt 0
   incr GameInfo(NumberOfMsgs)   
   while {$MsgCnt < $GameInfo(NumberOfMsgs)} {
      set msg [ReadQuotedMsg $fd]
      Clean msg
      lappend GameInfo(messages) $msg
      incr MsgCnt                                
   }

   set ItemCnt 0
   incr GameInfo(NumberOfItems)
   while {$ItemCnt < $GameInfo(NumberOfItems)} {
      set Item [ReadQuotedMsg $fd]
      set Location [gets $fd]
      Clean Item Location
      lappend GameInfo(items) [list $Item $Location $Location]
      incr ItemCnt                                
   }

   set ActCnt 0
   while {$ActCnt < $GameInfo(NumberOfActions)} {
      set ActionCmd [ReadQuotedMsg $fd]
      Clean ActionCmd
      lappend GameInfo(actioncmds) [string trim $ActionCmd "\n\r"]
      incr ActCnt                                
   }   
 }
----
Text based driver -

 ##!/bin/sh
 ## \
 exec tclsh "$0" [email protected]

 ##############################################################################
 ## TclAdams.tcl
 ##
 ## Txt Driver to test Scott Adams Adventure game engine written in TCL.
 ##
 ## Author: Scott Beasley ([email protected])
 ## Feel free to *itch, or send patches to the above address :-)
 ##
 ##############################################################################

 source TclAdamsEng.tcl

 ## Test it all out with a puny little driver.
   set GameInfo {}

   if {$argc < 1} {
     puts "We need a game file to play!\nUsage:\
           TclAdams gamedatfile"
     exit 1           
   } else {
     set GameFile [lindex $argv 0]      
   }      

   ReadAdventureFile GameInfo $GameFile
   fconfigure stdout -buffering none

   CheckActions GameInfo 0 0

   while {$GameInfo(Playing)} {
      puts "*******************************************"
      Look GameInfo
      foreach msg $GameInfo(CurrentMsgs) {
         set msg [string trimright $msg "\n"]
         if {$msg != ""} {         
            puts $msg
         }            
      }

      puts "\nLocation:\n$GameInfo(RoomText)"
      set iLineLen 0
      set iDivder 0
      if {[llength $GameInfo(ItemsInRoom)]} {   
         puts -nonewline "You see: "
         foreach item $GameInfo(ItemsInRoom) {
            if {$iDivder} {
               puts -nonewline " - "   
            } else {
               set iDivder 1         
            }         
       
            if {[expr {$iLineLen+[string length $item]+3}] >= 70} {
               puts ""
               set iLineLen 0
            }
        
            incr iLineLen [expr {[string length $item]+3}]
            puts -nonewline $item
         }
      }
   
      puts "\nObvious exits: $GameInfo(RoomExits)\n"

      while 1 {
         puts -nonewline "What do you want to do? "         
         set cmd_ln [string trim [gets stdin]]
         puts {}
         if {$cmd_ln != ""} {
            break      
         }      
         puts "Pardon?\n"
      }
   
      set GameInfo(CurrentMsgs) {}
      if {$cmd_ln == ""} {
         continue      
      }
    
      set iRet [ParseUserInput GameInfo $cmd_ln]

      switch $iRet {
         2 {
            puts "You must supply a direction.\n"
         }
   
         3 {
            puts "You can't go in that direction.\n"
         }
 
         5 {
            puts "It's beyond your power to do that!\n"
         }

         6 {
            puts "You are carring that already...\n"
         }
      
         7 {
            puts "You speak unknown words!\n"
         }
      
         8 {
            puts "Don't know what that is?\n"
         }
   
         9 {
            puts "You are not carring that...\n"
         }

         10 {
            puts "You are carring to much!\n"
         }

         11 {
            puts "It's too dark to do it!\n"
         }
      }
   }

 ## puny driver end.
----
Gui based Driver - 

 ##!/bin/sh
 ## \
 exec wish "$0" [email protected]
 
 ##############################################################################
 ## TkAdams.tcl
 ##
 ## Tk driver to test Scott Adams Adventure game engine written in TCL.
 ##
 ## Author: Scott Beasley ([email protected])
 ## Feel free to *itch, or send patches to the above address :-)
 ##
 ##############################################################################

 source TclAdamsEng.tcl

 proc LoadAdventFile {{GameFile {}}} {
   global GameInfo   

   set GameInfo(MaxDisplayWidth) 85   
   if {$GameFile == ""} {
      set types {
          {{Adams Games Files}   {.dat}  TEXT}
          {{All Files}         *             }
      }
      
      set filename [tk_getOpenFile -filetypes $types]

      if {$filename != ""} {
         set GameFile $filename
      }
   }

   if {$GameFile != ""} {
      ReadAdventureFile GameInfo $GameFile
      CheckActions GameInfo 0 0
      MakeAWish 1
      focus .fr_one_wish.e_command   
   }
 }
 
 proc UserError {errormsg} {
   .fr_one.txt_action_msgs configure -state normal   
   .fr_one.txt_action_msgs delete 1.0 end
   .fr_one.txt_action_msgs insert 1.0 $errormsg
   .fr_one.txt_action_msgs configure -state disabled
 }

 proc DescriptPuts {line} {
   .fr_one.txt_room_and_item_info configure -state normal
   .fr_one.txt_room_and_item_info insert end $line
   .fr_one.txt_room_and_item_info configure -state disabled
 }

 proc ActionPuts {line} {
   set line [string trimright $line]
   .fr_one.txt_action_msgs configure -state normal   
   .fr_one.txt_action_msgs insert end $line
   .fr_one.txt_action_msgs insert end "\n"
   .fr_one.txt_action_msgs configure -state disabled
 }

 proc SetDirButtonsAllowed {} {
   global GameInfo dirnames

   foreach dir $dirnames {
      ".fr_two.b_[string tolower $dir]" configure -state disabled      
   }

   if {[string trim $GameInfo(RoomExits)] != ""} {
      foreach dir [split $GameInfo(RoomExits)] {
         if {[string trim $dir] != ""} {
            ".fr_two.b_[string tolower $dir]" configure -state active
         }            
      }
   }      
 }

 proc MakeAWish {{noparse 0}} {
   global UsersWish GameInfo
   
   if {$noparse} {
      set iRet 0      
   } else {
      set GameInfo(CurrentMsgs) {}
      set UsersWish [string trim $UsersWish]
      if {$UsersWish == ""} {
         return         
      }
      
      set iRet [ParseUserInput GameInfo $UsersWish]
   }
   
   set UsersWish {}
   Look GameInfo
   
   .fr_one.txt_action_msgs configure -state normal
   .fr_one.txt_room_and_item_info configure -state normal
   .fr_one.txt_action_msgs delete 1.0 end
   .fr_one.txt_room_and_item_info delete 1.0 end
   .fr_one.txt_action_msgs configure -state disabled
   .fr_one.txt_room_and_item_info configure -state disabled

   switch $iRet {
      2 {
         UserError "You must supply a direction.\n"
      }
   
      3 {
         UserError "You can't go in that direction.\n"
      }
 
      5 {
         UserError "It's beyond your power to do that!\n"
      }

      6 {
         UserError "You are carring that already...\n"
      }
      
      7 {
         UserError "You speak unknown words!\n"
      }
      
      8 {
         UserError "Don't know what that is?\n"
      }
   
      9 {
         UserError "You are not carring that...\n"
      }

      10 {
         UserError "You are carring to much!\n"
      }

      11 {
         UserError "It's too dark to do it!\n"
      }
   }

   set iFirstActMsg 0   
   foreach msg $GameInfo(CurrentMsgs) {
      if {!$iFirstActMsg} {
         set msg [string trimleft $msg "\n"]
         set iFirstActMsg 1   
      }
      
      set msg [string trimright $msg "\n"]
      if {$msg != ""} {         
         ActionPuts "$msg\n"
      }            
   }

   DescriptPuts "You are in a $GameInfo(RoomText)\n"
   set iLineLen 0
   set iDivder 0
   if {[llength $GameInfo(ItemsInRoom)]} {   
      DescriptPuts "You see: "
      foreach item $GameInfo(ItemsInRoom) {
         if {$iDivder} {
            DescriptPuts ". "
         } else {
            set iDivder 1         
         }         
       
         if {[expr {$iLineLen+[string length $item]+2}] >= \
             $GameInfo(MaxDisplayWidth)} {
            DescriptPuts "\n"
            set iLineLen 0
         }
        
         incr iLineLen [expr {[string length $item]+2}]
         DescriptPuts $item
      }
   }
   
 ##   DescriptPuts "\nObvious exits: $GameInfo(RoomExits)\n"
   SetDirButtonsAllowed   
 }

 proc DoDirection {dir} {
   global UsersWish
  
   set UsersWish $dir
   MakeAWish   
 }

 ## TkAdams Driver.
   # Build the window.
   wm title . {tkAdams}
   wm resizable . 0 0
   wm deiconify .

   frame .fr_one -borderwidth 0 -height 75 -relief groove -width 340 
   text .fr_one.txt_action_msgs -height 10 -state disabled
   text .fr_one.txt_room_and_item_info -height 10 -state disabled
   frame .fr_one_wish -borderwidth 0 -height 75 -relief groove -width 340 
   label .fr_one_wish.l_your_wish -borderwidth 1 -relief flat \
         -text {What is your wish?} -width 18 
   entry .fr_one_wish.e_command -textvariable UsersWish -width 25

   grid .fr_one -in . -column 0 -row 3 -columnspan 1 -rowspan 1 
   grid .fr_one.txt_action_msgs -in .fr_one -column 0 -row 2 \
        -columnspan 1 -rowspan 1 
   grid .fr_one.txt_room_and_item_info -in .fr_one -column 0 -row 3 \
        -columnspan 1 -rowspan 1 
   grid .fr_one_wish -in .fr_one -column 0 -row 4 -columnspan 1 -rowspan 1 
   grid .fr_one_wish.l_your_wish -in .fr_one_wish -column 0 -row 0 \
        -columnspan 1 -rowspan 1 
   grid .fr_one_wish.e_command -in .fr_one_wish -column 1 -row 0 \
        -columnspan 1 -rowspan 1 

   frame .fr_two -borderwidth 0 -height 75 -relief groove -width 125
   grid .fr_two -in . -column 0 -row 4 -columnspan 1 -rowspan 1
   set colndx 1
   foreach dir $dirnames {
      button ".fr_two.b_[string tolower $dir]" -text $dir \
             -command "DoDirection $dir" -width 8 -state disabled
      grid ".fr_two.b_[string tolower $dir]" -in .fr_two -column $colndx \
           -row 1 -columnspan 1 -rowspan 1
      incr colndx         
   }      

   frame .fr_three -borderwidth 0 -height 75 -relief groove -width 200
   grid .fr_three -in . -column 0 -row 5 -columnspan 1 -rowspan 1
   button .fr_three.b_quit -text "Quit" \
          -command "exit" -width 8 -state normal
   button .fr_three.b_save -text "Save Game" -padx 10 \
          -command "SaveGame" -width 8 -state normal
   button .fr_three.b_load_game -text "Load Game" -padx 10 \
          -command "SaveGame" -width 8 -state normal
   button .fr_three.b_load -text "Load New Adventure" -padx 40 \
          -command "LoadAdventFile" -width 8 -state normal
   grid .fr_three.b_quit -in .fr_three -column 0 \
        -row 5 -columnspan 1 -rowspan 1
   grid .fr_three.b_save -in .fr_three -column 2 \
        -row 5 -columnspan 1 -rowspan 1 -sticky nsew
   grid .fr_three.b_load_game -in .fr_three -column 3 \
        -row 5 -columnspan 1 -rowspan 1 -sticky nsew
   grid .fr_three.b_load -in .fr_three -column 4 \
        -row 5 -columnspan 2 -rowspan 1 -sticky nsew

   bind .fr_one_wish.e_command <Key-Return> "MakeAWish"

   set GameFile {}      
   if {$argc >= 1} {
      set GameFile [lindex $argv 0]      
   }
   
   LoadAdventFile $GameFile   
   
 ## end TkAdams