(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED 	"14-Aug-2022 10:36:07" 
					{DSK}<home>larry>loops>truckin>TRUCKIN.;2
 94977  

      :CHANGES-TO (FNS GameClass.New GameMasterMeta.New GameObject.NewInstance)
                  (VARS TRUCKINCOMS)

      :PREVIOUS-DATE " 3-Aug-2022 11:36:04" {DSK}<home>larry>loops>truckin>TRUCKIN.;1
	  )

(* ; "Copyright (c) 1985, 1987, 2022 by Xerox Corporation.")

(PRETTYCOMPRINT TRUCKINCOMS)

(printout \TopLevelTtyWindow "Loading TRUCKINCOMS" T)

(RPAQQ TRUCKINCOMS

       ((DECLARE%: DONTCOPY (PROP MAKEFILE-ENVIRONMENT TRUCKIN))
	   
		(* ; 
"Copyright (c) 1983 by Xerox Corporation.")


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

        
        (* ; "JRB - Had to take fonts out of TRUCKINCONSTANTS;
					 DFASL's can't dump font descriptors.")


        (CONSTANTS * TRUCKINCONSTANTS)
        (INITVARS	(roadSignFont (FONTCREATE 'HELVETICA 8 'BOLD))
					(driverFont (FONTCREATE 'HELVETICA 8))
					(dataFont (FONTCREATE 'HELVETICA 10 'BOLD))
					(commodityFont (FONTCREATE 'HELVETICA 8 'BOLD))
					(gameStatusBoldFont (FONTCREATE 'HELVETICA 12 'BOLD))
		)
			   
        (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
		))
)

(printout \TopLevelTtyWindow "Finished Loading TRUCKINCOMS" T)


	(* ;
	"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."
	)



(printout \TopLevelTtyWindow "Defining TRUCKINCONSTANTS" T)

(RPAQQ TRUCKINCONSTANTS
       ((lineSize 1)
        (iconSide 16)
        (boardShade 23130)
        (BLACKCOLOR 0)
        (roadColor 15)
        (roadStopColor 14)
        (roadStopNameColor 13)
        (otherRoadStopIconColor 12)
        (consumerIconColor 11)
        (producerIconColor 10)
        (borderColor 9))
)

(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)

(* ; "(CONSTANTS
	   (lineSize 1)
       (iconSide 16)
       (boardShade 23130)
       (BLACKCOLOR 0)
       (roadColor 15)
       (roadStopColor 14)
       (roadStopNameColor 13)
       (otherRoadStopIconColor 12)
       (consumerIconColor 11)
       (producerIconColor 10)
       (borderColor 9))"
)

(RPAQ? roadSignFont
 (FONTCREATE 'HELVETICA 8 'BOLD))

(RPAQ? driverFont
 (FONTCREATE 'HELVETICA 8))

(RPAQ? dataFont
 (FONTCREATE 'HELVETICA 10 'BOLD))

(RPAQ? commodityFont
 (FONTCREATE 'HELVETICA 8 'BOLD))

(RPAQ? gameStatusBoldFont
 (FONTCREATE 'HELVETICA 12 'BOLD))

(RPAQQ 	TRUCKINCLASSES
		(CommodityClassMeta CommodityMeta GameAbstractClass
		GameBoard GameClass GameMetaClass
		GameObject GameParameters TDMTParameters 
        TruckinDMParameters TruckinParameters)
)

(printout \TopLevelTtyWindow "Defining TRUCKINCLASSES" T)

(DEFCLASSES 	CommodityClassMeta CommodityMeta GameAbstractClass 
				GameBoard GameClass GameMetaClass 
				GameObject GameParameters TDMTParameters
				TruckinDMParameters TruckinParameters
)
	   
(DEFCLASS CommodityClassMeta

	(MetaClass	GameMetaClass
				Edited%: (* ; "sm%: 20-JAN-83")

				doc "MetaClass for all classes of commodities"
	)
	(Supers GameAbstractClass)
	(ClassVariables	(CopyCV NIL)
					(ComsVar Commodities)
	)
)

(DEFCLASS CommodityMeta

	(MetaClass	GameMetaClass
				Edited%: (* ; "sm%: 20-JAN-83")

				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 (QUOTE NotSetValue))
					(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 (QUOTE NotSetValue))
	)
)

(DEFCLASS TDMTParameters

   (MetaClass	GameClass
				Edited%: (* ; "sm%:  30-JUN-83 18:57")

				doc "Parameters for TimeTruckinDM")
   (Supers TruckinDMParameters)
   (ClassVariables 	(CopyCV (Icon))
					(Icon #,NotSetValue)
   )
)

(DEFCLASS TruckinDMParameters

   (MetaClass GameClass Edited%:                             (* ; "sm%: 1-JUL-83 17:42")
)
   (Supers TruckinParameters)
   (ClassVariables (CopyCV NIL))
   (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)")
	)
)

(printout \TopLevelTtyWindow "Defining TruckinParameters" T)

(DEFCLASS TruckinParameters

   (MetaClass GameClass
			  Edited%: (* ; "sm%: 5-AUG-83 09:59")

			  doc "Used for Setting/resetting Truckin parameters")
   (Supers GameParameters)
   (ClassVariables (CopyCV NIL))
   (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 takenby 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")
	)
)

(printout \TopLevelTtyWindow "Defining TruckinVars" T)

(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
	)
)

(printout \TopLevelTtyWindow "Defining TRUCKINFNS" T)

(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
		)
)
		
(printout \TopLevelTtyWindow "At AuxBuyMade" T)
		
(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 the 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	unchargedTim
							(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))
                                                   0.5]
))

(printout \TopLevelTtyWindow "At BrokenRules" T)

(DEFINEQ

(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! '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
										'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! 'RemotePlayer))
					(_ culprit InstOf! 'Player)
			  )
			 (TruckinRE
 culprit)
			)
		)
		   
		(RETURN culprit]
)

(ChangeValue

	[LAMBDA (self var value)
	
		(* ; "dgb%: 27-JAN-83")

		(* ; "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]
))

(printout \TopLevelTtyWindow "At CheckVictim " T)

(DEFINEQ

(CheckVictim

	[LAMBDA (self varName newValue propName activeVal type)   
	
		(* ; "sm%:  19-MAY-83")

		(* ; "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) 0.2)))
			 (ChangeValue
 truck 'cashBox (IDIFFERENCE (@ truck cashBox) loss))
			 (WriteGameStatus
 "Cash lost $" loss)
			 (for
 x in
 (@ truck cargo)
			  when
 (_ x InstOf! 'LuxuryGoods)
			  do

						(COND
							((_ x TransferOwner bandit (@ bandit pr))
							 (WriteGameStatus	"Bandits stole "
												(CONCAT (@ x qty) " " (ClassName x))
												" units")
		]
		
        (RETURN newValue]
)

(CommodityClassMeta.New

	[LAMBDA (self)
		(* edited%: "20-Aug-87")

		(* ; "will complain and NOT create an 
instance")

		
    (printout \TopLevelTtyWindow "Cannot create an instance of a class of commodities!" T)
    NIL
	]
)

(CreateNewPlayer

  [LAMBDA (name type truck)

  (* ; "edited%: 20-Aug-87")

  (* ; "creates a new player, using the 
specified info")

  
	(printout \TopLevelTtyWindow "CreateNewPlayer" T)
	
    (PROG (player res obj temp menuItems plClass)
	
		[COND
			[(AND (SETQ plClass (GetClassRec type))
                  (_ plClass Subclass 'Player)
			]
			(T
				[SETQ	menuItems
						(REMOVE 	'RemotePlayer
									(REMOVE 'DemoPeddler (_ ($ Player) List! 'Subs)
				]
                (SETQ res (INMENU "Type of player- " menuItems "Select type of player" T))
                (SETQ plClass (GetObjectRec res))
		]
		
		(SETQ player (_ plClass New name truck))
		(printout \TopLevelTtyWindow "Player created- " (GetObjectName player) T)
		
		(pushnew
 ExistingPlayers player)
		(RETURN player]
)


(CreatePlayers
	
	[LAMBDA (numOrPlayers)
	
		(* ; "edited%: 20-Aug-87 15-23")

		(* ; "creates num new players and assigns 
them to Global newPlayers")

		(* ; "if num is NIL, allows upto 20 
  players to be created")

		
		(printout \TopLevelTtyWindow "CreatePlayers" index T)
		
		(PROG	((pcount
				 (COND
					((NUMBERP numOrPlayers) numOrPlayers)
					(T 20)
				 ))
				 player players
				 (moreNeeded T)
				 res exPlayers
				 obj temp
				 (miscOptions '(NO))
				 menuItems)
			
			(SETQ	ExistingPlayers
					(for
 x in
 ExistingPlayers
					 when
 (NOT (_ x InstOf! 'DestroyedObject))
                     collect
 x)
			)
			
			[COND
				((AND numOrPlayers (NOT (NUMBERP numOrPlayers)))
				 (SETQ	exPlayers
						(for
 x in
 ExistingPlayers
								collect
 (GetObjectName x))
				 )
				 (SETQ miscOptions '(ALL-EXISTING NO))
			]
			
			[SETQ 	menuItems
					(APPEND miscOptions
							(APPEND exPlayers
									(REMOVE 'RemotePlayer
											(REMOVE 'DemoPeddler (_ ($ Player) List! 'Subs)
			]
			
			[SETQ	players
					(for
 i from
 1 to
 pcount
					 while
 moreNeeded 
					 bind
 index 
					 first
 (SETQ index 1)
					 join

					 
					 (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
							)
					 )
					 
					 (printout \TopLevelTtyWindow "************ Player No. " index T)
					 
					 (COND
						((EQ res 'NO)
						 (SETQ moreNeeded NIL)
						 NIL)

						((EQ res 'ALL-EXISTING)
						 (printout \TopLevelTtyWindow "Existing players are: " exPlayers T)
									 
						 (for
 x in
 exPlayers
						  do
 (DREMOVE x menuItems))
						  
						 (DREMOVE '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
						 (printout \TopLevelTtyWindow "************ Player Type " T)
									 
						 (SETQ obj (GetObjectRec res))
						 (printout \TopLevelTtyWindow "************ Player Obj: " obj T)
									 
						 (SETQ index (ADD1 index))
						 (* ; "(printout \TopLevelTtyWindow "************ instance- " instance T)")
						 (printout \TopLevelTtyWindow "************ type?: " (type? res obj) T)
									 
						 (COND
							((type?
 res obj)
                             (_ (@ obj truck) Initialize)
                             (_ obj Initialize)
										  
                             (printout \TopLevelTtyWindow "Player selected: " T)
							 
										  
							 (* ; "only one type of player allowed!")
                             (DREMOVE res menuItems)
                             (DREMOVE 'ALL-EXISTING menuItems)
                             (LIST obj)
							)
                            (T
							 (SETQ player (_ obj New))
							 (printout \TopLevelTtyWindow "GetObjectName: " (GetObjectName player) T)
							 (printout \TopLevelTtyWindow "Player created "
														  (GetObjectName player)
													      T)
							 (LIST player)
							)
						 )
						)
					))
			]
		
		(printout \TopLevelTtyWindow "************ Players: " players T)
        (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.")

		 
		(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 'TEXTURE '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)) 'Up)
				(T '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) 'Right)
                      (EQ direction 'Up))
				 (AND (EQ (@ rs roadOrientation) 'Left)
                      (EQ direction '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)


	(* ; "Edited 14-Aug-2022 10:28 by lmm")

	(* 'sm%: 21-SEP-83 09:26")


	(* ; 
 "New method --- sends NewInstance to newly created instance")


	(CL:COMPILER-LET ((*SelectorOfMethodBeingCompiled* 'New)
                      (*SelfOfMethodBeingCompiled* 'self))
	
	(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 '((Suspend (SuspendGame
 T)
                                              "Suspend running Truckin")
                                       ("Kill Game" (KillGame
)
                                              "Kill Running Truckin Game"]
    [MenuGetOrCreate GameAwakeMenu '((Awake (WakeGame
)
                                            "Resumes suspended game")
                                     ("Kill Game" (KillGame
)
                                            "Kill Running Truckin Game"]
    (ADDMENU GameSuspendMenu GameControlWindow '(1 . 1) NIL])

(GameMasterMeta.New

  [LAMBDA (self gameBoardType)
                               (* ; "Edited 14-Aug-2022 10:31 by lmm")

                                                             (* ; "sm%: 14-JUN-83 11:32")

                                                             (* ; 

                                                          "Creates and initializes a new GameMaster.")

                                                             (* ; 

                                          "if gameBoardType is not specified, uses default gameBoard")

    (CL:COMPILER-LET ((*SelectorOfMethodBeingCompiled* 'New)
                      (*SelfOfMethodBeingCompiled* 'self))
           (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
                             '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)
                            (* ; "Edited 14-Aug-2022 10:34 by lmm")

                                                             (* ; "dgb%: "22-SEP-83 15-03")

                                                             (* ; 

                                                             "Received when new instance is created")

                                                             (* ; 

                                                             "Any specialization must return self")

    (CL:COMPILER-LET ((*SelectorOfMethodBeingCompiled* 'NewInstance)
                      (*SelfOfMethodBeingCompiled* '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 0.1 (FQUOTIENT (FIX (TIMES (RAND (DIFFERENCE (@@ Pr)
                                                 (TIMES (@@ Pr)
                                                        0.2))
                                          (PLUS (@@ Pr)
                                                (TIMES (@@ Pr)
                                                       0.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)
                                     0.3)))
                  (FIX (PLUS (@@ Qty)
                             (TIMES (@@ Qty)
                                    0.3])

(GetRuleSetMethods

  [LAMBDA (class)                                            (* ; "edited%: "20-Aug-87 15-23")

                                                             (* ; "returns list of RuleSet Instances 

                                                             which are methods in this class")

    (SORT (for
 x in
 (_ class ListAttribute 'Selectors) bind
 y
             when
 [NOT (EQ NotSetValue (SETQ y (GetItHere class x 'RuleSet '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!
                      'Bandit))
              [COND
                 ((_ newValue InstOf! '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 '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) 0.2)))
                  (ChangeValue
 self 'cashBox (IDIFFERENCE (@ cashBox) fine))
                  (WriteGameStatus
 "Cash lost: $" fine)
                  (for
 x in
 (@ cargo) when
 (_ x InstOf! '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))
	
		(COND
			(SHKFlg (printout \TopLevelTtyWindow "Initialize Truckin" T)
		)
		
		(* ; "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 'TRUCKINLOG)
		
		(SETQ truckinLogFlg T)
		(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)
		  
		(* ; " Constant offsets for game.")

		(* ; "These globals are used to store names of major Truckin Instances")

                                                    
		(SETQ	banditNames
				'(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))

				
		(SETQ	Communicator NIL)
		(SETQ	DecisionMaker NIL)
		(SETQ	PlayerInterface NIL)
		(SETQ GameBoard NIL)
		(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 '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 'HEIGHT))
							(FONTPROP dataFont '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 'INVERT 'REPLACE)
          (RETURN rIcon])

(KillGame

  [LAMBDA NIL                                                (* ; "sm%: 16-SEP-83 17:19")

    (DEL.PROCESS 'GameClock)
    (DEL.PROCESS 'WorldProcess)
    (DEL.PROCESS '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)                                      (* edited%: "20-Aug-87 15-23")

                                                             (* Makes a file for the playerClass by 

                                                             the same name)

    (PROG [playerName fileVar temp file (options '(NEW C ST]
          (COND
             ((GetClassRec playerClass)
              (SETQ playerClass (GetClassRec playerClass))
              (SETQ playerName (GetObjectName playerClass)))
             (T (printout \TopLevelTtyWindow 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 \TopLevelTtyWindow "File: " file " already exists." T)
              (COND
                 [(EQ 'YES (INTTY "Should I reuse existing file? " '(YES NO)
                                  "Y - reuse existing file. N - make it afresh"))
                  (SETQ options '(RC ST]
                 (T (SET fileVar (LIST (LIST 'CLASSES playerName)
                                       [CONS 'FNS (SORT (APPEND (_ playerClass ListAttribute
                                                                         'Functions)]
                                       (CONS 'INSTANCES (GetRuleSetMethods
 playerClass]
             (T (SET fileVar (LIST (LIST 'CLASSES playerName)
                                   [CONS 'FNS (SORT (APPEND (_ playerClass ListAttribute 'Functions)]
                                   (CONS 'INSTANCES (GetRuleSetMethods
 playerClass]
          (printout \TopLevelTtyWindow "Following is being saved on the file: " file T T)
          (printout \TopLevelTtyWindow (EVALV fileVar)
                 T T)
          (printout \TopLevelTtyWindow "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 _ 'RunPlayerRE]
          (WINDOWPROP w '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 '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                                                (* ; "sm%: 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 0.25))
        (DANDELION (SETQ truckIncr 3)
                   (SETQ HandicapRatio 0.4))
        (PROGN (SETQ truckIncr 1)
               (SETQ HandicapRatio 1])

(SetUpGame

	(* dgb%: " 9-JUN-83 13:26")

	
	[LAMBDA (numPlayers gameType)                              
		
		(_ ($! (OR gameType '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 'title "GameObject lattice")
          (_ x Show '(GameObject))
          (SETQ x (_ ($ ClassBrowser)
                     New))
          (PutValue x 'title "Commodity lattice")
          (_ x Show '(Commodity))
          (SETQ x (_ ($ ClassBrowser)
                     New))
          (PutValue x 'title "Commodity and transportability lattice")
          (_ x Show '(Commodity CommodityTransportability))
          (SETQ x (_ ($ ClassBrowser)
                     New))
          (PutValue x 'title "Hazard lattice")
          (_ x Show '(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)
                                                            0.3)))
                                         (FIX (PLUS (@@ Qty)
                                                    (TIMES (@@ Qty)
                                                           0.3]
          [SETQ pr (MAX 0.1 (PROGN (FQUOTIENT (FIX (TIMES (RAND (DIFFERENCE (@@ Pr)
                                                                       (TIMES (@@ Pr)
                                                                              0.2))
                                                                (PLUS (@@ Pr)
                                                                      (TIMES (@@ Pr)
                                                                             0.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 'GameClock)
         (SUSPEND.PROCESS 'GameClock))
    (AND (FIND.PROCESS 'InterimWorldProcess)
         (SUSPEND.PROCESS 'InterimWorldProcess))
    (AND (FIND.PROCESS 'WorldProcess)
         (SUSPEND.PROCESS '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 '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!
                '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!
                '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 0.25 (DIFFERENCE

                                                             (FQUOTIENT (@ truck weight)

                                                             (@@ truck MaxWeight)) 0.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 'CTRL)
              (SETQ begT (CLOCK))
              (while
 (KEYDOWNP 'CTRL) do
 (COND
                                            ((KEYDOWNP 'LSHIFT)
                                             (AND where (printout PPDefault where T))
                                             (EVAL.IN.TTY.PROCESS '(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 'WorldProcess)
         (WAKE.PROCESS 'WorldProcess))
    (AND (FIND.PROCESS 'InterimWorldProcess)
         (WAKE.PROCESS 'InterimWorldProcess))
    (AND (FIND.PROCESS 'GameClock)
         (WAKE.PROCESS '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 'ON gameStatusWindow]
          [COND
				((AND (NULL truckinLogHandle) truckinLogFlg)
				 (SETQ truckinLogHandle (OPENFILE truckinLogFile '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)))"
			   )
                                                     
  

(printout \TopLevelTtyWindow "At Defining GLOBALVARS " T)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

	(GLOBALVARS PlayerProcRestFlg GameProcRestFlg)
)

(RPAQQ GameCommandX
 585)

(RPAQQ GameCommandY
 651)

(RPAQQ GameParamRegion
 (622 650 273 140))

(RPAQQ HandicapRatio
 0.4)

(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)))

(printout \TopLevelTtyWindow "At Defining BatchMethod Definitions" T)

(\BatchMethodDefs)
(METH CommodityMeta  New (pr qty owner)

      "create a new instance of a commodity with qty, pr, and owner specified" (category (Class)))


(METH CommodityMeta  Subs! NIL

      NIL (category (CommodityMeta)))


(METH GameAbstractClass  New NIL

      NIL (category (Class)))


(METH GameBoard  NewInstance (simulator)

      "Received when new instance is created" (category (Object)))


(METH GameClass  AddCV! (name value copyValue)

      "Adds CV to self, its subs, and CopyCV list" (category (GameClass)))


(METH GameClass  DeleteCV! (name)

      "Deletes CV from self, its subs, and CopyCV list" (category (GameClass)))


(METH GameClass  RenameCV! (oldName newName)

      "Renames a CV in self and all subclasses. Changes CopyCV list also." (category (GameClass)))


(METH GameClass  Subs! NIL

      NIL (category (GameClass)))


(METH GameMetaClass  New (name supers)

      "New method for creating new Game classes" (category (Class)))


(METH GameObject  AddGauges (ivs default titleForm)

      
    "Adds a collection of gauges to the ivs of some game object under interactive control of a user."
      (category (GameObject)))


(METH GameObject  Initialize NIL

      "Initializes"
	  (category (GameObject))
)

(METH GameParameters  LoadPara NIL

      "Loads the defined parameters with existing values"
	  (category (GameParameters))
)

(METH GameParameters  SetUp NIL

      
	"Displays the inspector containing parameters, and a menu to signal
	when to accept the parameters"
	(category (GameParameters))
)

(METH GameParameters  StorePara NIL

      "Store values where they came from"
	  (category (GameParameters))
)

(Method ((CommodityMeta New)
 self pr qty owner)
	(* ; "edited: 20-Aug-87 15-23")

    (* ; "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 'New ($ Class)))
         (COND
            ((NULL qty)
             (COND
                (pr (_ new SetName pr)))
             (RETURN new))
            [(OR (EQUAL owner '*SPECIAL*)
                 (_ owner InstOf! 'Producer)]
            (T
				(printout \TopLevelTtyWindow "Attempt to illegally create an instance of commodity" T)
				(RETURN NIL)
			)
		)
         (_@ new qty qty)
         (_@ new pr pr)
         (COND
            ((EQUAL owner '*SPECIAL*))
            (T (_@ new owner owner)))
         (RETURN new)))

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

   NIL)

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

(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))

(Method ((GameClass AddCV!)
 self name value copyValue)

	(* ; "edited: 20-Aug-87 15-23")


	(* ; "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 'CV name value)
         (COND
            ([NOT (FMEMB 'CopyCV (_ self ListAttribute 'CVs)]
             (_ self Add 'CV 'CopyCV NIL)))
         [PutClassValue self 'CopyCV (SettifyCopyCV
 (ATTACH (COND
                                                               ((NULL copyValue)
                                                                name)
                                                               (T (LIST name copyValue)))
                                                           (GetClassValue self 'CopyCV]
         (for
 x in
 (_ self ListAttribute 'Subs) do
 (_ (GetObjectRec x)
                                                      AddCV! name (COND
                                                                     (copyValue copyValue)
                                                                     (T NotSetValue))
                                                      copyValue))
         (RETURN name)))

(Method ((GameClass DeleteCV!)
 self name)

	(* ; "edited: 20-Aug-87 15-23")

	
   "Deletes CV from self, its subs, and CopyCV list"
   
   (PROG NIL
         (_ self Delete 'CV name)
         [COND
            ((FMEMB 'CopyCV (_ self ListAttribute 'CVs))
             (PutClassValue self 'CopyCV (ELIMINATE
 name (GetClassValue self 'CopyCV]
         (for
 x in
 (_ self ListAttribute 'Subs) do
 (_ (GetObjectRec x)
                                                      DeleteCV! name))
         (RETURN name)))

(Method ((GameClass RenameCV!)
 self oldName newName)

	(* ; "edited: 20-Aug-87 15:23")

	
	"Renames a CV in self and all subclasses. Changes CopyCV list also."
	
	(RenameVariable (GetObjectName self) oldName newName T)
	
	[PutClassValue self 'CopyCV (SUBST newName oldName (GetClassValue self 'CopyCV]
	
	(for
 x in
 (_ self ListAttribute 'Subs)
	 eachtime
(SETQ y (GetObjectRec x))
	 do
 (_ y RenameCV! oldName newName))
	 
	newName
)

(Method ((GameClass Subs!)
 self)                             (* ; "edited: 20-Aug-87 15-23")

                                                             (* ; "sm:  7-JAN-83 11:55")

   [PROG [(subs (_ self ListAttribute 'Subs)]
         (RETURN (APPEND subs (for
 x in
 subs join
 (_ (GetObjectRec x)
                                                     Subs!)])

(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 'CopyCV) do
 (COND
                                                      ((ATOM x)
                                                       (_ newClass Add 'CV x NotSetValue))
                                                      (T (_ newClass Add '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 'CopyCV)
                                            CopyList))
                      (for
 z in
 (GetClassValue y 'CopyCV)
                         do
 (COND
                               ((ATOM z)
                                (_ newClass Add 'CV z NotSetValue))
                               (T (_ newClass Add 'CV (CAR z)
                                           (COND
                                              ((NULL (CDR z))
                                               (GetClassValueOnly y z))
                                              (T (CADR z))))]
         (_ newClass Add 'CV 'CopyCV (SettifyCopyCV CopyList))
         (RETURN newClass)))

(Method ((GameObject AddGauges)
 self ivs default titleForm)

	(* ; "edited: 17-Sep-87 14:43")

	(* ; 
"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!
                                  'Subs))
         (SETQ gaugeClassNames (for
 gcn in
 gaugeClassNames
                                  unless
 (EQ (ClassName (Class (GetObjectRec gcn)))
                                             'AbstractClass) collect
 gcn))

         (* ; "Loop thru the ivs")


         (for
 iv in
 ivs when
 [OR default (NOT (EQ 'NO (SETQ res (INMENU (CONCAT "Add gauge to " iv 
                                                                               "? ")
                                                                       '(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 'DEFAULT)
                                                 default)
                                             (GetObjectRec (GetValue gaugeObj iv 'DefaultGauge]
                                        (GetValue gaugeObj iv 'DefaultGauge))
                                       (T (INMENU "Type of Gauge: " gaugeClassNames NIL 'NoShift]
               (SETQ gauge (_ (GetClassRec gaugeClassName)
                              New))
               (SETQ limit (GetValue gaugeObj iv '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))) 

         (* * This is way wrong, but it forces any default value in gaugeObj's iv to be 

         copied down now; this makes the clock gauge work)


               (PutValueOnly gaugeObj iv (GetValueOnly gaugeObj iv))
               (_ gauge Attach gaugeObj iv NIL NIL NIL NIL (COND
                                                              ([NotSetValue (SETQ gaugePos
                                                                             (GetValue gaugeObj iv
                                                                                    'GaugePos]
                                                               NIL)
                                                              (T gaugePos))) 
                                                             (* disable for now. (_ gauge Move))
)
         (RETURN ivs)))

(Method ((GameObject Initialize)
 self)                       (* ; "edited: 25-Aug-87 10:52")

                                                             (* ; "Initializes")

   "Per smL suggestion - smashing #,NotSetValue to initialize (used to be (GetInitialValue self x)) (the class will fill it in later...)"
   (for
 x in
 (@@ InitializeIVs) do
 (PutValue self x #,NotSetValue)))

(Method ((GameParameters LoadPara)
 self)                     (* ; "edited: 20-Aug-87 15-23")

   "Loads the defined parameters with existing values"
   (for
 x in
 (_ self ListAttribute 'IVs) bind
 exp val when
 (SETQ exp (GetValue self x 'exp))
      do
 [SETQ val (COND
                      ((EQ exp NotSetValue)
                       NotSetValue)
                      ((ATOM exp)
                       (EVALV exp))
                      (T (EVAL (CONS '@ exp]
         (PutValue self x val)                               (* Save value in prop oldVal)

         (PutValue self x val 'oldVal)))

(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 _ '((DONE (PROGN (CLOSEW GameParamW)
                                                                    (CLOSEW GameCommandW)
                                                                    (SETQ GameParaSet T))
                                                             
                                             "Clicking DONE will cause Game Parameters to be changed"
                                                             ]
          GameCommandX GameCommandY))

(Method ((GameParameters StorePara)
 self)                    (* ; "edited: 20-Aug-87 15-23")

   "Store values where they came from"
   [for
 x in
 (_ self ListAttribute 'IVs) bind
 exp val oldVal changeExp
      when
 (SETQ exp (GetValue self x 'exp))
      do
 (SETQ val (GetValue self x))
         (SETQ oldVal (GetValue self x 'oldVal))
         [COND
            ((EQ exp NotSetValue))
            ((ATOM exp)
             (SET exp val))
            (T (EVAL (CONS '_@
                           (APPEND exp (CONS val]
         (COND
            ((AND (NOT (EQUAL val oldVal))
                  (NOT (EQ (SETQ changeExp (GetValue self x 'changeExp))
                           NotSetValue)))
             (ERRORSET changeExp T]
)

(printout \TopLevelTtyWindow "Loaded BatchMethod Definitions" T)

(\UnbatchMethodDefs)

(PUTPROPS TRUCKIN COPYRIGHT ("Xerox Corporation" 1985 1987 2022))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (11527 78836 (AuxBuyMade 11537 . 12231) (AuxMoveMade 12233 . 12836) (AuxSellMade 12838
 . 13503) (BanditGotYou? 13505 . 14045) (BrokenRules 14047 . 17154) (ChangeValue 17156 . 18577) (
CheckVictim 18579 . 20333) (CommodityClassMeta.New 20335 . 20735) (CreateNewPlayer 20737 . 21828) (
CreatePlayers 21830 . 26024) (DrawRoadMarks 26026 . 27398) (Drive 27400 . 31196) (DriveLeft 31198 . 
33366) (DriveRight 33368 . 35531) (ELIMINATE 35533 . 36100) (FindFirstNIL 36102 . 36321) (FindLocIndex
 36323 . 36695) (FindRandomNIL 36697 . 37624) (GameClass.New 37626 . 38374) (GameControlMenu 38376 . 
39279) (GameMasterMeta.New 39281 . 40863) (GameObject.NewInstance 40865 . 41630) (GenConsumerPr 41632
 . 42374) (GenConsumerQty 42376 . 42934) (GetRuleSetMethods 42936 . 43433) (InCopyCV? 43435 . 44237) (
InformBandit&WS 44239 . 47584) (InitializeTruckin 47586 . 53080) (IntervalToEvent 53082 . 54249) (
InvertIcon 54251 . 54639) (KillGame 54641 . 54884) (MailOut 54886 . 55206) (MakeDriveBitMaps 55208 . 
55846) (MakePlayerFile 55848 . 58084) (NormalizeValue 58086 . 58494) (PlayerInterruptMenu 58496 . 
58865) (RunPlayerRE 58867 . 59693) (RunPlayerRE1 59695 . 60328) (RandomRoomAvailable 60330 . 61285) (
ReceiveIn 61287 . 61806) (ReflectIcon 61808 . 62366) (STRINGNUM 62368 . 62702) (SendOut 62704 . 62851)
 (SetMachineDepPara 62853 . 63408) (SetUpGame 63410 . 63620) (SettifyCopyCV 63622 . 64059) (
SetupGameBrowsers 64061 . 65057) (SmashCreateCommodity 65059 . 66547) (SmashRandomPerishable 66549 . 
67101) (SubstituteStop 67103 . 67731) (SuspendGame 67733 . 68851) (SwitchMenu 68853 . 69020) (
TalkinBuyMade 69022 . 69321) (TalkinMoveMade 69323 . 69546) (TalkinSellMade 69548 . 69843) (
TruckinError 69845 . 69973) (TruckinRE 69975 . 71004) (UpdateConsumerDisplay 71006 . 71515) (
UpdatePrDisplay 71517 . 72149) (UpdateProducerSoldout 72151 . 72693) (UpdateQtyDisplay 72695 . 73349) 
(WSRuleViolated? 73351 . 74469) (WaitIfControlKey 74471 . 75625) (WakeGame 75627 . 76248) (
WriteGameStatus 76250 . 78834)))))

STOP