(FILECREATED "26-Mar-85 19:30:36" {INDIGO}<LOOPS>SOURCES>TRUCKIN>TRUCKIN.;2 77170  

      changes to:  (METHODS GameAbstractClass.New)
		   (FNS GameAbstractClass.New)

      previous date: "14-Jan-85 17:16:33" {INDIGO}<LOOPS>SOURCES>TRUCKIN>TRUCKIN.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT TRUCKINCOMS)

(RPAQQ TRUCKINCOMS ((* Copyright (c)
		       1983 by Xerox Corporation.)
		    (* Source Code for Truckin. This program is a mini-expert system for teaching 
		       knowledge representation techniques in the Loops programming system. Truckin 
		       provides a simple simulation environment for novice Loops users in which small 
		       bodies of knowledge can be created and tested interactively. Knowledge in 
		       Truckin is in the form of rules for controlling a game piece to 
		       "maximize profit"
		       along a truck route.)
		    (* Written in January 1983 by the Loops Design Team -- Daniel Bobrow, Sanjay 
		       Mittal, and Mark Stefik.)
		    (CONSTANTS * TRUCKINCONSTANTS)
		    (CLASSES * TRUCKINCLASSES)
		    (GLOBALVARS * TRUCKINVARS)
		    (FNS * TRUCKINFNS)
		    (GLOBALVARS PlayerProcRestFlg GameProcRestFlg)
		    (VARS GameCommandX GameCommandY GameParamRegion HandicapRatio aliceCount 
			  banditCount banditMoveFrequency banditMoveRange debugMode debugTimeTrace 
			  defaultGaugesFlg GameControlRegion (GameControlMenu)
			  (GameControlWindow)
			  (GameSuspendMenu)
			  (GameAwakeMenu))
		    [APPENDVARS (BREAKRESETFORMS (TTY.PROCESS (THIS.PROCESS]
		    (METHODS CommodityMeta.New CommodityMeta.Subs! GameAbstractClass.New 
			     GameBoard.NewInstance GameClass.AddCV! GameClass.DeleteCV! 
			     GameClass.RenameCV! GameClass.Subs! GameMetaClass.New 
			     GameObject.AddGauges GameObject.Initialize GameParameters.LoadPara 
			     GameParameters.SetUp GameParameters.StorePara)))



(* Copyright (c) 1983 by Xerox Corporation.)




(* Source Code for Truckin. This program is a mini-expert system for teaching knowledge 
representation techniques in the Loops programming system. Truckin provides a simple simulation
 environment for novice Loops users in which small bodies of knowledge can be created and 
tested interactively. Knowledge in Truckin is in the form of rules for controlling a game piece
 to "maximize profit" along a truck route.)




(* Written in January 1983 by the Loops Design Team -- Daniel Bobrow, Sanjay Mittal, and Mark 
Stefik.)


(RPAQQ TRUCKINCONSTANTS [(lineSize 1)
			 (iconSide 16)
			 (boardShade 23130)
			 (BLACKCOLOR 0)
			 (roadColor 15)
			 (roadStopColor 14)
			 (roadStopNameColor 13)
			 (otherRoadStopIconColor 12)
			 (consumerIconColor 11)
			 (producerIconColor 10)
			 (borderColor 9)
			 (roadSignFont (FONTCREATE (QUOTE HELVETICA)
						   8
						   (QUOTE BOLD)))
			 (driverFont (FONTCREATE (QUOTE HELVETICA)
						 8))
			 (dataFont (FONTCREATE (QUOTE HELVETICA)
					       10
					       (QUOTE BOLD)))
			 (commodityFont (FONTCREATE (QUOTE HELVETICA)
						    8
						    (QUOTE BOLD)))
			 (gameStatusBoldFont (FONTCREATE (QUOTE HELVETICA)
							 12
							 (QUOTE BOLD])
(DECLARE: EVAL@COMPILE 

(RPAQQ lineSize 1)

(RPAQQ iconSide 16)

(RPAQQ boardShade 23130)

(RPAQQ BLACKCOLOR 0)

(RPAQQ roadColor 15)

(RPAQQ roadStopColor 14)

(RPAQQ roadStopNameColor 13)

(RPAQQ otherRoadStopIconColor 12)

(RPAQQ consumerIconColor 11)

(RPAQQ producerIconColor 10)

(RPAQQ borderColor 9)

(RPAQ roadSignFont (FONTCREATE (QUOTE HELVETICA)
			       8
			       (QUOTE BOLD)))

(RPAQ driverFont (FONTCREATE (QUOTE HELVETICA)
			     8))

(RPAQ dataFont (FONTCREATE (QUOTE HELVETICA)
			   10
			   (QUOTE BOLD)))

(RPAQ commodityFont (FONTCREATE (QUOTE HELVETICA)
				8
				(QUOTE BOLD)))

(RPAQ gameStatusBoldFont (FONTCREATE (QUOTE HELVETICA)
				     12
				     (QUOTE BOLD)))

[CONSTANTS (lineSize 1)
	   (iconSide 16)
	   (boardShade 23130)
	   (BLACKCOLOR 0)
	   (roadColor 15)
	   (roadStopColor 14)
	   (roadStopNameColor 13)
	   (otherRoadStopIconColor 12)
	   (consumerIconColor 11)
	   (producerIconColor 10)
	   (borderColor 9)
	   (roadSignFont (FONTCREATE (QUOTE HELVETICA)
				     8
				     (QUOTE BOLD)))
	   (driverFont (FONTCREATE (QUOTE HELVETICA)
				   8))
	   (dataFont (FONTCREATE (QUOTE HELVETICA)
				 10
				 (QUOTE BOLD)))
	   (commodityFont (FONTCREATE (QUOTE HELVETICA)
				      8
				      (QUOTE BOLD)))
	   (gameStatusBoldFont (FONTCREATE (QUOTE HELVETICA)
					   12
					   (QUOTE BOLD]
)

(RPAQQ TRUCKINCLASSES (CommodityClassMeta CommodityMeta GameAbstractClass GameBoard GameClass 
					  GameMetaClass GameObject GameParameters TDMTParameters 
					  TruckinDMParameters TruckinParameters))
(DEFCLASSES CommodityClassMeta CommodityMeta GameAbstractClass GameBoard GameClass GameMetaClass 
	    GameObject GameParameters TDMTParameters TruckinDMParameters TruckinParameters)
[DEFCLASS CommodityClassMeta
   (MetaClass GameMetaClass Edited:                          (* sm: "20-JAN-83 17:32")
	      doc                                            (* MetaClass for all classes of commodities)
	      )
   (Supers GameAbstractClass)
   (ClassVariables (CopyCV NIL)
		   (ComsVar Commodities))]

[DEFCLASS CommodityMeta
   (MetaClass GameMetaClass Edited:                          (* sm: "20-JAN-83 14:28")
	      doc                                            (* MetaClass for all commodities which are not classes 
							     of commodities)
	      )
   (Supers GameClass)
   (ClassVariables (ComsVar Commodities))]

[DEFCLASS GameAbstractClass
   (MetaClass GameMetaClass Edited:                          (* sm: "20-JAN-83 17:29"))
   (Supers GameClass)]

[DEFCLASS GameBoard
   (MetaClass GameClass Edited:                              (* sm: "27-JUN-83 17:36"))
   (Supers GameObject)
   (ClassVariables (CopyCV NIL))
   (InstanceVariables (gameWindow NIL dontSave Value doc     (* A Lisp Window in which the game board is displayed.)
				  )
		      (windowRegion NIL doc                  (* This is the region decribing the board.)
				    )
		      (simulator NIL doc                     (* pointer to simulator which is playing this board)
				 ))]

[DEFCLASS GameClass
   (MetaClass GameMetaClass Edited:                          (* sm: "20-JAN-83 14:29"))
   (Supers Class)
   (ClassVariables (ComsVar TRUCKINCLASSES)
		   (CopyCV NIL))]

[DEFCLASS GameMetaClass
   (MetaClass MetaClass Edited:                              (* sm: "20-JAN-83 14:29"))
   (Supers MetaClass)
   (ClassVariables (ComsVar TRUCKINCLASSES))]

[DEFCLASS GameObject
   (MetaClass GameClass Edited:                              (* sm: "26-JUL-83 09:46"))
   (Supers Object)
   (ClassVariables (UnnamedInstanceCount 0)
		   (Icon ?)
		   (CopyCV (Icon InitializeIVs))
		   (InitializeIVs NIL doc                    (* list of IVs which are initialized by Initialize msg)
				  ))
   (InstanceVariables (lex NIL doc                           (* used by the Announcer System)))]

[DEFCLASS GameParameters
   (MetaClass GameClass Edited:                              (* sm: "13-JUN-83 15:39"))
   (Supers GameObject)
   (ClassVariables (CopyCV (Icon))
		   (Icon ?))]

[DEFCLASS TDMTParameters
   (MetaClass GameClass Edited:                              (* sm: "30-JUN-83 18:57")
	      doc                                            (* Parameters for TimeTruckinDM)
	      )
   (Supers TruckinDMParameters)
   (ClassVariables (CopyCV (Icon))
		   (Icon ?))]

[DEFCLASS TruckinDMParameters
   (MetaClass GameClass Edited:                              (* sm: " 1-JUL-83 17:42"))
   (Supers TruckinParameters)
   (ClassVariables (CopyCV))
   (InstanceVariables (startsAfter NIL goodVal NUMBERP exp (DecisionMaker startsAfter)
				   doc "Number of mins from now when game
will start")
		      (gameDuration NIL goodVal NUMBERP exp (DecisionMaker gameDuration)
				    doc "How long the game will run (in minutes"))]

[DEFCLASS TruckinParameters
   (MetaClass GameClass Edited:                              (* sm: " 5-AUG-83 09:59")
	      doc                                            (* Used for Setting/resetting Truckin parameters)
	      )
   (Supers GameParameters)
   (ClassVariables (CopyCV))
   (InstanceVariables (banditCount 2 goodVal NUMBERP exp banditCount doc "Number of Bandits in game")
		      (timeTrace NIL goodVal (T NIL)
				 exp timeTrace doc 
				 "If T then prints time taken
by each player after each request")
		      (debugMode T goodVal (T NIL)
				 exp debugMode doc "If T then rule violations
bring up RuleExec")
		      (gameDebugFlg NIL goodVal (T NIL)
				    exp gameDebugFlg doc 
				    "If T then prints some 
extra diagnostic messages")
		      (truckinLogFlg NIL goodVal (T NIL)
				     exp truckinLogFlg doc 
				    "If T then keeps a log of all
Game Printout in Status window")
		      (truckDelay 0 goodVal NUMBERP exp truckDelay doc 
			  "Controls speed at which trucks move.
Higher delay means slower motion"))]


(RPAQQ TRUCKINVARS (Communicator DecisionMaker GameBoard GameCommandW GameParamW aliceCount 
				 banditCount banditMoveFrequency banditMoveRange banditNames 
				 blankDataIcon blankPlayerIcon forcedStop gameDebugFlg gameMaster 
				 gameStatusWindow gameWindow interactiveGameMenu ExistingPlayers 
				 paintMap roadStopHalfWidth saveMap timeTrace truckDelay 
				 truckSlowDownDistance truckIncr truckinLogHandle truckinLogFile 
				 truckinLogFlg xTunnelLeft xTunnelRight yData FCTPenalty FCTReason PI 
				 PlayerInterface Simulator))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS Communicator DecisionMaker GameBoard GameCommandW GameParamW aliceCount banditCount 
	    banditMoveFrequency banditMoveRange banditNames blankDataIcon blankPlayerIcon forcedStop 
	    gameDebugFlg gameMaster gameStatusWindow gameWindow interactiveGameMenu ExistingPlayers 
	    paintMap roadStopHalfWidth saveMap timeTrace truckDelay truckSlowDownDistance truckIncr 
	    truckinLogHandle truckinLogFile truckinLogFlg xTunnelLeft xTunnelRight yData FCTPenalty 
	    FCTReason PI PlayerInterface Simulator)
)

(RPAQQ TRUCKINFNS (AuxBuyMade AuxMoveMade AuxSellMade BanditGotYou? BrokenRules ChangeValue 
			      CheckVictim CommodityClassMeta.New CreateNewPlayer CreatePlayers 
			      DrawRoadMarks Drive DriveLeft DriveRight ELIMINATE FindFirstNIL 
			      FindLocIndex FindRandomNIL GameClass.New GameControlMenu 
			      GameMasterMeta.New GameObject.NewInstance GenConsumerPr GenConsumerQty 
			      GetRuleSetMethods InCopyCV? InformBandit&WS InitializeTruckin 
			      IntervalToEvent InvertIcon KillGame MailOut MakeDriveBitMaps 
			      MakePlayerFile NormalizeValue PlayerInterruptMenu RunPlayerRE 
			      RunPlayerRE1 RandomRoomAvailable ReceiveIn ReflectIcon STRINGNUM 
			      SendOut SetMachineDepPara SetUpGame SettifyCopyCV SetupGameBrowsers 
			      SmashCreateCommodity SmashRandomPerishable SubstituteStop SuspendGame 
			      SwitchMenu TalkinBuyMade TalkinMoveMade TalkinSellMade TruckinError 
			      TruckinRE UpdateConsumerDisplay UpdatePrDisplay UpdateProducerSoldout 
			      UpdateQtyDisplay WSRuleViolated? WaitIfControlKey WakeGame 
			      WriteGameStatus))
(DEFINEQ

(AuxBuyMade
  [LAMBDA (player roadPosition reqQty qty reason penalty fragility lifetime)
                                                             (* sm: "13-JUN-83 14:52")
                                                             (* Aux function to provide interface to other 
							     (QUOTE listeners') of game without charging their time 
							     to game)
    (PROG (begT)
          (SETQ begT (CLOCK))
          (TalkinBuyMade player roadPosition reqQty qty reason penalty fragility lifetime)
          (←@
	    gameMaster unchargedTime (IPLUS (@ gameMaster unchargedTime)
					    (IDIFFERENCE (CLOCK)
							 begT)))
          (RETURN player])

(AuxMoveMade
  [LAMBDA (player from to reason penaltyAmt missTurn)        (* sm: "13-JUN-83 14:50")
                                                             (* Aux function to provide interface for other 
							     (QUOTE listeners') of the game but not charge their time
							     to the game)
    (PROG (begT)
          (SETQ begT (CLOCK))
          (TalkinMoveMade player from to reason penaltyAmt missTurn)
          (←@
	    gameMaster unchargedTime (IPLUS (@ gameMaster unchargedTime)
					    (IDIFFERENCE (CLOCK)
							 begT)))
          (RETURN player])

(AuxSellMade
  [LAMBDA (player roadPosition reqQty qty cargoPosition reason penalty)
                                                             (* sm: "13-JUN-83 14:58")
                                                             (* Aux function to provide interface to other 
							     (QUOTE listeners') of game without charging their time 
							     to the game)
    (PROG (begT)
          (SETQ begT (CLOCK))
          (TalkinSellMade player roadPosition reqQty qty cargoPosition reason penalty)
          (←@
	    gameMaster unchargedTime (IPLUS (@ gameMaster unchargedTime)
					    (IDIFFERENCE (CLOCK)
							 begT])

(BanditGotYou?
  [LAMBDA (player rs speed)                                  (* sm: " 9-SEP-83 14:50")
                                                             (* checks if Bandit at rs caught the currentPlayer)
    (PROG ((truck (@ player truck)))
          (RETURN (LESSP speed (RAND 1 (FIX (TIMES (PLUS (@@ truck MaxDist)
							 (@ player maxMove))
						   .5])

(BrokenRules
  [LAMBDA (culprit msg cashP moveP penaltyMsg)               (* sm: "16-SEP-83 15:02")
                                                             (* called when trucker violates some rule)
                                                             (* ARGS: cashP -
							     if >1, is the actual cash penalty, else, is the fraction
							     of cash lost as penalty.)
                                                             (* moveP -
							     if given means a turn is lost.)
                                                             (* penaltyMsg -
							     if given is used to indicate other penalties, which are 
							     calculated elsewhere but printed here)
    (PROG (truck tmp ↑ws)
          [COND
	    ((← culprit InstOf!(QUOTE SystemTruck))
	      (SETQ culprit (@ culprit driver]
          (SETQ ↑ws culprit)
          (WriteGameStatus (CONCAT (@ culprit driver)
				   ", ")
			   msg)
          (SETQ truck (@ culprit truck))
          (COND
	    ((AND cashP (LESSP cashP 0))                     (* cashP is -ve -
							     it is used to convey moves penalty)
	      [SETQ moveP (IPLUS (OR moveP 0)
				 (FIX (ABS cashP]
	      (SETQ cashP NIL)))
          (COND
	    (gameDebugFlg (EVAL.IN.TTY.PROCESS (INTTYL "Debug Pause: " NIL "Type Return to Continue.")
					       T)))
          (COND
	    (cashP                                           (* impose cash penalty)
		   [ChangeValue truck (QUOTE cashBox)
				(IDIFFERENCE (@ truck cashBox)
					     (SETQ tmp (COND
						 ((GREATERP cashP 1)
						   cashP)
						 (T (FIX (TIMES (@ truck cashBox)
								cashP]
		   (WriteGameStatus NIL "Cash Penalty: $" tmp)))

          (* (COND (moveP (* impose turn penalty) (←@ PlayerInterface loseTurn (CONS culprit (@ PlayerInterface loseTurn))) 
	  (* (WriteGameStatus (@ culprit driver) " Loses Next Turn")))))


          (COND
	    (penaltyMsg (WriteGameStatus NIL "Penalty: " penaltyMsg)))
          (COND
	    ((AND debugMode (NOT (← culprit InstOf!(QUOTE RemotePlayer)))
		  (← culprit InstOf!(QUOTE Player)))
	      (TruckinRE culprit)))
          (RETURN culprit])

(ChangeValue
  [LAMBDA (self var value)                                   (* dgb: "27-JAN-83 16:43")
                                                             (* changes key game variables in objects to prevent 
							     cheating)

          (* (PROG (actVal) (SETQ actVal (GetItHere self var)) (RETURN (COND ((type? activeValue actVal) 
	  (PutLocalState! actVal value)) (T (BrokenRules currentPlayer (CONCAT "Cheating: you changed " var) NIL 1 
	  "Fuel Tank and cash emptied") (* as active value was removed by user, restore it) (PutItHere self var NotSetValue)
	  (←@ fuel 0) (ChangeValue self (QUOTE cashBox) 0))))))


    (PutValue self var value])

(CheckVictim
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "19-MAY-83 13:42")
                                                             (* This is a putFn for (BanditCar location) to see if 
							     there is anyone to rob)
    (PROG (victim loss truck (bandit (@ driver))
		  (caught (RAND 1 10))
		  (savedBandit currentPlayer))
          (PutLocalState activeVal newValue self varName propName type)
          [COND
	    ((AND (SETQ victim (← newValue AnyVictim))
		  (IGEQ caught banditCutOff))
	      (SETQ currentPlayer victim)
	      (← newValue Unpark)
	      (← newValue Flash)
	      (SETQ currentPlayer savedBandit)
	      (WriteGameStatus "BANDIDOS robbed you!! " (@ victim driver))
	      (SETQ truck (@ victim truck))
	      (SETQ loss (FIX (TIMES (@ truck cashBox)
				     .2)))
	      (ChangeValue truck (QUOTE cashBox)
			   (IDIFFERENCE (@ truck cashBox)
					loss))
	      (WriteGameStatus "Cash lost: $" loss)
	      (for x in (@ truck cargo) when (← x InstOf!(QUOTE LuxuryGoods))
		 do (COND
		      ((← x TransferOwner bandit (@ bandit pr))
			(WriteGameStatus "Bandits stole: " (CONCAT (@ x qty)
								   " "
								   (ClassName x))
					 " units"]
          (RETURN newValue])

(CommodityClassMeta.New
  [LAMBDA (self)                                             (* mjs: " 2-AUG-83 11:22")
                                                             (* will complain and NOT create an instance)
    (printout TTY "Cannot create an instance of a class of commodities!" T)
    NIL])

(CreateNewPlayer
  [LAMBDA (name type truck)                                  (* sm: " 9-SEP-83 14:52")
                                                             (* creates a new player, using the specified info)
    (PROG (player res obj temp menuItems plClass)
          [COND
	    [(AND (SETQ plClass (GetClassRec type))
		  (← plClass Subclass (QUOTE Player]
	    (T [SETQ menuItems (REMOVE (QUOTE RemotePlayer)
				       (REMOVE (QUOTE DemoPeddler)
					       (← ($ Player)
						  List!(QUOTE Subs]
	       (SETQ res (INMENU "Type of player: " menuItems "Select type of player" T))
	       (SETQ plClass (GetObjectRec res]
          (SETQ player (← plClass New name truck))
          (printout TTY "Player created: " (GetObjectName player)
		    T)
          (pushnew ExistingPlayers player)
          (RETURN player])

(CreatePlayers
  [LAMBDA (numOrPlayers)                                     (* sm: "12-SEP-83 14:53")
                                                             (* creates num new players and assigns them to Global 
							     newPlayers)
                                                             (* if num is NIL, allows upto 20 players to be created)
    (PROG ((pcount (COND
		     ((NUMBERP numOrPlayers)
		       numOrPlayers)
		     (T 20)))
	   player players (moreNeeded T)
	   res exPlayers obj temp (miscOptions (QUOTE (NO)))
	   menuItems)
          (SETQ ExistingPlayers (for x in ExistingPlayers when (NOT (← x InstOf!(QUOTE 
										  DestroyedObject)))
				   collect x))
          [COND
	    ((AND numOrPlayers (NOT (NUMBERP numOrPlayers)))
	      (SETQ exPlayers (for x in ExistingPlayers collect (GetObjectName x)))
	      (SETQ miscOptions (QUOTE (ALL-EXISTING NO]
          [SETQ menuItems (APPEND miscOptions (APPEND exPlayers (REMOVE (QUOTE RemotePlayer)
									(REMOVE (QUOTE DemoPeddler)
										(← ($ Player)
										   List!(QUOTE Subs]
          [SETQ players (for i from 1 to pcount while moreNeeded bind index first (SETQ index 1)
			   join (printout TTY "************ Player No. " index T)
				(SETQ res (INMENU "Type of player: " menuItems 
"Enter one of: type of player, name of existing player, A for use existing players, or N for no more players"
						  T))
				(COND
				  ((EQ res (QUOTE NO))
				    (SETQ moreNeeded NIL)
				    NIL)
				  ((EQ res (QUOTE ALL-EXISTING))
				    (printout TTY "Existing players are: " exPlayers T)
				    (for x in exPlayers do (DREMOVE x menuItems))
				    (DREMOVE (QUOTE ALL-EXISTING)
					     menuItems)
				    (SETQ index (IPLUS index (FLENGTH exPlayers)))
				    (for x in exPlayers
				       collect (SETQ temp (GetObjectRec x))
					       (← (@ temp truck)
						  Initialize)
					       (← temp Initialize)
					       temp))
				  (T (SETQ obj (GetObjectRec res))
				     (SETQ index (ADD1 index))
				     (COND
				       ((type? instance obj)
					 (← (@ obj truck)
					    Initialize)
					 (← obj Initialize)
					 (printout TTY "Player selected: " res T)
					 (DREMOVE res menuItems)
					 (DREMOVE (QUOTE ALL-EXISTING)
						  menuItems)
					 (LIST obj))
				       (T (SETQ player (← obj New))
					  (printout TTY "Player created: " (GetObjectName player)
						    T)
					  (LIST player]
          (RETURN players])

(DrawRoadMarks
  [LAMBDA (self)                                             (* sm: "12-MAY-83 12:51")

          (* * Draw the dotted Lines in the road above the RoadStops.)


    (PROG (x y (whiteIncr (CONSTANT 13))
	     (blackIncr (CONSTANT 12))
	     (stripeWidth (CONSTANT 2))
	     yIncr numRoads marksPerRoad)

          (* * Initialize constants.)


          (SETQ numRoads (@@ numRows))
          (SETQ yIncr (IPLUS (@@($ RoadStop)
			       Height)
			     (@@($ Player)
			       Height)))
          (SETQ marksPerRoad (IQUOTIENT (fetch (REGION WIDTH) of (@ windowRegion))
					(IPLUS whiteIncr blackIncr)))

          (* * Draw the lines on the roads.)


          (SETQ y (IDIFFERENCE yIncr (IQUOTIENT (@@($ Player)
						  Height)
						2)))
          (for road from 1 to numRoads
	     do (SETQ x 0)
		(for mark from 1 to marksPerRoad
		   do (BITBLT NIL NIL NIL gameWindow x y whiteIncr stripeWidth (QUOTE TEXTURE)
			      (QUOTE REPLACE)
			      WHITESHADE)
		      (SETQ x (IPLUS x blackIncr whiteIncr)))
		(SETQ y (IPLUS y yIncr])

(Drive
  [LAMBDA (startRoadStop stopRoadStop player)                (* sm: " 5-JUL-83 18:34")

          (* * Low level routine to Drive the game piece for the currentPlayer from startRoadStop to stopRoadStop.)


    (PROG (direction (rs startRoadStop)
		     stopRs nextRs tunnelFlg prevTunnelFlg xStart xStop y)

          (* * Decide whether the truck is going Up or Down the highway.)


          [SETQ direction (COND
	      ((GREATERP (@ stopRoadStop milePost)
			 (@ startRoadStop milePost))
		(QUOTE Up))
	      (T (QUOTE Down]
      DriveLoop
          (COND
	    ((EQ rs stopRoadStop)                            (* Quit if arrived.)
	      (RETURN)))

          (* * Find the last RoadStop (stopRs) in this direction with the same orientation as RoadStop 
	  (rs).)


          (SETQ stopRs rs)
          (SETQ nextRs (SELECTQ direction
				(Up (@ rs next))
				(Down (@ rs prev))
				NIL))
          (SETQ tunnelFlg NIL)
          [while (AND (NEQ stopRs stopRoadStop)
		      (NOT tunnelFlg))
	     do (COND
		  ((EQ (@ nextRs roadOrientation)
		       (@ rs roadOrientation))
		    (SETQ stopRs nextRs)
		    (SETQ nextRs (SELECTQ direction
					  (Up (@ nextRs next))
					  (Down (@ nextRs prev))
					  NIL)))
		  (T (SETQ tunnelFlg T]

          (* * Now Drive to stopRs and possibly go through a tunnel to the next line of the highway.)


          (COND
	    ([OR (AND (EQ (@ rs roadOrientation)
			  (QUOTE Right))
		      (EQ direction (QUOTE Up)))
		 (AND (EQ (@ rs roadOrientation)
			  (QUOTE Left))
		      (EQ direction (QUOTE Down]             (* Here to go Right.)
	      [SETQ xStart (COND
		  (prevTunnelFlg xTunnelLeft)
		  (T (IPLUS (@ rs x)
			    roadStopHalfWidth]
	      [SETQ xStop (COND
		  (tunnelFlg (IPLUS (@ stopRs x)
				    xTunnelRight))
		  (T (@ stopRs x]
	      (SETQ y (IPLUS (@ rs y)
			     (@@ rs Height)))
	      (DriveRight xStart xStop y player))
	    (T                                               (* Here to go Left.)
	       [SETQ xStart (COND
		   (prevTunnelFlg (IPLUS (@ rs x)
					 xTunnelRight))
		   (T (IPLUS (@ rs x)
			     roadStopHalfWidth]
	       [SETQ xStop (COND
		   (tunnelFlg xTunnelLeft)
		   (T (IPLUS (@ stopRs x)
			     roadStopHalfWidth]
	       (SETQ y (IPLUS (@ rs y)
			      (@@ rs Height)))
	       (DriveLeft xStart xStop y player)))

          (* * Loop back to drive along the next line of the highway.)


          (SETQ prevTunnelFlg tunnelFlg)
          (SETQ rs (COND
	      (tunnelFlg nextRs)
	      (T stopRs)))
          (GO DriveLoop])

(DriveLeft
  [LAMBDA (xStart xStop y player)                            (* mjs: " 4-AUG-83 10:25")

          (* * Low level routine for moving a player icon down the road to the left.)


    (PROG ((tempTruckDelay truckDelay)
	   truckX
	   (endSave (IDIFFERENCE (@@($ Player)
				   Width)
				 truckIncr))
	   (nextCol (@@($ Player)
		      Width))
	   (height (@@($ Player)
		     Height)))

          (* * Initialize the saveMap, paintMap, and place truck initially.)


          (BITBLT (@ player reverseIcon)
		  NIL NIL paintMap)
          (BITBLT gameWindow xStart y saveMap)
          (BITBLT (@ player reverseIcon)
		  NIL NIL gameWindow xStart y)

          (* * Drive the Truck through the x positions. x is the position that the truck will be drawn next.)


          (SETQ xStart (IDIFFERENCE xStart truckIncr))
          [for x from xStart to xStop by (IMINUS truckIncr)
	     do (WaitIfControlKey "driving")                 (* Update the PaintMap.)
		(BITBLT saveMap endSave NIL paintMap nextCol NIL truckIncr height) 
                                                             (* Shift and update the saveMap.)
		(BITBLT saveMap NIL NIL saveMap truckIncr NIL endSave height)
		(BITBLT gameWindow x y saveMap NIL NIL truckIncr height) 
                                                             (* Move the Truck.)
		(BITBLT paintMap NIL NIL gameWindow x y)
		(SETQ truckX x)                              (* Adjust speed as needed.)
		[COND
		  ((ILESSP (IDIFFERENCE x xStop)
			   truckSlowDownDistance)
		    (SETQ tempTruckDelay (ADD1 tempTruckDelay]
		(COND
		  ((NEQ tempTruckDelay 0)
		    (WAITMS tempTruckDelay]

          (* * Finally erase the truck from the road.)


          (BITBLT saveMap NIL NIL gameWindow truckX y)
          (RETURN])

(DriveRight
  [LAMBDA (xStart xStop y player)                            (* mjs: " 4-AUG-83 10:26")

          (* * Low level routine for moving a player icon down the road to the right.)


    (PROG ((tempTruckDelay truckDelay)
	   truckX
	   (endSave (IDIFFERENCE (@@($ Player)
				   Width)
				 truckIncr))
	   (nextCol (@@($ Player)
		      Width))
	   (height (@@($ Player)
		     Height)))

          (* * Initialize the saveMap, paintMap, and place truck initially.)


          (BITBLT (@ player icon)
		  NIL NIL paintMap truckIncr)
          (BITBLT gameWindow xStart y saveMap)
          (BITBLT (@ player icon)
		  NIL NIL gameWindow xStart y)

          (* * Drive the Truck through the x positions. x is where the truck image is now in the gameboard.)


          [for x from xStart to xStop by truckIncr
	     do (WaitIfControlKey "driving")                 (* Update the PaintMap.)
		(BITBLT saveMap NIL NIL paintMap NIL NIL truckIncr height) 
                                                             (* Shift and update the saveMap.)
		(BITBLT saveMap truckIncr NIL saveMap NIL NIL endSave height)
		(BITBLT gameWindow (IPLUS x nextCol)
			y saveMap endSave NIL truckIncr height)
                                                             (* Move the Truck.)
		(BITBLT paintMap NIL NIL gameWindow x y)
		(SETQ truckX x)                              (* Adjust speed as needed.)
		[COND
		  ((ILESSP (IDIFFERENCE xStop x)
			   truckSlowDownDistance)
		    (SETQ tempTruckDelay (ADD1 tempTruckDelay]
		(COND
		  ((NEQ tempTruckDelay 0)
		    (WAITMS tempTruckDelay]

          (* * Erase the truck from the road.)


          (BITBLT saveMap NIL NIL gameWindow (IPLUS truckX truckIncr)
		  y)
          (RETURN])

(ELIMINATE
  [LAMBDA (x l)                                              (* sm: "12-JAN-83 16:29")

          (* eliminates x from l, where l is a list of atoms or lists. An item is eliminated either if it is EQUAL to x or 
	  its CAR is EQUAL to x. Returns a new list)


    (COND
      ((NULL l)
	NIL)
      ((EQUAL x (CAR l))
	(ELIMINATE x (CDR l)))
      ((AND (LISTP (CAR l))
	    (EQUAL x (CAAR l)))
	(ELIMINATE x (CDR l)))
      (T (CONS (CAR l)
	       (ELIMINATE x (CDR l])

(FindFirstNIL
  [LAMBDA (lst)                                              (* sm: "15-FEB-83 11:11")
    (COND
      [(for i from 1 to (FLENGTH lst) thereis (NULL (CAR (NTH lst i]
      (T 0])

(FindLocIndex
  [LAMBDA (el l)                                             (* sm: "21-JAN-83 17:23")
                                                             (* given list of roadstops l, finds the index of el)
    (for i from 1 to (LENGTH l) thereis (EQ el (CAR (NTH l i])

(FindRandomNIL
  [LAMBDA (lst)                                              (* sm: "15-FEB-83 11:09")
                                                             (* finds the first NIL in lst randomly)
                                                             (* returns the index of the found element)
    (PROG ((index 0)
	   ri
	   (length (FLENGTH lst)))
          [for i from 1 to length while (ZEROP index)
	     do (SETQ ri (RAND 1 length))
		(COND
		  ((NULL (CAR (NTH lst ri)))
		    (SETQ index ri]
          (RETURN (COND
		    ((ZEROP index)
		      (FindFirstNIL lst))
		    (T index])

(GameClass.New
  [LAMBDA (self a1 a2 a3 a4 a5)                              (* sm: "21-SEP-83 09:26")
                                                             (* New method -
							     sends NewInstance to newly created instance)
    (PROG (inst)
          (SETQ inst (←Super
	      self New))                                     (* (← inst NewInstance a1 a2 a3 a4 a5))
          (RETURN inst])

(GameControlMenu
  [LAMBDA NIL                                                (* sm: "16-SEP-83 17:32")
                                                             (* Create the gameControl Menu)
    (SETQ GameControlWindow (CREATEW GameControlRegion "GameControl"))
    [MenuGetOrCreate GameSuspendMenu (QUOTE ((Suspend (SuspendGame T)
						      "Suspend running Truckin")
					      ("Kill Game" (KillGame)
							   "Kill Running Truckin Game"]
    [MenuGetOrCreate GameAwakeMenu (QUOTE ((Awake (WakeGame)
						  "Resumes suspended game")
					    ("Kill Game" (KillGame)
							 "Kill Running Truckin Game"]
    (ADDMENU GameSuspendMenu GameControlWindow (QUOTE (1 . 1))
	     NIL])

(GameMasterMeta.New
  [LAMBDA (self gameBoardType)                               (* sm: "14-JUN-83 11:32")
                                                             (* Creates and initializes a new GameMaster.)
                                                             (* if gameBoardType is not specified, uses default 
							     gameBoard)
    (PROG (gbClass)
          (SETQ gameMaster (←Super
	      self New))                                     (* Close Game Parameters Window)
          (AND GameParamW (CLOSEW GameParamW))
          (AND GameCommandW (CLOSEW GameCommandW))

          (* * Create a GameBoard.)


          [COND
	    ((AND (GetObjectRec gameBoardType)
		  (← (GetObjectRec gameBoardType)
		     InstOf
		     (QUOTE GameBoard)))
	      (SETQ gbClass gameBoardType))
	    (T (SETQ gbClass (@ gameMaster gameBoard]
          (SETQ gameBoard (← (GetObjectRec gbClass)
			     New))
          (← gameBoard NewBoard)
          (← gameMaster AttachBoard gameBoard)
          (← gameMaster SetUpGauges)
          (RETURN gameMaster])

(GameObject.NewInstance
  [LAMBDA (self name a1 a2 a3 a4)                            (* dgb: "22-SEP-83 15:03")
                                                             (* Received when new instance is created)
                                                             (* Any specialization must return self)
    (←Super
      self NewInstance name a1 a2 a3 a4])

(GenConsumerPr
  [LAMBDA (self)                                             (* sm: "25-JAN-83 13:54")
                                                             (* creates a random value for pr for a consumer at 
							     FirstFech)
    (MAX .1 (FQUOTIENT (FIX (TIMES (RAND (DIFFERENCE (@@ Pr)
						     (TIMES (@@ Pr)
							    .2))
					 (PLUS (@@ Pr)
					       (TIMES (@@ Pr)
						      .2)))
				   100))
		       100.0])

(GenConsumerQty
  [LAMBDA (self)                                             (* sm: "25-JAN-83 13:55")
                                                             (* generates a random qty for a consumer at first fetch)
    (IMAX 1 (RAND (FIX (DIFFERENCE (@@ Qty)
				   (TIMES (@@ Qty)
					  .3)))
		  (FIX (PLUS (@@ Qty)
			     (TIMES (@@ Qty)
				    .3])

(GetRuleSetMethods
  [LAMBDA (class)                                            (* sm: "21-SEP-83 11:14")
                                                             (* returns list of RuleSet Instances which are methods 
							     in this class)
    (SORT (for x in (← class List (QUOTE Selectors)) bind y
	     when [NOT (EQ NotSetValue (SETQ y (GetItHere class x (QUOTE RuleSet)
							  (QUOTE METHOD]
	     collect y])

(InCopyCV?
  [LAMBDA (x list)                                           (* sm: "13-JAN-83 10:47")

          (* * if x is in CopyCVList list, returns the matching element from list else NIL)


    (for z in list thereis (COND
			     ((EQUAL x z)
			       x)
			     [(AND (LISTP x)
				   (LISTP z)
				   (EQUAL (CAR x)
					  (CAR z]
			     ((AND (LISTP x)
				   (EQUAL (CAR x)
					  z)))
			     [(AND (LISTP z)
				   (EQUAL x (CAR z]
			     (T NIL])

(InformBandit&WS
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "18-MAY-83 09:02")
                                                             (* This is a putFn for (truck location) to check if 
							     location has Bandit or Weigh Station)
    (PROG (fine bandit (penalty 0))
          (PutLocalState activeVal newValue self varName propName type)
          [COND
	    ((NOT (← (@ driver)
		     InstOf!(QUOTE Bandit)))
	      [COND
		((← newValue InstOf!(QUOTE WeighStation))    (* check if forced to stop here)
		  [COND
		    (forcedStop (← newValue Unpark)
				(← newValue Crash)
				[SETQ penalty (TIMES (@ newValue penaltyFactor)
						     (PLUS 10 (@ weight]
				(BrokenRules currentPlayer 
					     "Speeding past a WeighStation at high speed"
					     NIL NIL (CONCAT "Forcibly stopped!! at "
							     (@@ newValue RoadSign]
                                                             (* add any penalty to regular fine)
		  [SETQ fine (FIX (PLUS penalty (TIMES (@ newValue weightTax)
						       (PLUS 10 (@ weight]
		  (COND
		    ((NOT (LESSP (@ cashBox)
				 fine))
		      (WriteGameStatus (CONCAT (@(@ driver)
						 driver)
					       " paid total Wt. Tax $")
				       fine)
		      (ChangeValue self (QUOTE cashBox)
				   (IDIFFERENCE (@ cashBox)
						fine)))
		    (T (BrokenRules self (CONCAT "Cannot pay WeighStation tax of $" fine)
				    NIL 1]
	      (COND
		((SETQ bandit (← newValue Bandit?))
		  (← newValue Flash)
		  [COND
		    [forcedStop (← newValue Unpark)
				(← newValue Crash)
				(WriteGameStatus "BANDITS stopped you!! " (@(@ driver)
						   driver)
						 (CONCAT " at " (@@ newValue RoadSign]
		    (T (WriteGameStatus "BANDITS robbed you!! " (@(@ driver)
					  driver]
		  (SETQ fine (FIX (TIMES (@ cashBox)
					 .2)))
		  (ChangeValue self (QUOTE cashBox)
			       (IDIFFERENCE (@ cashBox)
					    fine))
		  (WriteGameStatus "Cash lost: $" fine)
		  (for x in (@ cargo) when (← x InstOf!(QUOTE LuxuryGoods))
		     do (COND
			  ((← x TransferOwner bandit (@ bandit pr))
			    (WriteGameStatus "Bandits Stole: " (CONCAT (@ x qty)
								       " "
								       (ClassName x))
					     " units"]
          (RETURN newValue])

(InitializeTruckin
  [LAMBDA NIL                                                (* sm: "28-JUN-83 10:35")
                                                             (* Initializes the TRUCKIN game.
							     Sets up the Display, the gameMaster, etc.)
    (PROG ((yMargin 5))                                      (* Clear TRUCKINVARS.)
          (for var in TRUCKINVARS do (SET var NIL))          (* Change machine dependent parameters)
                                                             (* Ratio for equalizing different machines)
          (SETQ HandicapRatio 1)
          (SetMachineDepPara)                                (* Vars used in reporting Penalty and Reason for failed 
							     transaction)
          (SETQ FCTReason (SETQ FCTPenalty NIL))             (* Vars used in reporting Reason and Penalty for failed 
							     Move)
          (SETQ MReason (SETQ MPenalty NIL))                 (* Truckin Parameters. Number of Moves, Delay, 
							     AliceCount.)
                                                             (* actual file in which game log is being saved)
          (SETQ truckinLogHandle NIL)                        (* generic file name for game log)
          (SETQ truckinLogFile (QUOTE TRUCKINLOG))
          (SETQ truckinLogFlg NIL)
          (SETQ timeTrace (SETQ debugTimeTrace NIL))
          (SETQ debugMode T)                                 (* Used by DemoPlayers)
          (SETQ DemoPlayerMode NIL)                          (* controls if default gauges are attached)
          (SETQ defaultGaugesFlg T)
          (SETQ replenishFreq 40)
          (SETQ banditCount 2)
          (SETQ aliceCount 2)
          (SETQ truckDelay 0)
          (SETQ truckSlowDownDistance 30)                    (* how often bandits move)
          (SETQ banditMoveFrequency 5)                       (* how far apart from current position they move)
          (SETQ banditMoveRange 15)
          (SETQ banditIndex 1)                               (* cutoff below which bandits will not rob if reach 
							     truckers location)
          (SETQ banditCutOff 1)
          (SETQ banditNames
	    (QUOTE (Bonnie Clyde Capone JesseJ RHood Zorro Robber Thief Thug Mugger Clyde2 Clyde3 
			   Clyde4 Clyde5 Clyde6 Zorro2 Zorro3 Zorro4 Zorro5 Zorro6 Thief2 Thief3 
			   Thief4 Thief5 Thief6 Thug2 Thug3 Thug4 Thug5 Thug6)))
                                                             (* Constant offsets for game.)
                                                             (* These globals are used to store names of major 
							     Truckin Instances)
          [SETQ Communicator (SETQ DecisionMaker (SETQ PlayerInterface (SETQ GameBoard (SETQ 
		    Simulator NIL]
          (SETQ roadStopHalfWidth (IQUOTIENT (@@($ RoadStop)
					       Width)
					     2))
          (SETQ xTunnelLeft -100)
          (SETQ xTunnelRight (IPLUS (@@($ Player)
				      Width)
				    100))                    (* Create a blank Player icon and blank qty icon.)
          (SETQ blankPlayerIcon (BITMAPCREATE (@@($ Player)
						Width)
					      (@@($ Player)
						Height)))
          [SETQ blankDataIcon (BITMAPCREATE (IDIFFERENCE (@@($ RoadStop)
							   Width)
							 (ITIMES 2 lineSize))
					    (FONTPROP dataFont (QUOTE HEIGHT]
                                                             (* Create some reusable bitmaps for the Truck Driving 
							     routines.)

          (* Compute Y coordinate for updating data in the RoadStop displays. This quantity need only be added to the y 
	  coordinate of a RoadStop when updating the data in the display.)


          (SETQ yData (IDIFFERENCE (IDIFFERENCE (IDIFFERENCE (IDIFFERENCE (@@($ RoadStop)
									    Height)
									  (FONTPROP roadSignFont
										    (QUOTE HEIGHT)))
							     (FONTPROP dataFont (QUOTE HEIGHT)))
						iconSide)
				   yMargin])

(IntervalToEvent
  [LAMBDA (time)                                             (* sm: " 5-JUL-83 19:00")
                                                             (* returns the time in MS to "time" if "time" is in 
							     future else 0 Does correct wraparound on IDATE clock)
                                                             (* This function was written with JonL's help -
							     consult him for debugging it)
    (PROG (waitinterval)                                     (* ((waitinterval (NCREATE (QUOTE FIXP)))) 
							     (\PUTBASEFIXP waitinterval 0 time) 
							     (\BOXIDIFFERENCE waitinterval 
							     (IDATE)))
          (SETQ waitinterval (IDIFFERENCE time (IDATE)))
          (RETURN (COND
		    ((IGEQ waitinterval 0)
		      (ITIMES 1000 waitinterval))
		    (T 0])

(InvertIcon
  [LAMBDA (icon)                                             (* mjs: "17-JAN-83 18:07")

          (* * Returns the mirror image of the given icon.)


    (PROG (rIcon)

          (* * Make a bitmap for the reflected icon.)


          (SETQ rIcon (BITMAPCOPY icon))
          (BITBLT icon NIL NIL rIcon NIL NIL NIL NIL (QUOTE INVERT)
		  (QUOTE REPLACE))
          (RETURN rIcon])

(KillGame
  [LAMBDA NIL                                                (* sm: "16-SEP-83 17:19")
    (DEL.PROCESS (QUOTE GameClock))
    (DEL.PROCESS (QUOTE WorldProcess))
    (DEL.PROCESS (QUOTE InterimWorldProcess))
    (← Communicator CleanGameWorld])

(MailOut
  [LAMBDA (comm exp)                                         (* sm: "13-JUL-83 17:49")
    (for x in (@ comm broadcastList) do (ERSETQ (ApplyMethod x (CAR exp)
							     (CDR exp)
							     (Class x])

(MakeDriveBitMaps
  [LAMBDA (bitsPerPixel)                                     (* mjs: "18-MAY-83 16:19")

          (* * Make re-usable bitmaps for Truck motion effects.)


    (SETQ saveMap (BITMAPCREATE (@@($ Player)
				  Width)
				(@@($ Player)
				  Height)
				bitsPerPixel))
    (SETQ paintMap (BITMAPCREATE (IPLUS truckIncr (@@($ Player)
					  Width))
				 (@@($ Player)
				   Height)
				 bitsPerPixel])

(MakePlayerFile
  [LAMBDA (playerClass)                                      (* sm: "21-SEP-83 11:14")
                                                             (* Makes a file for the playerClass by the same name)
    (PROG [playerName fileVar temp file (options (QUOTE (NEW C ST]
          (COND
	    ((GetClassRec playerClass)
	      (SETQ playerClass (GetClassRec playerClass))
	      (SETQ playerName (GetObjectName playerClass)))
	    (T (printout TTY playerClass " is NOT a class." T 
			 "Please call this function with a valid class/className as arg"
			 T)
	       (RETURN NIL)))
          (SETQ file (U-CASE playerName))
          (SETQ fileVar (MKATOM (CONCAT file "COMS")))
          [COND
	    [(BOUNDP fileVar)                                (* file exists)
	      (printout TTY "File: " file " already exists." T)
	      (COND
		[(EQ (QUOTE YES)
		     (INTTY "Should I reuse existing file? " (QUOTE (YES NO))
			    "Y - reuse existing file. N - make it afresh"))
		  (SETQ options (QUOTE (RC ST]
		(T (SET fileVar (LIST (LIST (QUOTE CLASSES)
					    playerName)
				      [CONS (QUOTE FNS)
					    (SORT (APPEND (← playerClass List (QUOTE Functions]
				      (CONS (QUOTE INSTANCES)
					    (GetRuleSetMethods playerClass]
	    (T (SET fileVar (LIST (LIST (QUOTE CLASSES)
					playerName)
				  [CONS (QUOTE FNS)
					(SORT (APPEND (← playerClass List (QUOTE Functions]
				  (CONS (QUOTE INSTANCES)
					(GetRuleSetMethods playerClass]
          (printout TTY "Following is being saved on the file: " file T T)
          (printout TTY (EVALV fileVar)
		    T T)
          (printout TTY "If you want to add any more items to this file" T 
		    "select from the following items to be added to file: "
		    file T)
          (FILES?)
          (MAKEFILE file options)
          (RETURN file])

(NormalizeValue
  [LAMBDA (value factor)                                     (* sm: "18-MAY-83 08:55")
    (PROG [(by (COND
		 ((NULL factor)
		   100)
		 (T factor]
          (RETURN (COND
		    ((ZEROP by)
		      (FIX value))
		    (T (FQUOTIENT (FIX (TIMES value by))
				  by])

(PlayerInterruptMenu
  [LAMBDA (playerList POSorX Y)                              (* dgb: "11-JUL-83 13:11")
    (PROG [(w (ADDMENU (create MENU
			       ITEMS ← playerList
			       WHENSELECTEDFN ←(QUOTE RunPlayerRE]
          (WINDOWPROP w (QUOTE TITLE)
		      "Interrupt Player")
          (MOVEW w POSorX Y)
          (RETURN w])

(RunPlayerRE
  [LAMBDA (playerName menu key)                              (* sm: "19-SEP-83 10:42")

          (* Calls RE (rule exec) in Player process. Usually called from Interrupt Player menu, but can be called by anyone.
	  Does not use menu or key argument)


    (PROG ((playerProcess (FIND.PROCESS playerName)))
          (OR playerProcess (RETURN (printout PROMPTWINDOW .TAB0 0 playerName 
					      " is NOT a running player")))
          (PROCESS.EVAL playerProcess (LIST (QUOTE RunPlayerRE1)
					    (KWOTE playerName)))
                                                             (* Suspend Game, with clock process running, but 
							     GameControl window closed)
          (SuspendGame NIL T])

(RunPlayerRE1
  [LAMBDA (playerName awakeWho)                              (* sm: "16-SEP-83 17:36")
                                                             (* Called from RunPlayerRE to call RE in a TTYPROCESS)
    (RESETFORM (TTY.PROCESS (THIS.PROCESS))
	       (AND (@ PlayerInterface playerMenuWindow)
		    (CLOSEW (@ PlayerInterface playerMenuWindow)))
	       (NLSETQ (RE playerName))
	       (AND (@ PlayerInterface playerMenuWindow)
		    (OPENW (@ PlayerInterface playerMenuWindow)))
	       (WakeGame])

(RandomRoomAvailable
  [LAMBDA (begin end lastChoice)                             (* sm: " 5-JUL-83 15:20")
                                                             (* tries to randomly find a location between begin and 
							     end where there is room to park)
                                                             (* RETURNS lastChoice if all locs between these limits 
							     are filled)
    (PROG [(rs (@ Simulator roadStops))
	   index seen (maxSize (ADD1 (IDIFFERENCE end begin]
      LOOP(SETQ index (RAND begin end))
          [COND
	    ((FMEMB index seen)
	      (GO LOOP))
	    (T (SETQ seen (CONS index seen]
          (COND
	    ((← (CAR (NTH rs index))
		RoomToPark?)
	      (RETURN index)))
          (COND
	    ((EQUAL (FLENGTH seen)
		    maxSize)
	      (RETURN lastChoice)))
          (GO LOOP])

(ReceiveIn
  [LAMBDA (comm)                                             (* sm: " 7-JUL-83 17:29")
                                                             (* Receives a message from Gateway and sends it to comm)
    (PROG (msg)
          (SETQ msg (← (@ comm postman)
		       Receive))
          (COND
	    (msg (ApplyMethod comm (CAR msg)
			      (CDR msg)
			      (Class comm])

(ReflectIcon
  [LAMBDA (icon)                                             (* mjs: "14-JAN-83 14:00")

          (* * Returns the mirror image of the given icon.)


    (PROG (rIcon)

          (* * Make a bitmap for the reflected icon.)


          (SETQ rIcon (BITMAPCREATE iconSide iconSide))
          (for (col rCol) from 0 to (SUB1 iconSide)
	     do (SETQ rCol (IDIFFERENCE (SUB1 iconSide)
					col))
		(BITBLT icon col 0 rIcon rCol 0 1 iconSide))
          (RETURN rIcon])

(STRINGNUM
  [LAMBDA (NUM WIDTH)                                        (* sm: "24-JAN-83 14:47")
    (PROG ((string (MKSTRING NUM)))
          (RETURN (COND
		    ((IGREATERP (NCHARS string)
				WIDTH)
		      (SUBSTRING string 1 WIDTH))
		    (T string])

(SendOut
  [LAMBDA (comm exp)                                         (* sm: " 7-JUL-83 17:29")
    (← (@ comm postman)
       Send exp])

(SetMachineDepPara
  [LAMBDA NIL                                                (* smL "14-Jan-85 16:50")
                                                             (* Sets para dependent on Machinetype)
    (SELECTQ (MACHINETYPE)
	     (DORADO (SETQ truckIncr 1)
		     (SETQ HandicapRatio 1))
	     (DOLPHIN (SETQ truckIncr 8)
		      (SETQ HandicapRatio .25))
	     (DANDELION (SETQ truckIncr 3)
			(SETQ HandicapRatio .4))
	     (PROGN (SETQ truckIncr 1)
		    (SETQ HandicapRatio 1])

(SetUpGame
  [LAMBDA (numPlayers gameType)                              (* dgb: " 9-JUN-83 13:26")
    (← ($! (OR gameType (QUOTE TimeTruckin)))
       New)
    (AND numPlayers (CreatePlayers numPlayers])

(SettifyCopyCV
  [LAMBDA (list)                                             (* sm: "13-JAN-83 10:22")

          (* * takes a newly created CopyCV list and removes duplicate entries from the right end)


    (PROG ((new (CONS)))
          [for x in list do (COND
			      ((InCopyCV? x (CAR new)))
			      (T (TCONC new x]
          (RETURN (CAR new])

(SetupGameBrowsers
  [LAMBDA NIL                                                (* sm: " 9-SEP-83 14:55")
                                                             (* sets up class browsers for various class hierarchies 
							     in TRUCKIN world)
    (PROG (x)
          (SETQ x (← ($ ClassBrowser)
		     New))
          (PutValue x (QUOTE title)
		    "GameObject lattice")
          (← x Show (QUOTE (GameObject)))
          (SETQ x (← ($ ClassBrowser)
		     New))
          (PutValue x (QUOTE title)
		    "Commodity lattice")
          (← x Show (QUOTE (Commodity)))
          (SETQ x (← ($ ClassBrowser)
		     New))
          (PutValue x (QUOTE title)
		    "Commodity and transportability lattice")
          (← x Show (QUOTE (Commodity CommodityTransportability)))
          (SETQ x (← ($ ClassBrowser)
		     New))
          (PutValue x (QUOTE title)
		    "Hazard lattice")
          (← x Show (QUOTE (Hazard)))
          (RETURN NIL])

(SmashCreateCommodity
  [LAMBDA (self varName localSt propName activeVal type)     (* mjs: "25-JAN-83 13:31")
                                                             (* This is a getFn for creating a new commodity instance
							     for a producer and smashing the active value)
    (PROG (commodity qty pr)
          [SETQ qty (IMAX 1 (PROGN (RAND (FIX (DIFFERENCE (@@ Qty)
							  (TIMES (@@ Qty)
								 .3)))
					 (FIX (PLUS (@@ Qty)
						    (TIMES (@@ Qty)
							   .3]
          [SETQ pr (MAX .1 (PROGN (FQUOTIENT (FIX (TIMES (RAND (DIFFERENCE (@@ Pr)
									   (TIMES (@@ Pr)
										  .2))
							       (PLUS (@@ Pr)
								     (TIMES (@@ Pr)
									    .2)))
							 100))
					     100.0]
          (SETQ commodity (← (@@ Commodity)
			     New pr qty self))
          (ReplaceActiveValue activeVal commodity self varName propName type)
          (RETURN commodity])

(SmashRandomPerishable
  [LAMBDA (self varName localSt propName activeVal type)     (* sm: "25-JAN-83 18:59")
                                                             (* This is a getFn for generating the random Lifetime 
							     for PerishableCommodities)
    (ReplaceActiveValue activeVal (PROGN (RAND (@@ MinLifetime)
					       (@@ MaxLifetime)))
			self varName])

(SubstituteStop
  [LAMBDA (lst index new)                                    (* sm: "15-FEB-83 11:06")
                                                             (* substitutes index element in lst by new)
                                                             (* if index is 0, does nothing)
    (PROG NIL
          (COND
	    [(OR (NOT (NUMBERP index))
		 (ILEQ index 0)
		 (GREATERP index (FLENGTH lst]
	    (T (RPLACA (NTH lst index)
		       new)))
          (RETURN lst])

(SuspendGame
  [LAMBDA (clockFlg closeFlg)                                (* sm: "19-SEP-83 11:00")
                                                             (* Suspends game, switching menus)
                                                             (* Suspends clockprocess only if clockFlg is non-NIL)
                                                             (* If clockFlg is non-NIL closes GameControlWindow 
							     instead of switching menus)
    (COND
      (closeFlg (AND GameControlWindow (CLOSEW GameControlWindow)))
      (T (OPENW GameControlWindow)
	 (SwitchMenu GameSuspendMenu GameAwakeMenu GameControlWindow)))
    (AND clockFlg (FIND.PROCESS (QUOTE GameClock))
	 (SUSPEND.PROCESS (QUOTE GameClock)))
    (AND (FIND.PROCESS (QUOTE InterimWorldProcess))
	 (SUSPEND.PROCESS (QUOTE InterimWorldProcess)))
    (AND (FIND.PROCESS (QUOTE WorldProcess))
	 (SUSPEND.PROCESS (QUOTE WorldProcess])

(SwitchMenu
  [LAMBDA (fromMenu toMenu window pos)                       (* dgb: "11-JUL-83 18:19")
    (DELETEMENU fromMenu)
    (ADDMENU toMenu window pos])

(TalkinBuyMade
  [LAMBDA (player roadPosition reqQty qty reason penalty fragility lifetime)
                                                             (* sm: "13-JUN-83 14:53")
                                                             (* Dummy function. To be superseded)
    NIL])

(TalkinMoveMade
  [LAMBDA (player from to reason penaltyAmt missTurn)        (* sm: "13-JUN-83 14:51")
                                                             (* Dummy function. To be superseded)
    NIL])

(TalkinSellMade
  [LAMBDA (player roadPosition reqQty qty cargoPosition reason penalty)
                                                             (* sm: "13-JUN-83 15:00")
                                                             (* Dummy function. To be superseded)
    NIL])

(TruckinError
  [LAMBDA (msg)                                              (* mjs: "10-JAN-83 16:06")
    (PROMPT msg])

(TruckinRE
  [LAMBDA (player)                                           (* dgb: "11-JUL-83 13:17")
                                                             (* Calls RE but not charge for time spent in RE)
    (PROG (begT endT)
          (COND
	    [(AND (BOUNDP (QUOTE PlayerInterface))
		  (GetObjectRec PlayerInterface))
	      (SETQ begT (CLOCK))
	      [RunPlayerRE (COND
			     ((LITATOM player)
			       player)
			     (T (GetObjectName player]
	      (SETQ endT (CLOCK))
	      (←@
		PlayerInterface unchargedTime (IPLUS (@ PlayerInterface unchargedTime)
						     (IDIFFERENCE endT begT]
	    (T (RunPlayerRE (COND
			      ((LITATOM player)
				player)
			      (T (GetObjectName player])

(UpdateConsumerDisplay
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "28-JUN-83 09:43")
                                                             (* This is a putFn for qty for informing consumers to 
							     change displayed quantity)
    (PutLocalState activeVal newValue self varName propName type)
    (← Simulator UpdateRS self)
    newValue])

(UpdatePrDisplay
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "20-JAN-83 14:40")
                                                             (* This is a putFn for pr in Commodity and updates 
							     Producer display if pr changes)
    (PutLocalState activeVal newValue self varName propName type)
    (COND
      ((AND (GetObjectRec (@ owner))
	    (← (@ owner)
	       InstOf!(QUOTE Producer)))                     (* as this is owned by a Producer, update display on 
							     game board)
	(← (@ owner)
	   DisplayData)))
    newValue])

(UpdateProducerSoldout
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "27-JAN-83 18:54")
                                                             (* This is a putFn for Producers for creating a 
							     commodity instance with 0 qty when soldout)
    (PutLocalState activeVal newValue self varName propName type)
    (COND
      ((NULL newValue)
	(PutValue self varName (← (@@ Commodity)
				  New
				  (@@ Pr)
				  0 self))
	(← self DisplayData])

(UpdateQtyDisplay
  [LAMBDA (self varName newValue propName activeVal type)    (* mjs: "19-JAN-83 18:31")
                                                             (* This is a putFn for qty in Commodity for informing 
							     producers to change displayed quantity)
    (PutLocalState activeVal newValue self varName propName type)
    (COND
      ((AND (GetObjectRec (@ owner))
	    (← (@ owner)
	       InstOf!(QUOTE Producer)))                     (* this commodity is owned by a producer so update 
							     display)
	(← (@ owner)
	   DisplayData)))
    newValue])

(WSRuleViolated?
  [LAMBDA (player rs speed)                                  (* sm: " 7-JUN-83 12:07")
                                                             (* checks if going too fast past a WeighStation)

          (* * RETURNS: NIL if not caught)


    (PROG ((truck (@ player truck))
	   fine)
          (RETURN (COND
		    ((GREATERP speed (RAND 4 (@@ truck MaxDist)))
                                                             (* (BrokenRules currentPlayer 
							     "Passing WeighStation at high speed" 
							     (MAX .25 (DIFFERENCE (FQUOTIENT 
							     (@ truck weight) (@@ truck MaxWeight)) .5)) NIL 
							     "Forcibly stopped at WeighStation"))
		      T)
		    (T NIL])

(WaitIfControlKey
  [LAMBDA (where)                                            (* sm: "10-JUL-83 21:25")

          (* * Temporarily suspend computation if CONTROL key is depressed. Resumes when key is lifted.)


    (PROG (begT endT)
          [COND
	    ((KEYDOWNP (QUOTE CTRL))
	      (SETQ begT (CLOCK))
	      (while (KEYDOWNP (QUOTE CTRL))
		 do (COND
		      ((KEYDOWNP (QUOTE LSHIFT))
			(AND where (printout PPDefault where T))
			(EVAL.IN.TTY.PROCESS (QUOTE (UE))
					     T)))
		    (WAITMS 500))
	      (SETQ endT (CLOCK))                            (* (PutValue PlayerInterface 
							     (QUOTE unchargedTime) (IPLUS 
							     (@ PlayerInterface unchargedTime) 
							     (IDIFFERENCE endT begT))))
	      ]
          (RETURN where])

(WakeGame
  [LAMBDA NIL                                                (* sm: "19-SEP-83 10:38")
                                                             (* resumes a suspended game, switching menus)
    (AND (FIND.PROCESS (QUOTE WorldProcess))
	 (WAKE.PROCESS (QUOTE WorldProcess)))
    (AND (FIND.PROCESS (QUOTE InterimWorldProcess))
	 (WAKE.PROCESS (QUOTE InterimWorldProcess)))
    (AND (FIND.PROCESS (QUOTE GameClock))
	 (WAKE.PROCESS (QUOTE GameClock)))
    (OPENW GameControlWindow)
    (SwitchMenu GameAwakeMenu GameSuspendMenu GameControlWindow])

(WriteGameStatus
  [LAMBDA (msg boldMsg moreMsg asIsFlg)                      (* mjs: " 2-AUG-83 11:27")
                                                             (* Writes a message to a gameStatusWindow.
							     The middle part of the message in boldMsg is printed in 
							     BOLD font. All arguments are optional.)
                                                             (* if asIsFlg is Non-NIL, then does not position to 
							     beginning of line)
                                                             (* Pause if Control Key is Depressed.)
    (WaitIfControlKey)

          (* * Create status window if needed.)


    (PROG (oldFont begT endT)
          (SETQ begT (CLOCK))
          [COND
	    ((NOT (WINDOWP gameStatusWindow))
	      (PROG (left bottom (width 300)
			  (height 175))
		    (SETQ left (IDIFFERENCE SCREENWIDTH width))
		    (SETQ bottom (IDIFFERENCE SCREENHEIGHT height))
		    (SETQ gameStatusWindow
		      (CREATEW (create REGION
				       LEFT ← left
				       BOTTOM ← bottom
				       WIDTH ← width
				       HEIGHT ← height)
			       "Game Status"))
		    (DSPSCROLL (QUOTE ON)
			       gameStatusWindow]
          [COND
	    ((AND (NULL truckinLogHandle)
		  truckinLogFlg)
	      (SETQ truckinLogHandle (OPENFILE truckinLogFile (QUOTE OUTPUT]

          (* * Print out the three messages in appropriate fonts.)


          [for file in (COND
			 (truckinLogFlg (LIST gameStatusWindow truckinLogHandle))
			 (T (LIST gameStatusWindow)))
	     do (COND
		  ((NOT asIsFlg)
		    (printout file .TAB0 0)))
		(COND
		  (msg (printout file msg)))
		(COND
		  (boldMsg (printout file .FONT BOLDFONT boldMsg .FONT DEFAULTFONT)))
		(COND
		  (moreMsg (printout file moreMsg]
          (SETQ endT (CLOCK))                                (* (PutValue PlayerInterface 
							     (QUOTE unchargedTime) (IPLUS 
							     (@ PlayerInterface unchargedTime) 
							     (IDIFFERENCE endT begT))))
          (RETURN T])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PlayerProcRestFlg GameProcRestFlg)
)

(RPAQQ GameCommandX 585)

(RPAQQ GameCommandY 651)

(RPAQQ GameParamRegion (622 650 273 140))

(RPAQQ HandicapRatio 1)

(RPAQQ aliceCount 2)

(RPAQQ banditCount 2)

(RPAQQ banditMoveFrequency 5)

(RPAQQ banditMoveRange 15)

(RPAQQ debugMode T)

(RPAQQ debugTimeTrace NIL)

(RPAQQ defaultGaugesFlg T)

(RPAQQ GameControlRegion (645 635 68 48))

(RPAQQ GameControlMenu NIL)

(RPAQQ GameControlWindow NIL)

(RPAQQ GameSuspendMenu NIL)

(RPAQQ GameAwakeMenu NIL)

(APPENDTOVAR BREAKRESETFORMS (TTY.PROCESS (THIS.PROCESS)))
[METH CommodityMeta  New (pr qty owner)
      (* create a new instance of a commodity with qty, pr, and owner specified)]


[METH CommodityMeta  Subs! NIL
      NIL]


[METH GameAbstractClass  New NIL
      NIL]


[METH GameBoard  NewInstance (simulator)
      (* Received when new instance is created)]


[METH GameClass  AddCV! (name value copyValue)
      (* * Adds CV to self, its subs, and CopyCV list)]


[METH GameClass  DeleteCV! (name)
      (* * Deletes CV from self, its subs, and CopyCV list)]


[METH GameClass  RenameCV! (oldName newName)
      (* * Renames a CV in self and all subclasses. Changes CopyCV list also.)]


[METH GameClass  Subs! NIL
      (* sm: " 7-JAN-83 11:55")]


[METH GameMetaClass  New (name supers)
      (* * New method for creating new Game classes)]


[METH GameObject  AddGauges (ivs default titleForm)
      (* Adds a collection of gauges to the ivs of some game object under interactive control of a 
	 user.)]


[METH GameObject  Initialize NIL
      (* Initializes)]


[METH GameParameters  LoadPara NIL
      (* Loads the defined parameters with existing values)]


[METH GameParameters  SetUp NIL
      (* Displays the inspector containing parameters, and a menu to signal when to accept the 
	 parameters)]


[METH GameParameters  StorePara NIL
      (* Store values where they came from)]


(DEFINEQ

(CommodityMeta.New
  (Method ((CommodityMeta New)
	   self pr qty owner)                                (* mjs: " 2-AUG-83 11:22")
                                                             (* create a new instance of a commodity with qty, pr, 
							     and owner specified)
                                                             (* Only producers are allowed as legal owners for this 
							     method)
                                                             (* also adds to the CV Producers)
                                                             (* if qty is NIL, interprets pr as the name of the 
							     instance. This allows the instances to be used for 
							     demos)
	  (PROG (new)
	        (SETQ new (DoMethod self (QUOTE New)
				    ($ Class)))
	        (COND
		  ((NULL qty)
		    (COND
		      (pr (← new SetName pr)))
		    (RETURN new))
		  [(OR (EQUAL owner (QUOTE *SPECIAL*))
		       (← owner InstOf!(QUOTE Producer]
		  (T (printout TTY "Attempt to illegally create an instance of commodity" T)
		     (RETURN NIL)))
	        (←@
		  new qty qty)
	        (←@
		  new pr pr)
	        (COND
		  ((EQUAL owner (QUOTE *SPECIAL*)))
		  (T (←@
		       new owner owner)))
	        (RETURN new))))

(CommodityMeta.Subs!
  (Method ((CommodityMeta Subs!)
	   self)                                             (* sm: " 7-JAN-83 11:53")
	  NIL))

(GameAbstractClass.New
  (Method ((GameAbstractClass New)
	   self)
	  (AbstractClass.New self)))

(GameBoard.NewInstance
  (Method ((GameBoard NewInstance)
	   self simulator)                                   (* dgb: "22-SEP-83 15:18")
                                                             (* Received when new instance is created)
                                                             (* Any specialization must return self)
	  (←Super
	    self NewInstance)))

(GameClass.AddCV!
  (Method ((GameClass AddCV!)
	   self name value copyValue)                        (* sm: " 8-FEB-83 16:27")

          (* * Adds CV to self, its subs, and CopyCV list)

                                                             (* copyValue determines the value copied over.
							     If not given, NotSetValue is used.
							     Otherwise copyValue is copied to Subs)
	  (PROG NIL
	        (← self Add (QUOTE CV)
		   name value)
	        (COND
		  ([NOT (FMEMB (QUOTE CopyCV)
			       (← self List (QUOTE CVs]
		    (← self Add (QUOTE CV)
		       (QUOTE CopyCV)
		       NIL)))
	        [PutClassValue self (QUOTE CopyCV)
			       (SettifyCopyCV (ATTACH (COND
							((NULL copyValue)
							  name)
							(T (LIST name copyValue)))
						      (GetClassValue self (QUOTE CopyCV]
	        (for x in (← self List (QUOTE Subs)) do (← (GetObjectRec x)
							   AddCV! name (COND
							     (copyValue copyValue)
							     (T NotSetValue))
							   copyValue))
	        (RETURN name))))

(GameClass.DeleteCV!
  (Method ((GameClass DeleteCV!)
	   self name)                                        (* sm: "12-JAN-83 16:12")

          (* * Deletes CV from self, its subs, and CopyCV list)


	  (PROG NIL
	        (← self Delete (QUOTE CV)
		   name)
	        [COND
		  ((FMEMB (QUOTE CopyCV)
			  (← self List (QUOTE CVs)))
		    (PutClassValue self (QUOTE CopyCV)
				   (ELIMINATE name (GetClassValue self (QUOTE CopyCV]
	        (for x in (← self List (QUOTE Subs)) do (← (GetObjectRec x)
							   DeleteCV! name))
	        (RETURN name))))

(GameClass.RenameCV!
  (Method ((GameClass RenameCV!)
	   self oldName newName)                             (* sm: "12-JAN-83 13:01")

          (* * Renames a CV in self and all subclasses. Changes CopyCV list also.)


	  (RenameVariable (GetObjectName self)
			  oldName newName T)
	  [PutClassValue self (QUOTE CopyCV)
			 (SUBST newName oldName (GetClassValue self (QUOTE CopyCV]
	  (for x in (← self List (QUOTE Subs)) eachtime (SETQ y (GetObjectRec x))
	     do (← y RenameCV! oldName newName))
	  newName))

(GameClass.Subs!
  [Method ((GameClass Subs!)
	   self)                                             (* sm: "12-JAN-83 12:44")
                                                             (* sm: " 7-JAN-83 11:55")
	  (PROG [(subs (← self List (QUOTE Subs]
	        (RETURN (APPEND subs (for x in subs join (← (GetObjectRec x)
							    Subs!])

(GameMetaClass.New
  (Method ((GameMetaClass New)
	   self name supers)                                 (* sm: " 9-SEP-83 14:54")

          (* * New method for creating new Game classes)



          (* * Adds the new class to var name found as value of CV ComsVar)



          (* * Copies the description given by CopyCV in the meta class and each of the supers. The form of the CopyCV 
	  description is as follows:)



          (* * (E1 E2 ..En), where if Ei is an atom then creates a CV with name Ei and NotSetValue as value.
	  If Ei is a list of one item then creates CV with first item as CV and value as obtained by inheritance at CREATION 
	  TIME. Otherwise creates CV with second element as the value)


	  (PROG (newClass CopyList y)
	        (←Super
		  self New name supers)
	        (SETQ newClass (GetObjectRec name))
	        [for x in (GetClassValue self (QUOTE CopyCV))
		   do (COND
			((ATOM x)
			  (← newClass Add (QUOTE CV)
			     x NotSetValue))
			(T (← newClass Add (QUOTE CV)
			      (CAR x)
			      (COND
				((NULL (CDR x))
				  (GetClassValueOnly newClass x))
				(T (CADR x]
	        [for x in (REVERSE supers) eachtime (SETQ y (GetObjectRec x))
		   do (PROGN (SETQ CopyList (APPEND (GetClassValue y (QUOTE CopyCV))
						    CopyList))
			     (for z in (GetClassValue y (QUOTE CopyCV))
				do (COND
				     ((ATOM z)
				       (← newClass Add (QUOTE CV)
					  z NotSetValue))
				     (T (← newClass Add (QUOTE CV)
					   (CAR z)
					   (COND
					     ((NULL (CDR z))
					       (GetClassValueOnly y z))
					     (T (CADR z]
	        (← newClass Add (QUOTE CV)
		   (QUOTE CopyCV)
		   (SettifyCopyCV CopyList))
	        (RETURN newClass))))

(GameObject.AddGauges
  (Method ((GameObject AddGauges)
	   self ivs default titleForm)                       (* sm: "10-JUL-83 21:37")
                                                             (* Adds a collection of gauges to the ivs of some game 
							     object under interactive control of a user.)
                                                             (* if default is non-NIL, adds default gauges, else 
							     asks user)

          (* if titleForm is not given, then gauge title is of the form "iv of self". If given as a string, it will be 
	  titleForm. If given as a list, ivname and "of" will be concatenated to the strings in the list)


	  (PROG (gauge gaugeClassName gaugeClassNames res gaugeObj limit gaugePos)

          (* * Initialize constants.)


	        (SETQ ivs (MKLIST ivs))
	        (SETQ gaugeObj self)                         (* Filter out abstract classes.)
	        (SETQ gaugeClassNames (← ($ Gauge)
					 List!(QUOTE Subs)))
	        (SETQ gaugeClassNames (for gcn in gaugeClassNames
					 unless (EQ (ClassName (Class (GetObjectRec gcn)))
						    (QUOTE AbstractClass))
					 collect gcn))

          (* * Loop thru the ivs)


	        (for iv in ivs when [OR default (NOT (EQ (QUOTE NO)
							 (SETQ res (INMENU (CONCAT "Add gauge to " iv 
										   "? ")
									   (QUOTE (YES NO DEFAULT))
									   
		  "Type Y to add a gauge of choice, D for default gauge, and  N to skip this iv."]
		   do [SETQ gaugeClassName (COND
			  ([AND (OR (EQ res (QUOTE DEFAULT))
				    default)
				(GetObjectRec (GetValue gaugeObj iv (QUOTE DefaultGauge]
			    (GetValue gaugeObj iv (QUOTE DefaultGauge)))
			  (T (INMENU "Type of Gauge: " gaugeClassNames NIL (QUOTE NoShift]
		      (SETQ gauge (← (GetClassRec gaugeClassName)
				     New))
		      (SETQ limit (GetValue gaugeObj iv (QUOTE GaugeLimit)))
		      [← gauge SetScale (COND
			   ([OR (NOT (LISTP limit))
				(NOT (NUMBERP (CAR limit]
			     0)
			   (T (CAR limit)))
			 (COND
			   ([OR (NOT (LISTP limit))
				(NOT (NUMBERP (CADR limit]
			     100)
			   (T (CADR limit]
		      (←@
			gauge title (COND
			  ((NULL titleForm)
			    (CONCAT iv " of " (OR (GetObjectName self)
						  self)))
			  ((LISTP titleForm)
			    (CONCAT iv " of " (CAR titleForm)))
			  (T titleForm)))
		      (← gauge Attach gaugeObj iv NIL NIL NIL NIL (COND
			   ([NotSetValue (SETQ gaugePos (GetValue gaugeObj iv (QUOTE GaugePos]
			     NIL)
			   (T gaugePos)))                    (* disable for now. (← gauge Move))
		      )
	        (RETURN ivs))))

(GameObject.Initialize
  [Method ((GameObject Initialize)
	   self)                                             (* sm: " 1-JUL-83 15:39")
                                                             (* Initializes)
	  (for x in (@@ InitializeIVs) do (PutValue self x (GetInitialValue self x])

(GameParameters.LoadPara
  [Method ((GameParameters LoadPara)
	   self)                                             (* sm: "14-JUN-83 15:20")
                                                             (* Loads the defined parameters with existing values)
	  (for x in (← self List (QUOTE IVs)) bind exp val when (SETQ exp (GetValue self x
										    (QUOTE exp)))
	     do [SETQ val (COND
		    ((EQ exp NotSetValue)
		      NotSetValue)
		    ((ATOM exp)
		      (EVALV exp))
		    (T (EVAL (CONS (QUOTE @)
				   exp]
		(PutValue self x val)                        (* Save value in prop oldVal)
		(PutValue self x val (QUOTE oldVal])

(GameParameters.SetUp
  (Method ((GameParameters SetUp)
	   self)                                             (* sm: "19-SEP-83 12:03")
                                                             (* Displays the inspector containing parameters, and a 
							     menu to signal when to accept the parameters)
	  (AND GameCommandW (CLOSEW GameCommandW))
	  (AND GameParamW (CLOSEW GameParamW))
	  (SETQ GameParaSet NIL)
	  (← self LoadPara)
	  (SETQ GameParamW (← self Inspect GameParamRegion))
	  (MOVEW [SETQ GameCommandW (ADDMENU (create MENU
						     ITEMS ←(QUOTE ((DONE (PROGN (CLOSEW GameParamW)
										 (CLOSEW GameCommandW)
										 (SETQ GameParaSet T))
									  
					 "Clicking DONE will cause Game Parameters to be changed"]
		 GameCommandX GameCommandY)))

(GameParameters.StorePara
  [Method ((GameParameters StorePara)
	   self)                                             (* sm: "14-JUN-83 17:21")
                                                             (* Store values where they came from)
	  (for x in (← self List (QUOTE IVs)) bind exp val oldVal changeExp
	     when (SETQ exp (GetValue self x (QUOTE exp)))
	     do (SETQ val (GetValue self x))
		(SETQ oldVal (GetValue self x (QUOTE oldVal)))
		[COND
		  ((EQ exp NotSetValue))
		  ((ATOM exp)
		    (SET exp val))
		  (T (EVAL (CONS (QUOTE ←@)
				 (APPEND exp (CONS val]
		(COND
		  ((AND (NOT (EQUAL val oldVal))
			(NOT (EQ (SETQ changeExp (GetValue self x (QUOTE changeExp)))
				 NotSetValue)))
		    (ERRORSET changeExp T])
)
(PUTPROPS TRUCKIN COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (11361 62498 (AuxBuyMade 11371 . 12058) (AuxMoveMade 12060 . 12655) (AuxSellMade 12657
 . 13312) (BanditGotYou? 13314 . 13695) (BrokenRules 13697 . 15906) (ChangeValue 15908 . 16600) (
CheckVictim 16602 . 17883) (CommodityClassMeta.New 17885 . 18204) (CreateNewPlayer 18206 . 19055) (
CreatePlayers 19057 . 21613) (DrawRoadMarks 21615 . 22727) (Drive 22729 . 25324) (DriveLeft 25326 . 
27163) (DriveRight 27165 . 28963) (ELIMINATE 28965 . 29474) (FindFirstNIL 29476 . 29692) (FindLocIndex
 29694 . 29999) (FindRandomNIL 30001 . 30643) (GameClass.New 30645 . 31065) (GameControlMenu 31067 . 
31785) (GameMasterMeta.New 31787 . 32874) (GameObject.NewInstance 32876 . 33261) (GenConsumerPr 33263
 . 33714) (GenConsumerQty 33716 . 34089) (GetRuleSetMethods 34091 . 34553) (InCopyCV? 34555 . 35039) (
InformBandit&WS 35041 . 37334) (InitializeTruckin 37336 . 41316) (IntervalToEvent 41318 . 42169) (
InvertIcon 42171 . 42580) (KillGame 42582 . 42844) (MailOut 42846 . 43079) (MakeDriveBitMaps 43081 . 
43509) (MakePlayerFile 43511 . 45372) (NormalizeValue 45374 . 45668) (PlayerInterruptMenu 45670 . 
46018) (RunPlayerRE 46020 . 46767) (RunPlayerRE1 46769 . 47303) (RandomRoomAvailable 47305 . 48163) (
ReceiveIn 48165 . 48563) (ReflectIcon 48565 . 49076) (STRINGNUM 49078 . 49342) (SendOut 49344 . 49489)
 (SetMachineDepPara 49491 . 50037) (SetUpGame 50039 . 50255) (SettifyCopyCV 50257 . 50637) (
SetupGameBrowsers 50639 . 51609) (SmashCreateCommodity 51611 . 52525) (SmashRandomPerishable 52527 . 
52920) (SubstituteStop 52922 . 53423) (SuspendGame 53425 . 54371) (SwitchMenu 54373 . 54539) (
TalkinBuyMade 54541 . 54839) (TalkinMoveMade 54841 . 55063) (TalkinSellMade 55065 . 55359) (
TruckinError 55361 . 55488) (TruckinRE 55490 . 56215) (UpdateConsumerDisplay 56217 . 56610) (
UpdatePrDisplay 56612 . 57207) (UpdateProducerSoldout 57209 . 57703) (UpdateQtyDisplay 57705 . 58308) 
(WSRuleViolated? 58310 . 59050) (WaitIfControlKey 59052 . 59851) (WakeGame 59853 . 60428) (
WriteGameStatus 60430 . 62496)) (64567 77092 (CommodityMeta.New 64577 . 65944) (CommodityMeta.Subs! 
65946 . 66096) (GameAbstractClass.New 66098 . 66203) (GameBoard.NewInstance 66205 . 66599) (
GameClass.AddCV! 66601 . 67764) (GameClass.DeleteCV! 67766 . 68416) (GameClass.RenameCV! 68418 . 69007
) (GameClass.Subs! 69009 . 69404) (GameMetaClass.New 69406 . 71349) (GameObject.AddGauges 71351 . 
74269) (GameObject.Initialize 74271 . 74595) (GameParameters.LoadPara 74597 . 75337) (
GameParameters.SetUp 75339 . 76202) (GameParameters.StorePara 76204 . 77090)))))
STOP