(FILECREATED "14-Jan-85 17:16:33" {INDIGO}<LOOPS>TRUCKIN>MULTI>TRUCKIN.;55 77626
changes to: (METHODS CommodityMeta.New CommodityMeta.Subs! GameBoard.NewInstance
GameClass.AddCV! GameClass.DeleteCV! GameClass.RenameCV! GameClass.Subs!
GameMetaClass.New GameObject.AddGauges GameObject.Initialize
GameParameters.LoadPara GameParameters.SetUp GameParameters.StorePara)
(FNS SetMachineDepPara CommodityMeta.New CommodityMeta.Subs! GameBoard.NewInstance
GameClass.AddCV! GameClass.DeleteCV! GameClass.RenameCV! GameClass.Subs!
GameMetaClass.New GameObject.AddGauges GameObject.Initialize
GameParameters.LoadPara GameParameters.SetUp GameParameters.StorePara)
previous date: " 9-Mar-84 13:23:14" {INDIGO}<LOOPS>TRUCKIN>MULTI>TRUCKIN.;54)
(* 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 (method AbstractClass.New)]
[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))
(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 (11897 63034 (AuxBuyMade 11907 . 12594) (AuxMoveMade 12596 . 13191) (AuxSellMade 13193
. 13848) (BanditGotYou? 13850 . 14231) (BrokenRules 14233 . 16442) (ChangeValue 16444 . 17136) (
CheckVictim 17138 . 18419) (CommodityClassMeta.New 18421 . 18740) (CreateNewPlayer 18742 . 19591) (
CreatePlayers 19593 . 22149) (DrawRoadMarks 22151 . 23263) (Drive 23265 . 25860) (DriveLeft 25862 .
27699) (DriveRight 27701 . 29499) (ELIMINATE 29501 . 30010) (FindFirstNIL 30012 . 30228) (FindLocIndex
30230 . 30535) (FindRandomNIL 30537 . 31179) (GameClass.New 31181 . 31601) (GameControlMenu 31603 .
32321) (GameMasterMeta.New 32323 . 33410) (GameObject.NewInstance 33412 . 33797) (GenConsumerPr 33799
. 34250) (GenConsumerQty 34252 . 34625) (GetRuleSetMethods 34627 . 35089) (InCopyCV? 35091 . 35575) (
InformBandit&WS 35577 . 37870) (InitializeTruckin 37872 . 41852) (IntervalToEvent 41854 . 42705) (
InvertIcon 42707 . 43116) (KillGame 43118 . 43380) (MailOut 43382 . 43615) (MakeDriveBitMaps 43617 .
44045) (MakePlayerFile 44047 . 45908) (NormalizeValue 45910 . 46204) (PlayerInterruptMenu 46206 .
46554) (RunPlayerRE 46556 . 47303) (RunPlayerRE1 47305 . 47839) (RandomRoomAvailable 47841 . 48699) (
ReceiveIn 48701 . 49099) (ReflectIcon 49101 . 49612) (STRINGNUM 49614 . 49878) (SendOut 49880 . 50025)
(SetMachineDepPara 50027 . 50573) (SetUpGame 50575 . 50791) (SettifyCopyCV 50793 . 51173) (
SetupGameBrowsers 51175 . 52145) (SmashCreateCommodity 52147 . 53061) (SmashRandomPerishable 53063 .
53456) (SubstituteStop 53458 . 53959) (SuspendGame 53961 . 54907) (SwitchMenu 54909 . 55075) (
TalkinBuyMade 55077 . 55375) (TalkinMoveMade 55377 . 55599) (TalkinSellMade 55601 . 55895) (
TruckinError 55897 . 56024) (TruckinRE 56026 . 56751) (UpdateConsumerDisplay 56753 . 57146) (
UpdatePrDisplay 57148 . 57743) (UpdateProducerSoldout 57745 . 58239) (UpdateQtyDisplay 58241 . 58844)
(WSRuleViolated? 58846 . 59586) (WaitIfControlKey 59588 . 60387) (WakeGame 60389 . 60964) (
WriteGameStatus 60966 . 63032)) (65130 77548 (CommodityMeta.New 65140 . 66507) (CommodityMeta.Subs!
66509 . 66659) (GameBoard.NewInstance 66661 . 67055) (GameClass.AddCV! 67057 . 68220) (
GameClass.DeleteCV! 68222 . 68872) (GameClass.RenameCV! 68874 . 69463) (GameClass.Subs! 69465 . 69860)
(GameMetaClass.New 69862 . 71805) (GameObject.AddGauges 71807 . 74725) (GameObject.Initialize 74727
. 75051) (GameParameters.LoadPara 75053 . 75793) (GameParameters.SetUp 75795 . 76658) (
GameParameters.StorePara 76660 . 77546)))))
STOP