(FILECREATED "27-JUN-83 00:30:00" {INDIGO}<LOOPS>TRUCKIN>TRUCKIN.;21 144206
changes to: (FNS CreatePlayers GameObject.AddGauges GameParameters.SetUp InitializeTruckin
TimeTruckin.RedoGameParameters TruckinGame.RedoGameParameters)
(VARS TRUCKINCOMS)
previous date: "16-JUN-83 19:53:58" {INDIGO}<LOOPS>TRUCKIN>TRUCKIN.;19)
(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 Group -- Daniel Bobrow, Sanjay Mittal,
and Mark Stefik.)
(CONSTANTS * TRUCKINCONSTANTS)
(CLASSES * TRUCKINCLASSES)
(GLOBALVARS * TRUCKINVARS)
(FNS * TRUCKINFNS)
(VARS GameCommandX GameCommandY GameParamRegion aliceCount banditCount
banditMoveFrequency banditMoveRange debugMode debugTimeTrace
defaultGaugesFlg)
[P (INTERRUPTCHAR 6 (LIST (FUNCTION TruckinRE]
(* A fix up for the inspector to allow it to place a window exactly where is is
wanted. A patch until this is put in the system. Used in GameParameter.Setup)
(VARS INSPECTLOC)
(FNS MYINSPECT)
(ADVISE GETBOXREGION-IN-INSPECTW.CREATE)))
(* 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 Group -- 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 (BWGameBoard ColorGameBoard CommodityClassMeta CommodityMeta GameAbstractClass
GameBoard GameClass GameMaster GameMasterMeta GameMetaClass
GameObject GameParameters MTParameters MetaBrowser MoveTruckin
TTParameters TimeTruckin TruckinGame TruckinParameters))
(DEFCLASSES BWGameBoard ColorGameBoard CommodityClassMeta CommodityMeta GameAbstractClass GameBoard
GameClass GameMaster GameMasterMeta GameMetaClass GameObject GameParameters MTParameters
MetaBrowser MoveTruckin TTParameters TimeTruckin TruckinGame TruckinParameters)
[DEFCLASS BWGameBoard
(MetaClass GameClass Edited: (* sm: "11-MAY-83 17:32"))
(Supers GameBoard)
(ClassVariables)
(InstanceVariables)
(Methods)]
[DEFCLASS ColorGameBoard
(MetaClass GameClass Edited: (* sm: "11-MAY-83 17:31"))
(Supers GameBoard)
(ClassVariables (colorP T doc (* This indicates that the display will be on the color
screen))
(numColumns 7 doc (* number of RoadStops arranged horizontally on the game
board.))
(numRows 4 doc (* number of RoadStops arranged vertically on the game
board.))
(CopyCV NIL))
(InstanceVariables)
(Methods (CreateGameBoard ColorGameBoard.CreateGameBoard args (region title)
doc
(* * Creates a new Window for the gameBoard.)
)
(MakeDriveBitMaps ColorGameBoard.MakeDriveBitMaps args NIL doc
(* Creates Bit maps for Trucks)))]
[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))
(InstanceVariables)
(Methods)]
[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))
(InstanceVariables)
(Methods (New CommodityMeta.New args (pr qty owner)
doc (* create a new instance of a commodity with qty, pr,
and owner specified)
)
(Subs! CommodityMeta.Subs! args NIL))]
[DEFCLASS GameAbstractClass
(MetaClass GameMetaClass Edited: (* sm: "20-JAN-83 17:29"))
(Supers GameClass)
(ClassVariables)
(InstanceVariables)
(Methods (New AbstractClass.New args NIL))]
[DEFCLASS GameBoard
(MetaClass GameClass Edited: (* sm: "11-MAY-83 17:32"))
(Supers GameObject)
(ClassVariables (colorP NIL doc (* This indicates that this is not a colordisplay)
)
(numColumns 11 doc (* number of RoadStops arranged horizontally on the game
board.))
(numRows 6 doc (* number of RoadStops arranged vertically on the game
board.))
(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.)
)
(roadStops NIL doc (* List of RoadStops on gameBoard.))
(gameMaster NIL doc (* pointer to game master which is playing this board)
))
(Methods (AssignRoadStops GameBoard.AssignRoadStops args NIL doc
(* * Assign RoadStops to the current GameBoard)
)
(AttachToGame GameBoard.AttachToGame args (game)
doc (* attaches self to game)
)
(CreateGameBoard GameBoard.CreateGameBoard args (region title)
doc
(* * Creates a new Window for the gameBoard.)
)
(DisplayGameBoard GameBoard.DisplayGameBoard args NIL doc
(* * Displays the gameBoard. ReAllocates gameBoard window if needed.)
)
(DrawRoadMarks DrawRoadMarks args NIL doc
(* * Draw the dotted Lines in the road above the RoadStops.)
)
(NewBoard GameBoard.NewBoard args NIL doc (* Creates and displays a new game board)
)
(PlaceRoadStops GameBoard.PlaceRoadStops args NIL doc
(* mjs: "17-JAN-83 10:34"))
(RemovePlayer GameBoard.RemovePlayer args (player)
doc (* Sent to game board so it can remove player from
board)
)
(MakeDriveBitMaps GameBoard.MakeDriveBitMaps args NIL doc
(* Creates Bit maps for Trucks)))]
[DEFCLASS GameClass
(MetaClass GameMetaClass Edited: (* sm: "20-JAN-83 14:29"))
(Supers Class)
(ClassVariables (ComsVar TRUCKINCLASSES)
(CopyCV NIL))
(InstanceVariables)
(Methods (AddCV! GameClass.AddCV! args (name value copyValue)
doc
(* * Adds CV to self, its subs, and CopyCV list)
)
(DeleteCV! GameClass.DeleteCV! args (name)
doc
(* * Deletes CV from self, its subs, and CopyCV list)
)
(RenameCV! GameClass.RenameCV! args (oldName newName)
doc
(* * Renames a CV in self and all subclasses. Changes CopyCV list also.)
)
(Subs! GameClass.Subs! args ? doc (* sm: " 7-JAN-83 11:55")))]
[DEFCLASS GameMaster
(MetaClass GameMasterMeta doc
(* * Controller for the TRUCKIN game.)
Edited: (* sm: "14-JUN-83 10:05")
)
(Supers GameObject)
(ClassVariables)
(InstanceVariables (gameBoard BWGameBoard doc (* pointer to game board))
(gameParameters GameParameters doc (* pointer to gameParameters object)))
(Methods (AttachBoard GameMaster.AttachBoard args (gameBoard)
doc (* Attaches gameBoard to game)
)
(UnattachBoard GameMaster.UnattachBoard args NIL doc
(* Removes game board))
(ChangeGameParameters GameMaster.ChangeGameParameters args NIL doc
(* Changes gameParameters via inspector))
)]
[DEFCLASS GameMasterMeta
(MetaClass MetaClass doc (* MetaClass for making a new Gamemaster.)
Edited: (* mjs: "13-JAN-83 09:49")
)
(Supers Class)
(ClassVariables)
(InstanceVariables)
(Methods (New GameMasterMeta.New args (gameBoardType)
doc (* Creates and initializes a new GameMaster.)
))]
[DEFCLASS GameMetaClass
(MetaClass MetaClass Edited: (* sm: "20-JAN-83 14:29"))
(Supers MetaClass)
(ClassVariables (ComsVar TRUCKINCLASSES))
(InstanceVariables)
(Methods (New GameMetaClass.New doc
(* * New method for creating new Game classes)
args
(name supers)))]
[DEFCLASS GameObject
(MetaClass GameClass Edited: (* sm: "19-JAN-83 11:15"))
(Supers Object)
(ClassVariables (UnnamedInstanceCount 0)
(Icon ?)
(CopyCV (Icon)))
(InstanceVariables)
(Methods (AddGauges GameObject.AddGauges args (ivs default titleForm)
doc (* Adds a collection of gauges to the ivs of some game
object under interactive control of a user.)
))]
[DEFCLASS GameParameters
(MetaClass GameClass Edited: (* sm: "13-JUN-83 15:39"))
(Supers GameObject)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables)
(Methods (LoadPara GameParameters.LoadPara args NIL doc
(* Loads the defined parameters with existing values)
)
(SetUp GameParameters.SetUp args NIL doc (* Displays the inspector containing parameters, and a
menu to signal when to accept the parameters)
)
(StorePara GameParameters.StorePara args NIL doc
(* Store values where they came from)))]
[DEFCLASS MTParameters
(MetaClass GameClass Edited: (* sm: "14-JUN-83 10:04"))
(Supers TruckinParameters)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables (numMovesRemaining 200 doc (* number of moves remaining in game)
goodVal NUMBERP exp (gameMaster numMovesRemaining)))
(Methods)]
[DEFCLASS MetaBrowser
(MetaClass GameClass Edited: (* sm: " 7-JAN-83 17:28"))
(Supers ClassBrowser)
(ClassVariables)
(InstanceVariables (title "MetaClass Lattice"))
(Methods (GetSubs MetaBrowser.GetSubs args (elt)))]
[DEFCLASS MoveTruckin
(MetaClass GameMasterMeta Edited: (* dgb: "23-JUN-83 18:45"))
(Supers TruckinGame)
(ClassVariables)
(InstanceVariables (numMovesRemaining 200 DefaultGauge DigiMeter GaugeLimit (0 200)
GaugePos
(852 . 465)
SetByUser NIL doc
(* number of moves remaining in the game.
SetByUser is used to flag that value is not to be
reinitialized))
(banditFreq 5 doc (* how often bandits move))
(replenishFreq 40 doc (* how often gas is replenished))
(aliceStay 3 doc (* how many moves can stay at Alices))
(gameParameters MTParameters doc (* pointer to gameParameters object)))
(Methods (BeginGame MoveTruckin.BeginGame)
(InitializeGameParameters MoveTruckin.InitializeGameParameters doc
(* Initializes critical variables for new game to run)
args NIL)
(MoveBandits MoveTruckin.MoveBandits args NIL)
(RunGame MoveTruckin.RunGame args (players)
doc (* This is the main loop that runs the game)
)
(SetUpGauges MoveTruckin.SetUpGauges args NIL doc
(* Set up gauges)))]
[DEFCLASS TTParameters
(MetaClass GameClass Edited: (* sm: "14-JUN-83 15:19"))
(Supers TruckinParameters)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables (timeRemaining 3000 goodVal NUMBERP exp (gameMaster timeRemaining)
changeExp
(PutValue gameMaster (QUOTE timeRemaining)
T
(QUOTE SetByUser))
oldVal 3000 doc "Time remaining in game")
(timeTrace NIL goodVal (T NIL)
exp timeTrace doc
"If T then prints time taken
by each player after each move"))
(Methods)]
[DEFCLASS TimeTruckin
(MetaClass GameMasterMeta Edited: (* dgb: "23-JUN-83 18:43"))
(Supers TruckinGame)
(ClassVariables (MinMoveTime 1 doc (* min time everyone is charged))
(MaxMoveTime 25 doc (* max time per move, after which player yanked from
game))
(AliceBonus 2 doc (* cashBox multiplied by this for reaching Alice)
))
(InstanceVariables (timeRemaining 1000 DefaultGauge SSDigiMeter GaugeLimit (0 1000)
GaugePos
(852 . 465)
SetByUser NIL doc (* time remaining in game. SetByUser is used to indicate
that value is not to be re-initialized))
(lastPlayer NIL doc (* player who moved last time))
(replenishFreq 200 LastTime 3000 ReplenishFactor 30 doc
(* how freq are gas stations filled))
(banditFreq 50 LastTime 3000 BanditFactor 10 doc
(* freq of bandits move))
(avgNumMoves 200 Factor 2 doc (* average num of moves/player.
Used to calculate time paras))
(aliceStay 3 MaxTime 30 AliceFactor 8 doc
(* aliceStay -
max conseq turns at Alice. MaxTime -
Max time allowed at Alice during a conseq stay)
)
(gameParameters TTParameters doc (* pointer to gameParameters object)))
(Methods (BeginGame TimeTruckin.BeginGame args (players moves time))
(ChargeTime TimeTruckin.ChargeTime args (player clockTime)
doc (* Calculates the actual time to be charged to player)
)
(CheckAlice TimeTruckin.CheckAlice args (player))
(GiveAliceBonus TimeTruckin.GiveAliceBonus args (atAlice)
doc (* Give bonus for reaching Alices)
)
(InitializeGameParameters TimeTruckin.InitializeGameParameters doc
(* Initializes critical variables for new game to run)
args NIL)
(MoveBandits TimeTruckin.MoveBandits args NIL)
(RedoGameParameters TimeTruckin.RedoGameParameters doc
(* Change game parameters based on players in the game)
args NIL)
(ReplenishQty TimeTruckin.ReplenishQty doc (* Checks if time to replenish)
args NIL)
(RunGame TimeTruckin.RunGame args (players)
doc (* This is the main loop that runs the game)
)
(SetUpGauges TimeTruckin.SetUpGauges args NIL doc
(* Sets up gauges))
(UpdateAlice TimeTruckin.UpdateAlice args (player time)
doc (* Adds time used if parked at Alice)
)
(WhoWon TimeTruckin.WhoWon))]
[DEFCLASS TruckinGame
(MetaClass GameMasterMeta Edited: (* dgb: "23-JUN-83 18:44"))
(Supers GameMaster)
(ClassVariables)
(InstanceVariables (alices NIL doc (* actual AlicesRestaurant's on board))
(bandits NIL nextTime NIL doc (* list of bandits currently on board.
nextTime is a list of locs to be used for placing
bandits in next turn))
(currentPlayer NIL DefaultGauge LCD GaugePos (879 . 430)
doc (* current player who has control)
)
(unionHall NIL doc (* actual instance of UnionHall on board)
)
(unchargedTime 0 doc (* time not charged because used by Execs or Breaks)
)
(roadStops NIL doc (* same roadStops as in (gameBoard roadStops))
)
(players NIL doc (* List of the players for this simulation.)
)
(loseTurn NIL doc (* List of players that lose the next turn.)
)
(lastMoved NIL doc (* last player who issued Move command))
(gameParameters TruckinParameters doc
(* pointer to gameParameters object)))
(Methods (BeginGame TruckinGame.BeginGame args (players moves)
doc
(* * Starts a new game. Players is either the number of players or a list of Player objects.
If players is NIL, but the gameMaster has previous players, it uses those.)
)
(BreakCargo TruckinGame.BreakCargo args (player commodIndex)
doc (* Sent by a commodity when it breaks)
)
(Buy TruckinGame.Buy args (qty)
doc (* message sent by currentPlayer to BUY qty at its
current location)
)
(BuyMade TruckinGame.BuyMade args (player roadPosition reqQty qty reason penalty
fragility lifetime)
doc (* Indicates a definite BUY to be made, or reasons for
not carrying out a BuyRequest)
)
(BuyRequest TruckinGame.BuyRequest args (player roadPosition qty)
doc (* sm: " 6-JUN-83 10:34")
)
(CheckAlice TruckinGame.CheckAlice args NIL doc
(* check AlicesRestaurant's before each turn)
)
(ContinueGame TruckinGame.ContinueGame args (noRedrawFlg)
doc (* to resume a game in the middle.)
)
(ForcedMove TruckinGame.ForcedMove args (player curLoc maxMilePost reason)
doc (* determines the loc to move currentPlayer as a forced
move close to maxMilePost)
)
(GasFill TruckinGame.GasFill args (prevStop gsStop qty pr)
doc (* Instructions for moving a gas truck and filling
GasStation)
)
(GiveAliceBonus TruckinGame.GiveAliceBonus args (atAlice)
doc (* Dummy method)
)
(InitializeGameParameters TruckinGame.InitializeGameParameters doc
(* sm: "12-MAY-83 13:20")
args ?)
(Move TruckinGame.Move args (newLoc)
doc (* sent by currentPlayer to move to newLoc)
)
(MoveBandits TruckinGame.MoveBandits args NIL doc
(* randomly moves bandits around on the board before
each turn))
(MoveCheckingHazards TruckinGame.MoveCheckingHazards args (player curLoc newLoc reason)
doc (* moves truck checking for hazards along the way.
Called by GameMaster.MoveTruck)
)
(MoveMade TruckinGame.MoveMade args (player from to reason penaltyAmt missTurn)
doc (* Actually makes the move after all checks are done)
)
(MoveRequest TruckinGame.MoveRequest args (player from to reason)
doc (* sent to DecisionMaker for deciding if move can be
made)
)
(MoveTruck TruckinGame.MoveTruck args (player curLoc newLoc reason)
doc (* actually moves the currentPlayer's truck)
)
(RedoGameParameters TruckinGame.RedoGameParameters args NIL doc
(* Dummy. Needed if some game parameters need to be
changed after the players are known))
(RemovePlayer TruckinGame.RemovePlayer args (player reason)
doc (* removes player from game)
)
(ReplenishQty TruckinGame.ReplenishQty args NIL doc
(* replenish GasStations qty))
(Sell TruckinGame.Sell args (commodity qty)
doc (* message sent by currentPlayer to sell qty of
commodity at the player's current location.)
)
(SellMade TruckinGame.SellMade args (player roadPosition reqQty qty cargoPosition reason
penalty)
doc (* Performs an actual Sell, once all checking is done)
)
(SellRequest TruckinGame.SellRequest args (player roadPosition commodityIndex qty)
doc (* sm: "25-MAY-83 15:40")
)
(SetUpGauges TruckinGame.SetUpGauges args ? doc
(* Sets up gauges))
(SpoilCargo TruckinGame.SpoilCargo args (player commodIndex)
doc (* Sent by commodity when it spoils)
)
(WhoWon TruckinGame.WhoWon args NIL doc (* summarizes the game results)))]
[DEFCLASS TruckinParameters
(MetaClass GameClass Edited: (* sm: "14-JUN-83 15:16")
doc (* Used for Setting/resetting Truckin parameters)
)
(Supers GameParameters)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables (banditCount 2 goodVal NUMBERP exp banditCount doc "Number of Bandits in game")
(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"))
(Methods)]
(RPAQQ TRUCKINVARS (GameCommandW GameParamW aliceCount banditCount banditMoveFrequency
banditMoveRange banditNames blankDataIcon blankPlayerIcon
currentPlayer forcedStop gameBoard gameDebugFlg gameBoard gameMaster
gameStatusWindow gameWindow interactiveGameMenu maxMove newPlayers
numMovesRemaining paintMap roadStopHalfWidth saveMap timeTrace
truckDelay truckSlowDownDistance truckIncr truckinLogHandle
truckinLogFile truckinLogFlg xTunnelLeft xTunnelRight yData
FCTPenalty FCTReason))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS GameCommandW GameParamW aliceCount banditCount banditMoveFrequency
banditMoveRange banditNames blankDataIcon blankPlayerIcon currentPlayer forcedStop
gameBoard gameDebugFlg gameBoard gameMaster gameStatusWindow gameWindow interactiveGameMenu
maxMove newPlayers numMovesRemaining paintMap roadStopHalfWidth saveMap timeTrace
truckDelay truckSlowDownDistance truckIncr truckinLogHandle truckinLogFile truckinLogFlg
xTunnelLeft xTunnelRight yData FCTPenalty FCTReason)
)
(RPAQQ TRUCKINFNS (AuxBuyMade AuxMoveMade AuxSellMade BanditGotYou? BrokenRules ChangeValue
CheckVictim CityDump.CanBuy ColorGameBoard.CreateGameBoard
ColorGameBoard.MakeDriveBitMaps CommodityClassMeta.New
CommodityMeta.New CommodityMeta.Subs! CreatePlayers DrawRoadMarks Drive
DriveLeft DriveRight ELIMINATE FindFirstNIL FindLocIndex FindRandomNIL
GameBoard.AssignRoadStops GameBoard.AttachToGame
GameBoard.CreateGameBoard GameBoard.DisplayGameBoard
GameBoard.MakeDriveBitMaps GameBoard.NewBoard GameBoard.PlaceRoadStops
GameBoard.RemovePlayer GameClass.AddCV! GameClass.DeleteCV!
GameClass.RenameCV! GameClass.Subs! GameMaster.AttachBoard
GameMaster.ChangeGameParameters GameMaster.UnattachBoard
GameMasterMeta.New GameMetaClass.New GameObject.AddGauges
GameParameters.LoadPara GameParameters.SetUp GameParameters.StorePara
GenConsumerPr GenConsumerQty InCopyCV? InformBandit&WS
InitializeTruckin InvertIcon MakeDriveBitMaps MetaBrowser.GetSubs
MoveTruckin.BeginGame MoveTruckin.InitializeGameParameters
MoveTruckin.MoveBandits MoveTruckin.RunGame MoveTruckin.SetUpGauges
NormalizeValue RandomRoomAvailable ReflectIcon STRINGNUM
SetMachineDepPara SetUpGame SettifyCopyCV SetupGameBrowsers
SmashCreateCommodity SmashRandomPerishable SubstituteStop TalkinBuyMade
TalkinMoveMade TalkinSellMade TimeTruckin.BeginGame
TimeTruckin.ChargeTime TimeTruckin.CheckAlice
TimeTruckin.GiveAliceBonus TimeTruckin.InitializeGameParameters
TimeTruckin.MoveBandits TimeTruckin.RedoGameParameters
TimeTruckin.ReplenishQty TimeTruckin.RunGame TimeTruckin.SetUpGauges
TimeTruckin.UpdateAlice TimeTruckin.WhoWon TruckinError
TruckinGame.BeginGame TruckinGame.BreakCargo TruckinGame.Buy
TruckinGame.BuyMade TruckinGame.BuyRequest TruckinGame.CheckAlice
TruckinGame.ContinueGame TruckinGame.ForcedMove TruckinGame.GasFill
TruckinGame.GiveAliceBonus TruckinGame.InitializeGameParameters
TruckinGame.Move TruckinGame.MoveBandits
TruckinGame.MoveCheckingHazards TruckinGame.MoveMade
TruckinGame.MoveRequest TruckinGame.MoveTruck
TruckinGame.RedoGameParameters TruckinGame.RemovePlayer
TruckinGame.ReplenishQty TruckinGame.Sell TruckinGame.SellMade
TruckinGame.SellRequest TruckinGame.SetUpGauges TruckinGame.SpoilCargo
TruckinGame.WhoWon TruckinRE UpdateConsumerDisplay UpdatePrDisplay
UpdateProducerSoldout UpdateQtyDisplay WSRuleViolated? WaitIfControlKey
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: " 7-JUN-83 12:01")
(* checks if Bandit at rs caught the currentPlayer)
(PROG ((truck (%@ player truck)))
(RETURN (LESSP speed (RAND 1 (FIX (TIMES (PLUS (%@%@ truck MaxDist)
maxMove)
.5])
(BrokenRules
[LAMBDA (culprit msg cashP moveP penaltyMsg) (* sm: " 8-JUN-83 14:14")
(* 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)
" violated Rule:
")
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 (INTTYL "Debug Pause: " NIL "Type Return to Continue.")))
(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)
(←%@
gameMaster loseTurn (CONS culprit (%@ gameMaster loseTurn)))
(WriteGameStatus (%@ culprit driver)
" Loses Next Turn")))
(COND
(penaltyMsg (WriteGameStatus "Penalty: " penaltyMsg)))
(COND
(debugMode (TruckinRE)))
(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])
(CityDump.CanBuy
[LAMBDA (self commodity pr qty seller) (* sm: "25-JAN-83 18:14")
(* checks if CityDump will buy this commodity)
(* Returns self if can, else NIL)
(PROG NIL (* check if want to buy this commodity)
(COND
((← commodity InstOf!(%@%@ Commodity)))
(T (BrokenRules seller "wrongcommodity")
(RETURN NIL))) (* check qty)
(COND
((GREATERP qty (%@ qty))
(BrokenRules seller "too much quantity")
(RETURN NIL))) (* check pr)
(COND
((GREATERP pr (%@ pr))
(BrokenRules seller "price too high")
(RETURN NIL)))
(RETURN self])
(ColorGameBoard.CreateGameBoard
[LAMBDA (self region title) (* sm: "25-MAY-83 13:50")
(* * Creates a new Window for the gameBoard.)
(PROG (gameWindow screen)
[COND
((OR (NULL (COLORDISPLAYP))
(NULL (SETQ screen (COLORSCREENBITMAP)))
(NEQ 4 (fetch (BITMAP BITMAPBITSPERPIXEL) of screen)))
(COLORDISPLAY T 4)
(SETQ screen (COLORSCREENBITMAP]
(SETQ gameWindow (DSPCREATE screen))
(BITBLT NIL NIL NIL gameWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
borderColor)
(DSPXOFFSET (IQUOTIENT (IDIFFERENCE 640 (fetch (REGION WIDTH) of region))
2)
gameWindow)
(DSPYOFFSET (IQUOTIENT (IDIFFERENCE 480 (fetch (REGION HEIGHT) of region))
2)
gameWindow)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch (REGION WIDTH) of region)
HEIGHT ←(fetch (REGION HEIGHT) of region))
gameWindow)
(BITBLT NIL NIL NIL gameWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
roadColor)
(MakeDriveBitMaps 4)
(RETURN gameWindow])
(ColorGameBoard.MakeDriveBitMaps
[LAMBDA (self) (* sm: "14-JUN-83 16:49")
(* Creates Bit maps for Trucks)
(MakeDriveBitMaps 4])
(CommodityClassMeta.New
[LAMBDA (self) (* mjs: "19-JAN-83 15:01")
(* will complain and NOT create an instance)
(printout T "Cannot create an instance of a class of commodities!" T)
NIL])
(CommodityMeta.New
[LAMBDA (self pr qty owner) (* sm: "11-MAR-83 15:58")
(* 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 T "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!
[LAMBDA (self) (* sm: " 7-JAN-83 11:53")
NIL])
(CreatePlayers
[LAMBDA (num) (* dgb: "23-JUN-83 18:23")
(* 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 num)
num)
(T 20)))
player players (moreNeeded T)
res existingPlayers obj temp (miscOptions (QUOTE (ALL-EXISTING NO)))
menuItems)
(SETQ existingPlayers (for x in newPlayers collect (GetObjectName x)))
[SETQ menuItems (APPEND miscOptions (APPEND existingPlayers (REMOVE (QUOTE DemoPeddler)
(← ($ Player)
List!(QUOTE Subs]
[SETQ players (for i from 1 to pcount while moreNeeded
join (printout T "************ Player No. " i 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 T "Existing players are: " existingPlayers T)
(for x in existingPlayers do (DREMOVE x menuItems))
(DREMOVE (QUOTE ALL-EXISTING)
menuItems)
(for x in existingPlayers
collect (SETQ temp (GetObjectRec x))
(← (@ temp truck)
Initialize)
(← temp Initialize)
temp))
(T (SETQ obj (GetObjectRec res))
(COND
((type? instance obj)
(← (@ obj truck)
Initialize)
(← obj Initialize)
(printout T "Player selected: " res T)
(DREMOVE res menuItems)
(DREMOVE (QUOTE ALL-EXISTING)
menuItems)
(LIST obj))
(T (SETQ player (← obj New))
(printout T "Player created: " (GetObjectName player)
T)
(pushnew newPlayers player)
(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: " 3-JUN-83 13:04")
(* * 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)
(SETQ player (OR player currentPlayer))
(* * 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) (* sm: " 3-JUN-83 13:06")
(* * Low level routine for moving a player icon down the road to the left.)
(RESETVAR truckDelay truckDelay (PROG (truckX (endSave (IDIFFERENCE (%@%@(%$ Player)
Width)
truckIncr))
(nextCol (%@%@(%$ Player)
Width))
(height (%@%@(%$ Player)
Height)))
(* * Initialize the saveMap, paintMap, and place truck initially.)
(SETQ player (OR player currentPlayer))
(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 truckDelay (ADD1 truckDelay]
(COND
((NEQ truckDelay 0)
(DISMISS truckDelay]
(* * Finally erase the truck from the road.)
(BITBLT saveMap NIL NIL gameWindow truckX y)
(RETURN])
(DriveRight
[LAMBDA (xStart xStop y player) (* sm: " 3-JUN-83 13:07")
(* * Low level routine for moving a player icon down the road to the right.)
(RESETVAR truckDelay truckDelay (PROG (truckX (endSave (IDIFFERENCE (%@%@(%$ Player)
Width)
truckIncr))
(nextCol (%@%@(%$ Player)
Width))
(height (%@%@(%$ Player)
Height)))
(* * Initialize the saveMap, paintMap, and place truck initially.)
(SETQ player (OR player currentPlayer))
(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 truckDelay (ADD1 truckDelay]
(COND
((NEQ truckDelay 0)
(DISMISS truckDelay]
(* * 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])
(GameBoard.AssignRoadStops
[LAMBDA (self) (* sm: "12-JUN-83 12:52")
(* * Assign RoadStops to the current GameBoard)
(PROG ((numStopsWanted (ITIMES (@@ numRows)
(@@ numColumns)))
numStopsKnown stops rs stillNeeded (availRS (APPEND (SetRoadStops)))
count) (* generate dummy board)
(for i from 1 to numStopsWanted do (SETQ stops (CONS NIL stops)))
(* install BoardPattern)
(SubstituteStop stops 1 (←New
($ UnionHall)))
(for x in BoardPattern do (SubstituteStop stops (FindRandomNIL stops)
(← ($ AlicesRestaurant)
New)))
(for x in MustStops do (SubstituteStop stops (FindRandomNIL stops)
(← (GetObjectRec x)
New)))
(SETQ stillNeeded (for x in stops count (NULL x)))
(SETQ availRS (FillerRoadStops (DefaultMustStops)))
(SETQ numStopsKnown (FLENGTH availRS))
[for i from stillNeeded to 10 by -1
do [SETQ rs (CAR (NTH availRS (RAND 1 numStopsKnown]
[COND
((ILEQ i numStopsKnown)
(SETQ availRS (DREMOVE rs availRS))
(SETQ numStopsKnown (FLENGTH availRS]
(SubstituteStop stops (FindRandomNIL stops)
(←New
(GetClassRec rs]
[for i from 9 to 1 by -1
do [SETQ rs (CAR (NTH availRS (RAND 1 numStopsKnown]
[COND
((ILEQ i numStopsKnown)
(SETQ availRS (DREMOVE rs availRS))
(SETQ numStopsKnown (FLENGTH availRS]
(SubstituteStop stops (FindFirstNIL stops)
(←New
(GetClassRec rs]
(SETQ StopsNotUsed availRS)
(RETURN (←@
roadStops stops])
(GameBoard.AttachToGame
[LAMBDA (self game) (* sm: "12-MAY-83 14:01")
(* attaches self to game)
(* returns previous game (if any) to which attached)
(PROG (prevGame)
(SETQ prevGame (%@ gameMaster))
(COND
((GetObjectRec prevGame)
(← prevGame UnattachBoard)))
(PutValue self (QUOTE gameMaster)
game)
(RETURN prevGame])
(GameBoard.CreateGameBoard
[LAMBDA (self region title) (* sm: "14-JUN-83 17:30")
(* * Creates a new Window for the gameBoard.)
(PROG (gameWindow)
(SETQ gameWindow (CREATEW region title))
(BITBLT NIL NIL NIL gameWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
boardShade)
(← self MakeDriveBitMaps)
(RETURN gameWindow])
(GameBoard.DisplayGameBoard
[LAMBDA (self) (* sm: "14-JUN-83 17:32")
(* * Displays the gameBoard. ReAllocates gameBoard window if needed.)
(PROG (region (xMargin 2)
(xExtra 10)
(yExtra 20)
width height (k 0)
(date (DATE)))
(* * Initialize and display the gameWindow if needed.)
(SETQ gameWindow (@ gameWindow))
(COND
((NOT gameWindow) (* New window if needed.)
[SETQ width (IPLUS xExtra (ITIMES (@@ numColumns)
(@@($ RoadStop)
Width]
[SETQ height (IPLUS yExtra (ITIMES (@@ numRows)
(IPLUS (@@($ RoadStop)
Height)
(@@($ Player)
Height]
(SETQ region (create REGION
LEFT ← 10
BOTTOM ← 10
WIDTH ← width
HEIGHT ← height))
(SETQ gameWindow (← self CreateGameBoard region (CONCAT
"TRUCKIN Knowledge System. Created by: DANIEL BOBROW, SANJAY MITTAL, and MARK STEFIK. Copyright (c) "
(CONCAT "19"
(SUBSTRING date 8 9))
" Xerox Corp" " ")))
(←@
gameWindow gameWindow)
(←@
windowRegion region))
(T (BITBLT NIL NIL NIL gameWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
boardShade)))
(← self DrawRoadMarks)
(for roadStop in (@ roadStops) do (← roadStop Place))
(RETURN self])
(GameBoard.MakeDriveBitMaps
[LAMBDA (self) (* sm: "14-JUN-83 16:48")
(* Creates Bit maps for Trucks)
(MakeDriveBitMaps 1])
(GameBoard.NewBoard
[LAMBDA (self) (* sm: "12-MAY-83 12:40")
(* Creates and displays a new game board)
(RANDSET T) (* Display the board)
(← self DisplayGameBoard) (* Pick Road Stops)
(← self AssignRoadStops) (* Place RoadStops on the board)
(← self PlaceRoadStops)
gameBoard])
(GameBoard.PlaceRoadStops
[LAMBDA (self) (* sm: "11-MAY-83 17:41")
(* mjs: "17-JAN-83 10:34")
(* * Place the RoadStops onto the GameBoard.)
(PROG ((numRows (%@%@ numRows))
(numColumns (%@%@ numColumns))
(roadStops (%@ roadStops))
(milePost 0)
roadStop x y xIncr yIncr prev)
(* * Compute the x and y initial values and increments.)
(SETQ yIncr (IPLUS (%@%@(%$ RoadStop)
Height)
(%@%@(%$ Player)
Height)))
(SETQ xIncr (%@%@(%$ RoadStop)
Width))
(SETQ y (ITIMES numRows yIncr))
(* * Place the RoadStops on the board.)
(for row from numRows to 1 by -2
do (SETQ x 0)
(SETQ y (IDIFFERENCE y yIncr))
(for col from 1 to numColumns
do (SETQ roadStop (pop roadStops))
(COND
(prev (←%@
prev next roadStop)))
(←%@
roadStop prev prev)
(SETQ prev roadStop)
(SETQ milePost (ADD1 milePost))
(← roadStop Place x y milePost (QUOTE Right))
(SETQ x (IPLUS x xIncr)))
(SETQ x (IDIFFERENCE x xIncr))
(SETQ y (IDIFFERENCE y yIncr))
(for col from numColumns to 1 by -1
do (SETQ roadStop (pop roadStops))
(←%@
prev next roadStop)
(←%@
roadStop prev prev)
(SETQ prev roadStop)
(SETQ milePost (ADD1 milePost))
(← roadStop Place x y milePost (QUOTE Left))
(SETQ x (IDIFFERENCE x xIncr])
(GameBoard.RemovePlayer
[LAMBDA (self player) (* sm: " 8-JUN-83 12:30")
(* Sent to game board so it can remove player from
board)
(PROG ((truck (%@ player truck))
loc)
(SETQ loc (%@ truck location))
(COND
(loc (← loc Unpark player)))
(RETURN player])
(GameClass.AddCV!
[LAMBDA (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!
[LAMBDA (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!
[LAMBDA (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!
[LAMBDA (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!])
(GameMaster.AttachBoard
[LAMBDA (self gameBoard) (* sm: "12-MAY-83 15:59")
(* Attaches gameBoard to game)
(PutValue self (QUOTE gameBoard)
gameBoard)
(←%@
roadStops
(%@ gameBoard roadStops))
(← gameBoard AttachToGame self])
(GameMaster.ChangeGameParameters
[LAMBDA (self) (* sm: "14-JUN-83 13:48")
(* Changes gameParameters via inspector)
(PROG (gp)
(SETQ gp (GetItHere self (QUOTE gameParameters)))
(COND
((EQ gp NotSetValue)
(SETQ gp (← (GetObjectRec (@ gameParameters))
New))
(←@
gameParameters gp)))
(PROMPT "Change Game Parameters by using the displayed Inspector." "When done, click DONE")
(← gp SetUp)
(while (NOT GameParaSet)
do (TOTOPW GameParamW)
(TOTOPW GameCommandW)
(DISMISS 500))
(RETURN T])
(GameMaster.UnattachBoard
[LAMBDA (self) (* sm: "12-MAY-83 16:00")
(* Removes game board)
(PutValue self (QUOTE gameBoard)
NotSetValue)
(←%@
roadStops 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])
(GameMetaClass.New
[LAMBDA (self name supers) (* sm: " 8-FEB-83 16:28")
(* * 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)
(←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
[LAMBDA (self ivs default titleForm) (* dgb: "23-JUN-83 18:41")
(* 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])
(GameParameters.LoadPara
[LAMBDA (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
[LAMBDA (self) (* dgb: "24-JUN-83 12:14")
(* 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 (MYINSPECT self NIL GameParamRegion))
(MOVEW [SETQ GameCommandW (ADDMENU (create MENU
ITEMS ←(QUOTE ((DONE (PROGN (CLOSEW GameParamW)
(CLOSEW GameCommandW)
(← (@ gameMaster
gameParameters)
StorePara)
(SETQ GameParaSet T))
"Clicking DONE will cause Game Parameters to be changed"]
GameCommandX GameCommandY])
(GameParameters.StorePara
[LAMBDA (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])
(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])
(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 (* dgb: "23-JUN-83 17:47")
(* 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)
(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.)
(RANDSET T)
(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])
(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])
(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])
(MetaBrowser.GetSubs
[LAMBDA (self elt) (* sm: " 7-JAN-83 17:36")
(PROG [(meta (GetObjectRec (CAR (← (GetObjectRec elt)
List
(QUOTE Meta]
(RETURN (COND
((EQ meta (GetObjectRec elt))
NIL)
(T (CONS meta])
(MoveTruckin.BeginGame
[LAMBDA (self players moves) (* sm: "13-MAY-83 16:56")
(* * Starts a new game. Players is either the number of players or a list of Player objects.
If players is NIL, but the gameMaster has previous players, it uses those.)
(PROG NIL
[COND
((NUMBERP moves)
(←%@
numMovesRemaining moves)
(PutValue self (QUOTE numMovesRemaining)
T
(QUOTE SetByUser]
(RETURN (←Super
self BeginGame players])
(MoveTruckin.InitializeGameParameters
[LAMBDA (self) (* sm: " 3-JUN-83 15:34")
(* Initializes critical variables for new game to run)
(←Super
self InitializeGameParameters)
[COND
((EQ (%@ self numMovesRemaining SetByUser)
T)
(PutValue self (QUOTE numMovesRemaining)
NIL
(QUOTE SetByUser)))
(T (←%@
numMovesRemaining
(GetInitialValue self (QUOTE numMovesRemaining]
(WriteGameStatus (DATE)
" New Simulation!
"
(CONCAT "Total Moves: " (%@ numMovesRemaining])
(MoveTruckin.MoveBandits
[LAMBDA (self) (* sm: "11-MAY-83 17:54")
(* randomly moves bandits around on the board before
each turn)
(COND
((ZEROP (IMOD (%@ numMovesRemaining)
(%@ banditFreq))) (* Only move once in a while if you are a bandit)
(←Super
self MoveBandits])
(MoveTruckin.RunGame
[LAMBDA (self players) (* dgb: " 9-JUN-83 19:03")
(* This is the main loop that runs the game)
(while (GREATERP (@ numMovesRemaining)
0)
bind playerRet do (PROGN (WaitIfControlKey "Beginning of Game Loop")
(COND
((ZEROP (IMOD (@ numMovesRemaining)
(@ replenishFreq)))
(← self ReplenishQty)))
[COND
((ZEROP (IMOD (@ numMovesRemaining)
10))
(WriteGameStatus NIL "Moves Remaining: " (@ numMovesRemaining]
(← self CheckAlice)
(← self MoveBandits)
(←@
numMovesRemaining
(SUB1 (@ numMovesRemaining)))
(for x in (@ players)
do (PROGN (SETQ currentPlayer (←@
currentPlayer x))
(←@
unchargedTime 0)
(SETQ forcedStop NIL)
(* update commodity status affected by moves)
(for y in (@(@ x truck)
cargo)
do (DoFringeMethods y (QUOTE UpdateStatus)))
(COND
((FMEMB x (@ loseTurn))
(WriteGameStatus (CONCAT (@ x driver)
" lost his turn"))
(←@
loseTurn
(REMOVE x (@ loseTurn)))
(←@
lastMoved NIL))
(T (SETQ maxMove (RAND 1 (@@(@ x truck)
MaxDist)))
(* (WriteGameStatus (@ x driver) " can MOVE max "
maxMove))
[COND
(debugMode (← x TakeTurn))
(T (SETQ playerRet (ERSETQ (← x TakeTurn)))
(COND
((NULL playerRet)
(← self RemovePlayer x
"Player crashed on a Bug"]
(←@
lastMoved NIL])
(MoveTruckin.SetUpGauges
[LAMBDA (self) (* sm: "11-MAY-83 17:44")
(* Set up gauges)
(← self AddGauges (QUOTE numMovesRemaining)
T "Moves Remaining")
(←Super
self SetUpGauges])
(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])
(RandomRoomAvailable
[LAMBDA (begin end lastChoice) (* sm: "18-FEB-83 16:17")
(* 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 (%@ gameMaster 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])
(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])
(SetMachineDepPara
[LAMBDA NIL (* sm: "14-JUN-83 16:52")
(* Sets para dependent on Machinetype)
(SELECTQ (MACHINETYPE)
(DORADO (SETQ truckIncr 1)
(←@@($ Player)
HandicapRatio 1))
(DOLPHIN (SETQ truckIncr 6)
(←@@($ Player)
HandicapRatio .25))
(DANDELION (SETQ truckIncr 6)
(←@@($ Player)
HandicapRatio .25))
(PROGN (SETQ truckIncr 1)
(←@@($ Player)
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: "19-JAN-83 11:06")
(* sets up class browsers for various class hierarchies
in TRUCKIN world)
(PROG NIL
(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])
(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])
(TimeTruckin.BeginGame
[LAMBDA (self players moves time) (* sm: "13-MAY-83 16:56")
(* * Starts a new game. Players is either the number of players or a list of Player objects.
If players is NIL, but the gameMaster has previous players, it uses those.)
(PROG NIL
(COND
((NUMBERP moves)
(←%@
avgNumMoves moves)))
[COND
((NUMBERP time)
(←%@
timeRemaining time)
(PutValue self (QUOTE timeRemaining)
T
(QUOTE SetByUser]
(RETURN (←Super
self BeginGame players])
(TimeTruckin.ChargeTime
[LAMBDA (self player clockTime) (* sm: "14-JUN-83 14:02")
(* Calculates the actual time to be charged to player)
(* if clockTime is NIL, MinMoveTime is charged)
(PROG (time charge)
[COND
((NULL clockTime)
(SETQ charge (@@ MinMoveTime)))
(T [SETQ time (IDIFFERENCE clockTime (IPLUS (@ unchargedTime)
(@@ player Handicap]
[SETQ charge (SETQ time (FIX (QUOTIENT (PLUS 500 (TIMES time (@@ player HandicapRatio))
)
1000]
(COND
((LESSP time (@@ MinMoveTime))
(SETQ charge (@@ MinMoveTime)))
((GREATERP time (@@ MaxMoveTime)) (* player exceeded limit. Yank from game)
(← self RemovePlayer player (CONCAT "Too much time taken " charge))
(SETQ charge 0]
(←@
player timeUsed (IPLUS charge (@ player timeUsed)))
(←@
timeRemaining
(IDIFFERENCE (@ timeRemaining)
charge))
(AND debugTimeTrace (WriteGameStatus (CONCAT "Time Used: by " (@ player driver))
(CONCAT "Clock(ms) " clockTime)
(CONCAT "Used(sec)" time)))
(AND timeTrace (WriteGameStatus "Time Charged to: " (@ player driver)
(CONCAT " " charge " sec")))
(RETURN charge])
(TimeTruckin.CheckAlice
[LAMBDA (self player) (* sm: "14-JUN-83 14:58")
(* check AlicesRestaurant's before each turn)
(for x in (@ alices)
do (for loc in (QUOTE (parkingPlace1 parkingPlace2))
do (PROG (time msg reason)
(COND
((EQ player (GetValue x loc))
(PutValue x loc (ADD1 (GetValue x loc (QUOTE howLong)))
(QUOTE howLong))
(COND
([OR (AND NIL (* This condition is blocked out)
(GREATERP (GetValue x loc (QUOTE howLong))
3)
(SETQ msg "Stayed at Alices more than 3 turns")
(SETQ reason (QUOTE AliceTurn)))
(AND (GREATERP (GetValue x loc (QUOTE howLong))
1)
(GREATERP (SETQ time (IDIFFERENCE (GetValue x loc (QUOTE
timeParked))
(@ gameMaster timeRemaining)))
(@ self aliceStay MaxTime))
(SETQ msg (CONCAT "Spent too much time at Alice: " time))
(SETQ reason (QUOTE AliceTime]
(* stayed there too long)
(COND
((← (@ unionHall)
RoomToPark?)
(BrokenRules player msg NIL 1 "Forcibly moved to UnionHall")
(← self MoveRequest player (FindLocIndex x (@ roadStops))
(FindLocIndex (@ unionHall)
(@ roadStops))
reason))
(T (* UnionHall is temporarily filled)
(BrokenRules player msg NIL 1
"Will be moved to UnionHall next turn"])
(TimeTruckin.GiveAliceBonus
[LAMBDA (self atAlice) (* sm: "25-MAY-83 17:55")
(* Give bonus for reaching Alices)
(WriteGameStatus "Their cashbox multiplied by " (%@%@ AliceBonus))
(for p in atAlice do (←%@(%@ p truck)
cashBox
(FIX (TIMES (%@(%@ p truck)
cashBox)
(%@%@ AliceBonus])
(TimeTruckin.InitializeGameParameters
[LAMBDA (self) (* sm: " 3-JUN-83 15:34")
(* Initializes critical variables for new game to run)
(←Super
self InitializeGameParameters)
[COND
((EQ (GetValue self (QUOTE timeRemaining)
(QUOTE SetByUser))
T))
(T (←%@
timeRemaining
(GetInitialValue self (QUOTE timeRemaining]
(PutValue self (QUOTE replenishFreq)
NotSetValue
(QUOTE LastTime))
(PutValue self (QUOTE banditFreq)
NotSetValue
(QUOTE LastTime))
(PutValue self (QUOTE unchargedTime)
0)
(PutValue self (QUOTE lastPlayer)
NIL])
(TimeTruckin.MoveBandits
[LAMBDA (self) (* sm: "13-MAY-83 15:05")
(* randomly moves bandits around on the board before
each turn)
(COND
((GREATERP (IDIFFERENCE (%@ self banditFreq LastTime)
(%@ timeRemaining))
(%@ banditFreq))
(PutValue self (QUOTE banditFreq)
(%@ timeRemaining)
(QUOTE LastTime)) (* Only move once in a while if you are a bandit)
(←Super
self MoveBandits])
(TimeTruckin.RedoGameParameters
[LAMBDA (self) (* sm: "13-JUN-83 16:54")
(* Change game parameters based on players in the game)
(PROG NIL
(←Super
self RedoGameParameters)
[COND
((EQ (GetValue self (QUOTE timeRemaining)
(QUOTE SetByUser))
T)
(PutValue self (QUOTE timeRemaining)
NIL
(QUOTE SetByUser)))
(T (PutValue self (QUOTE timeRemaining)
(ITIMES (@ avgNumMoves)
(@ self avgNumMoves Factor)
(LENGTH (@ players))
(@@ MinMoveTime]
(WriteGameStatus (DATE)
" New Simulation!
"
(CONCAT "Total Time (in sec.): " (@ timeRemaining)))
(PutValue self (QUOTE replenishFreq)
(@ timeRemaining)
(QUOTE LastTime))
(PutValue self (QUOTE banditFreq)
(ITIMES (@ timeRemaining)
2)
(QUOTE LastTime))
[PutValue self (QUOTE banditFreq)
(ITIMES (@@ MinMoveTime)
(LENGTH (@ players))
(GetValue self (QUOTE banditFreq)
(QUOTE BanditFactor]
[PutValue self (QUOTE replenishFreq)
(ITIMES (@@ MinMoveTime)
(LENGTH (@ players))
(GetValue self (QUOTE replenishFreq)
(QUOTE ReplenishFactor]
(RETURN NIL])
(TimeTruckin.ReplenishQty
[LAMBDA (self) (* sm: "19-MAY-83 15:09")
(* Checks if time to replenish)
(COND
((GREATERP (IDIFFERENCE (%@ self replenishFreq LastTime)
(%@ timeRemaining))
(%@ replenishFreq))
(PutValue self (QUOTE replenishFreq)
(%@ timeRemaining)
(QUOTE LastTime))
(←Super
self ReplenishQty])
(TimeTruckin.RunGame
[LAMBDA (self players) (* sm: "14-JUN-83 15:05")
(* This is the main loop that runs the game)
(while (GREATERP (@ timeRemaining)
0)
bind currPlayer begTime chargeTime playerRet
do (WaitIfControlKey "Beginning of Game Loop")
[COND
((ZEROP (IMOD (@ timeRemaining)
10))
(WriteGameStatus NIL "Time Remaining: " (@ timeRemaining]
(← self ReplenishQty)
(← self MoveBandits)
[for p bind (minTimeSoFar ← 10000000) in (@ players) do (COND
((ILESSP (@ p timeUsed)
minTimeSoFar)
(SETQ currPlayer p)
(SETQ minTimeSoFar
(@ p timeUsed]
(←@
currentPlayer
(SETQ currentPlayer currPlayer))
(SETQ forcedStop NIL) (* update commodity status affected by moves)
(for y in (@(@ currPlayer truck)
cargo)
do (DoFringeMethods y (QUOTE UpdateStatus)))
(←@
unchargedTime 0)
[COND
((FMEMB currPlayer (@ loseTurn))
(WriteGameStatus (CONCAT (@ currPlayer driver)
" lost his turn"))
(SETQ chargeTime (← self ChargeTime currPlayer))
(←@
loseTurn
(REMOVE currPlayer (@ loseTurn)))
(←@
lastMoved NIL))
(T (SETQ maxMove (RAND 1 (@@(@ currPlayer truck)
MaxDist))) (* (WriteGameStatus (@ x driver) " can MOVE max "
maxMove))
(SETQ begTime (CLOCK))
[COND
(debugMode (← currPlayer TakeTurn))
(T (SETQ playerRet (ERSETQ (← currPlayer TakeTurn)))
(COND
((NULL playerRet)
(← self RemovePlayer currPlayer "Player crashed on a Bug"]
(←@
lastMoved NIL)
(SETQ chargeTime (← self ChargeTime currPlayer (IDIFFERENCE (CLOCK)
begTime]
(←@
currPlayer movesMade (ADD1 (@ currPlayer movesMade)))
(← self UpdateAlice currPlayer chargeTime)
(← self CheckAlice currPlayer])
(TimeTruckin.SetUpGauges
[LAMBDA (self) (* sm: "11-MAY-83 17:44")
(* Sets up gauges)
(← self AddGauges (QUOTE timeRemaining)
T "Time Remaining")
(←Super
self SetUpGauges])
(TimeTruckin.UpdateAlice
[LAMBDA (self player time) (* sm: "14-JUN-83 15:08")
(* Adds time used if parked at Alice)
(for x in (@ alices) do (for loc in (QUOTE (parkingPlace1 parkingPlace2))
do (COND
((EQ player (GetValue x loc))
(PutValue x loc (IPLUS time (GetValue x loc (QUOTE timeUsed)))
(QUOTE timeUsed))
(COND
((ZEROP (GetValue x loc (QUOTE howLong)))
(PutValue x loc (@ timeRemaining)
(QUOTE timeParked])
(TimeTruckin.WhoWon
[LAMBDA (self) (* sm: "25-MAY-83 17:59")
(* summarizes the game results)
(PROG (atAlice winner)
(printout T 5 .FONT BOLDFONT "Summary of Game" .FONT DEFAULTFONT T)
(WriteGameStatus NIL "Summary of Game")
[SETQ atAlice (for x in (%@ alices) join (for y in (QUOTE (parkingPlace1 parkingPlace2))
when (GetValue x y) collect (GetValue x y]
(printout T "Following players made it to Alices" T T)
(WriteGameStatus "Following players made it to Alices")
(← self GiveAliceBonus atAlice)
[for x in atAlice
do (printout T .FONT BOLDFONT (%@ x driver)
-5 "$" (%@(%@ x truck)
cashBox)
T)
(WriteGameStatus (%@ x driver)
(CONCAT " $" (%@(%@ x truck)
cashBox]
(printout T T .FONT DEFAULTFONT "Summary of all player's status" T)
(for x in (%@ players)
do (← x Show)
(AND truckinLogFlg truckinLogHandle (← x Show truckinLogHandle)))
(printout T T T T)
(SETQ atAlice (%@ players))
(SETQ winner (CAR atAlice))
[for x in (CDR atAlice) do (COND
((GREATERP (%@(%@ x truck)
cashBox)
(%@(%@ winner truck)
cashBox))
(SETQ winner x]
(printout T .FONT BOLDFONT "Winner is :" (%@ winner driver)
.FONT DEFAULTFONT T)
(WriteGameStatus "Winner is: " (%@ winner driver))
(RETURN winner])
(TruckinError
[LAMBDA (msg) (* mjs: "10-JAN-83 16:06")
(PROMPT msg])
(TruckinGame.BeginGame
[LAMBDA (self players moves) (* sm: "16-JUN-83 19:27")
(* * Starts a new game. Players is either the number of players or a list of Player objects.
If players is NIL, but the gameMaster has previous players, it uses those.)
(PROG (move nextLoc locs board)
(SETQ board (@ gameBoard))
(← self ChangeGameParameters)
(* * Clear the board and initialize.)
(SetMachineDepPara)
(← board MakeDriveBitMaps)
(← self InitializeGameParameters)
[COND
((OR (@ players)
(@ bandits)) (* if this board has been used before, regenerate it
fresh)
(CLEARW (@ board gameWindow)) (* (←@ board gameWindow NIL))
(for x in (@ board roadStops) do (← x Initialize))
(← board DisplayGameBoard) (* (← board PlaceRoadStops))
]
[COND
((AND (EQ players T)
newPlayers)
(SETQ players newPlayers) (* initialize trucks for players)
(for x in players do (← (@ x truck)
Initialize]
(COND
((OR (NUMBERP players)
(NULL players))
(SETQ players (CreatePlayers players)))
((ATOM players)
(printout T "Illegal arg" -3 players T)
(RETURN NIL)))
(←@
players players) (* Redo any game parameters which depend on knowing the
number of players in the game)
(← self RedoGameParameters)
(SETQ locs (@ board roadStops))
(SETQ nextLoc (CAR locs))
(SETQ locs (CDR locs)) (* Put the Players onto the gameBoard.)
[for x in players do (PROG NIL
LOOP(COND
((← nextLoc RoomToPark?)
(SETQ currentPlayer x)
(← nextLoc Park x)
(PutValue (@ currentPlayer truck)
(QUOTE location)
nextLoc))
(T (SETQ nextLoc (CAR locs))
(SETQ locs (CDR locs))
(GO LOOP] (* get AlicesRestaurant's)
(←@
alices
(for x in (@ board roadStops) when (← x InstOf!(QUOTE AlicesRestaurant)) collect x))
(* get UnionHall)
(←@
unionHall
(CAR (@ board roadStops))) (* generate bandits)
[COND
((AND banditCount (GREATERP banditCount 0))
(←@
bandits
(for banditIndex from 1 to (IMIN banditCount (FLENGTH banditNames))
collect (← ($ Bandit)
New banditIndex] (* ask players to initialize just before game starts)
(for x in players do (← x Initialize)) (* Run the Simulation.)
(← self RunGame self players)
(← self WhoWon)
(WriteGameStatus NIL "Simulation Complete! " (DATE))
(AND truckinLogHandle (CLOSEF? truckinLogHandle))
(SETQ truckinLogHandle NIL)
(RETURN "Simulation Complete!"])
(TruckinGame.BreakCargo
[LAMBDA (self player commodIndex) (* sm: " 7-JUN-83 14:15")
(* Sent by a commodity when it breaks)
(PROG ((truck (%@ player truck))
commod)
(SETQ commod (CAR (NTH (%@ truck cargo)
commodIndex)))
(←%@
commod status NIL)
(WriteGameStatus (CONCAT (%@ player driver)
"'s Cargo of:")
(CONCAT (%@ commod qty)
" "
(ClassName commod)
" units")
" destroyed by RoughRoad"])
(TruckinGame.Buy
[LAMBDA (self qty) (* sm: " 6-JUN-83 18:22")
(* message sent by currentPlayer to BUY qty at its
current location)
(PROG (truck loc cmile)
[COND
((NUMBERP qty)
(SETQ qty (FIX qty]
(SETQ truck (%@ currentPlayer truck))
(SETQ loc (%@ truck location))
(SETQ cmile (FindLocIndex loc (%@ roadStops))) (* Update game status window.)
(WriteGameStatus (%@ currentPlayer driver)
" Wants to Buy "
(CONCAT qty " " (GetObjectName (%@%@ loc Commodity))
" units"))
(RETURN (← self BuyRequest currentPlayer cmile qty])
(TruckinGame.BuyMade
[LAMBDA (self player roadPosition reqQty qty reason penalty fragility lifetime)
(* dgb: "13-JUN-83 14:36")
(* Indicates a definite BUY to be made, or reasons for
not carrying out a BuyRequest)
(PROG ((truck (@ player truck))
(loc (CAR (NTH (@ roadStops)
roadPosition)))
commodity)
(AuxBuyMade player roadPosition reqQty qty reason penalty fragility lifetime)
(COND
((ZEROP qty) (* no buy made)
(BrokenRules player (CONCAT "Buy not made: " reason)
penalty)
(RETURN NIL)))
(SETQ commodity (← (GetObjectRec (@@ loc Commodity))
New
(@ loc pr)
qty loc))
(COND
((← commodity InstOf!(QUOTE FragileCommodity))
(←@
commodity fragility fragility)))
(COND
((← commodity InstOf!(QUOTE PerishableCommodity))
(←@
commodity lifetime lifetime)))
(RETURN (← commodity TransferOwner truck NIL qty])
(TruckinGame.BuyRequest
[LAMBDA (self player roadPosition qty) (* sm: " 8-JUN-83 14:11")
(* sm: " 6-JUN-83 10:34")
(* message sent to DecisionMaker to BUY qty at
roadPosition)
(PROG (truck loc commodity intendedLoc) (* check if truck at a producer roadstop)
(SETQ truck (%@ currentPlayer truck))
(SETQ loc (%@ truck location))
(SETQ intendedLoc (CAR (NTH (%@ roadStops)
roadPosition)))
[COND
((NOT (EQ loc intendedLoc)) (* player not where he thought he was)
(RETURN (← self BuyMade player roadPosition qty 0 (QUOTE IncorrectLoc]
[COND
([NOT (AND (GetObjectRec loc)
(← loc InstOf!(QUOTE Producer]
(RETURN (← self BuyMade currentPlayer roadPosition qty 0 (QUOTE NotProducer]
(* Update game status window.)
(* (WriteGameStatus (%@ currentPlayer driver) " Buys "
(CONCAT qty " " (GetObjectName
(%@%@ loc Commodity)) " units")))
(* check if qty is available at RoadStop)
[COND
((ZEROP qty)
(RETURN (← self BuyMade currentPlayer roadPosition qty 0 (QUOTE Zero]
[COND
((AND qty (GREATERP qty (%@ loc qty)))
(RETURN (← self BuyMade currentPlayer roadPosition qty 0 (QUOTE MoreThanAvailable)
.01] (* transfer ownership)
(SETQ commodity (← (%@%@ loc Commodity)
New
(%@ loc pr)
(COND
(qty qty)
(T (%@ loc qty)))
loc))
(RETURN (COND
[(← commodity CanTransfer currentPlayer NIL qty)
(← self BuyMade currentPlayer roadPosition qty (%@ commodity qty)
NIL NIL (COND
((← commodity InstOf!(QUOTE FragileCommodity))
(%@ commodity fragility))
(T NIL))
(COND
((← commodity InstOf!(QUOTE PerishableCommodity))
(%@ commodity lifetime))
(T NIL]
(T (* there was some error during transaction)
(← self BuyMade currentPlayer roadPosition qty 0 FCTReason FCTPenalty])
(TruckinGame.CheckAlice
[LAMBDA (self) (* sm: " 8-JUN-83 11:54")
(* check AlicesRestaurant's before each turn)
(for x in (%@ alices) do (for loc in (QUOTE (parkingPlace1 parkingPlace2))
do (PROGN (COND
((GetValue x loc)
(PutValue x loc (ADD1 (GetValue x loc (QUOTE howLong)))
(QUOTE howLong))
(COND
((GREATERP (GetValue x loc (QUOTE howLong))
3)
(* stayed there too long)
(SETQ currentPlayer (GetValue x loc))
(COND
((← (%@ unionHall)
RoomToPark?)
(BrokenRules currentPlayer
"Stayed at Alices more than 3 turns"
NIL 1
"Forcibly moved to UnionHall")
(← self MoveRequest currentPlayer
(FindLocIndex x (%@ roadStops))
(FindLocIndex (%@ unionHall)
(%@ roadStops))
(QUOTE AliceTurn)))
(T (* UnionHall is temporarily filled)
(BrokenRules currentPlayer
"Stayed at Alices more than 3 turns"
NIL 1
"Will be moved to UnionHall next turn"])
(TruckinGame.ContinueGame
[LAMBDA (self noRedrawFlg) (* sm: "14-JUN-83 17:13")
(* to resume a game in the middle.)
(PROG ((board (@ gameBoard)))
[COND
((NULL noRedrawFlg) (* redisplays the game board)
(CLEARW (@ board gameWindow))
(← board DisplayGameBoard) (* (← board PlaceRoadStops))
(for rs in (@ board roadStops)
do (←@
rs parkingPlace1 NIL)
(←@
rs parkingPlace2 NIL))
(for p in (@ players)
do (SETQ currentPlayer p)
(← (@(@ p truck)
location)
Park))
(for b in (@ bandits)
do (SETQ currentPlayer b)
(← (@(@ b truck)
location)
Park] (* resume game)
(← self RunGame)
(← self WhoWon)
(WriteGameStatus NIL "Simulation Complete! " (DATE))
(AND truckinLogHandle (CLOSEF? truckinLogHandle))
(SETQ truckinLogHandle NIL)
(RETURN "Simulation Complete!"])
(TruckinGame.ForcedMove
[LAMBDA (self player curLoc maxMilePost reason) (* sm: " 6-JUN-83 17:25")
(* determines the loc to move currentPlayer as a forced
move close to maxMilePost)
(PROG ((cmile (%@ curLoc milePost))
newLoc)
[SETQ newLoc (COND
((GREATERP cmile maxMilePost)
(for i from maxMilePost to cmile thereis (← (CAR (NTH (%@ roadStops)
i))
RoomToPark?)))
(T (for i from maxMilePost to cmile by -1 thereis (← (CAR (NTH (%@ roadStops)
i))
RoomToPark?]
[COND
((NULL newLoc) (* no room to park anywhere)
(RETURN (← self MoveMade player cmile cmile (QUOTE NoRoom]
(SETQ newLoc (CAR (NTH (%@ roadStops)
newLoc)))
(RETURN (← self MoveTruck player curLoc newLoc reason])
(TruckinGame.GasFill
[LAMBDA (self prevStop gsStop qty pr) (* sm: "13-JUN-83 19:06")
(* Instructions for moving a gas truck and filling
GasStation)
(* Fills gas station at gsStop)
(* Spl cases: If prevStop =0 then start at UnionHall.
If gsStop=0 then end at UnionHall)
(PROG (gasMan prevRS newRS (unionHall (@ unionHall))
(roadStops (@ roadStops)))
(SETQ gasMan (OR (GetObjectRec (QUOTE Gas))
(← ($ GasPlayer)
New)))
(←@
currentPlayer gasMan)
[COND
((ZEROP prevStop)
(WriteGameStatus NIL "Here comes the GasMan!")
(COND
((← unionHall RoomToPark?)
(← unionHall Crash gasMan)
(DISMISS 1500)))
(SETQ prevRS unionHall))
(T (SETQ prevRS (CAR (NTH roadStops prevStop]
[COND
((ZEROP gsStop)
(SETQ newRS unionHall))
(T (SETQ newRS (CAR (NTH roadStops gsStop]
(COND
((← prevRS Parked? gasMan)
(← prevRS Unpark gasMan)))
(Drive prevRS newRS gasMan)
(COND
[(EQ newRS unionHall)
(COND
((← newRS RoomToPark?)
(← newRS Crash gasMan)
(DISMISS 1500)
(← newRS Unpark gasMan]
(T (← newRS Park gasMan)
(DISMISS 200)
(←@
newRS qty qty)
(←@
newRS pr pr)
(DISMISS 300)))
(RETURN newRS])
(TruckinGame.GiveAliceBonus
[LAMBDA (self atAlice) (* sm: "25-MAY-83 18:01")
(* Dummy method)
self])
(TruckinGame.InitializeGameParameters
[LAMBDA (self) (* sm: "25-MAY-83 15:39")
(* Initializes critical variables for new game to run)
(AND gameStatusWindow (CLEARW gameStatusWindow))
(COND
(truckinLogHandle (CLOSEF? truckinLogHandle)))
(COND
[truckinLogFlg (SETQ truckinLogHandle (OPENFILE truckinLogFile (QUOTE OUTPUT]
(T (SETQ truckinLogHandle NIL)))
(←%@
loseTurn NIL)
(←%@
lastMoved NIL)
(←%@
currentPlayer NIL)
(←%@
unchargedTime 0)
(SETQ maxMove 0])
(TruckinGame.Move
[LAMBDA (self newLoc) (* sm: " 7-JUN-83 19:04")
(* sent by currentPlayer to move to newLoc)
(PROG ((truck (%@ currentPlayer truck))
curLoc cli nli maxLoc (gb (%@ gameBoard)))
(SETQ maxLoc (ITIMES (%@%@ gb numRows)
(%@%@ gb numColumns)))
(SETQ curLoc (%@ truck location))
[SETQ cli (COND
((NULL curLoc)
0)
(T (FindLocIndex curLoc (%@ roadStops]
[COND
((NUMBERP newLoc)
(SETQ nli (PLUS cli newLoc)))
[(FMEMB newLoc (%@ roadStops))
(SETQ nli (FindLocIndex newLoc (%@ roadStops]
(T (BrokenRules currentPlayer (CONCAT "Illegal location: " newLoc]
(WriteGameStatus (%@ currentPlayer driver)
(CONCAT " Moves " (IDIFFERENCE nli cli))
(CONCAT " (max " maxMove ")"))
(COND
((AND (GREATERP nli 0)
(LEQ nli maxLoc))
(SETQ newLoc (CAR (NTH (%@ roadStops)
nli)))
(WriteGameStatus " To: " (%@%@ newLoc RoadSign)
NIL T))
(T (WriteGameStatus NIL NIL NIL T)))
(RETURN (← self MoveRequest currentPlayer cli nli])
(TruckinGame.MoveBandits
[LAMBDA (self) (* sm: "13-JUN-83 16:50")
(* randomly moves bandits around on the board before
each turn)
(PROG ((maxLoc (FLENGTH (@ roadStops)))
loc curLoc banditLoc direction (oldDelay truckDelay)
truck cmile dmile)
(SETQ truckDelay 0)
(WriteGameStatus NIL "Watch out!! The Bandits are Moving")
[for x in (@ bandits)
do (PROGN (SETQ truck (@ x truck))
(SETQ direction (@ x direction))
(SETQ curLoc (@ truck location))
[SETQ banditLoc (COND
((NULL (GetObjectRec curLoc))
(RAND 1 maxLoc))
(T (@ curLoc milePost]
[COND
((AND (EQ direction (QUOTE F))
(GREATERP (IPLUS banditLoc banditMoveRange)
maxLoc))
(←@
x direction (QUOTE B)))
((AND (EQ direction (QUOTE B))
(LESSP (IDIFFERENCE banditLoc banditMoveRange)
1))
(←@
x direction (QUOTE F]
[SETQ loc (CAR (NTH (@ roadStops)
(COND
[(RandomRoomAvailable [COND
((EQ direction (QUOTE F))
banditLoc)
(T (IMAX 1 (IDIFFERENCE
banditLoc
banditMoveRange]
(COND
((EQ direction (QUOTE B))
banditLoc)
(T (IMIN maxLoc
(IPLUS banditLoc
banditMoveRange]
(T (RandomRoomAvailable 1 maxLoc]
[SETQ cmile (COND
((NULL curLoc)
0)
(T (FindLocIndex curLoc (@ roadStops]
(SETQ dmile (FindLocIndex loc (@ roadStops)))
(WriteGameStatus (@ x driver)
" Moves to "
(@@ loc RoadSign))
(← self MoveMade x cmile dmile (QUOTE BanditMove]
(SETQ truckDelay oldDelay)
(RETURN T])
(TruckinGame.MoveCheckingHazards
[LAMBDA (self player curLoc newLoc reason) (* sm: " 7-JUN-83 14:02")
(* moves truck checking for hazards along the way.
Called by GameMaster.MoveTruck)
(PROG (cmile (dmile (%@ newLoc milePost))
whoStopped rs forcedIndex dist fuelNeeded (truck (%@ player truck)))
[COND
((NOT (EQ curLoc (%@ truck location)))
(INTTYL "Bug in MoveCheckingHazards" NIL "Type return to continue.")
(SETQ curLoc (%@ truck location]
(SETQ cmile (%@ curLoc milePost))
(SETQ dist (IDIFFERENCE (IMAX cmile dmile)
(IMIN cmile dmile))) (* check for WeighStations and Bandits)
[SETQ forcedIndex (for i from cmile to dmile by (COND
((GREATERP cmile dmile)
-1)
(T 1))
when (AND (NOT (EQUAL i cmile))
(NOT (EQUAL i dmile)))
eachtime (SETQ rs (CAR (NTH (%@ gameMaster roadStops)
i)))
thereis (SETQ whoStopped (← rs GoingPast player dist]
(COND
(forcedIndex (SETQ newLoc (CAR (NTH (%@ gameMaster roadStops)
forcedIndex)))
(SETQ dmile forcedIndex)))
(RETURN (← self MoveMade player cmile dmile (OR whoStopped reason])
(TruckinGame.MoveMade
[LAMBDA (self player from to reason penaltyAmt missTurn) (* sm: "13-JUN-83 17:15")
(* Actually makes the move after all checks are done)
(* player -
player being moved from, to -
indices of from and to locs reason -
reason for move penaltyAmt -
if any associated with move missTurn -
any missed turn associated with move)
(* Current set of reasons: Bandit, WeighStation, NoFuel,
UnionHall, OffBoardBeg, OffBoardEnd, ConsecMoves,
IllegalLoc, MoreThanAllowed, AlreadyThere, NoRoom,
LowFuel)
(PROG (curLoc finalLoc dist (truck (@ player truck)))
(AuxMoveMade player from to reason penaltyAmt missTurn)
(COND
((AND (EQUAL from to)
(← player InstOf!(QUOTE Player))) (* no physical move. print message)
(BrokenRules player (CONCAT "Move not made: " reason)
penaltyAmt missTurn)
(RETURN NIL)))
(SETQ curLoc (COND
((GREATERP from 0)
(CAR (NTH (@ roadStops)
from)))
(T NIL)))
(SETQ finalLoc (CAR (NTH (@ roadStops)
to)))
(SETQ dist (IABS (IDIFFERENCE from to)))
[←@
truck fuel (IMAX 0 (IDIFFERENCE (@ truck fuel)
(ITIMES dist (@@ truck Gpm]
(COND
(curLoc (← curLoc Unpark player)
(Drive curLoc finalLoc player)))
(← finalLoc Visit player reason) (* more code here for UnionHall, Bandit & WS cash lost,
etc)
(RETURN finalLoc])
(TruckinGame.MoveRequest
[LAMBDA (self player from to reason) (* sm: " 8-JUN-83 14:07")
(* sent to DecisionMaker for deciding if move can be
made)
(* reason, if given is used for system generated
requests and is not charged as a move to player)
(PROG ((truck (%@ player truck))
curLoc moves (cli from)
(nli to)
(gb (%@ gameBoard))
maxLoc
(newLoc to)
fromLoc)
(SETQ maxLoc (ITIMES (%@%@ gb numRows)
(%@%@ gb numColumns)))
(SETQ curLoc (%@ truck location))
(SETQ fromLoc (CAR (NTH (%@ roadStops)
from)))
[COND
((NOT (EQ curLoc fromLoc)) (* player not where he thought he was)
(RETURN (← self MoveMade player from from (QUOTE IncorrectLoc]
[COND
((AND (NOT reason)
(EQ player (%@ lastMoved)))
(RETURN (← self MoveMade player cli cli (QUOTE ConsecutiveMove]
(COND
((NOT reason) (* set last moved only when no System Reason)
(←%@
lastMoved player)))
[COND
[(NUMBERP to)
(COND
[(LESSP nli 1)
(RETURN (← self MoveMade player cli cli (QUOTE OffBoardBeg]
[(GREATERP nli maxLoc)
(RETURN (← self MoveMade player cli cli (QUOTE OffBoardEnd]
(T (SETQ newLoc (CAR (NTH (%@ roadStops)
nli]
[(FMEMB to (%@ roadStops))
(SETQ nli (FindLocIndex to (%@ roadStops]
(T (BrokenRules player (CONCAT "Illegal location: " to))
(RETURN (← self MoveMade player cli cli (QUOTE IllegalLoc]
(* if asked to go to UnionHall dont check any more)
[COND
((← newLoc InstOf!(QUOTE UnionHall))
(RETURN (← self MoveTruck player curLoc newLoc reason]
[COND
((OR (GREATERP nli (PLUS cli maxMove))
(LESSP nli (DIFFERENCE cli maxMove)))
(RETURN (← self MoveMade player cli cli (QUOTE MoreThanAllowed)
NIL 1] (* check if want to move to curLoc)
[COND
((EQ newLoc curLoc) (* no moves are made)
(RETURN (← self MoveMade player cli cli (QUOTE AlreadyThere]
(RETURN (← self MoveTruck player curLoc newLoc])
(TruckinGame.MoveTruck
[LAMBDA (self player curLoc newLoc reason) (* sm: " 6-JUN-83 17:23")
(* actually moves the currentPlayer's truck)
(* reason -
if NIL then move asked by user. else is the reason for the move, where the actual loc will be different from the
original request)
(PROG (dist cmile dmile (truck (%@ player truck))
fuelNeeded actMile forcedMP) (* check if want to go to UnionHall)
(SETQ cmile (%@ curLoc milePost))
(SETQ dmile (%@ newLoc milePost))
[COND
((← newLoc InstOf!(QUOTE UnionHall))
(COND
((← newLoc RoomToPark?)
(RETURN (← self MoveMade player cmile dmile reason)))
(T (RETURN (← self MoveMade player cmile cmile (OR reason (QUOTE NoRoomStayPut]
(* check if truck has fuel)
(SETQ dist (IDIFFERENCE (IMAX cmile dmile)
(IMIN cmile dmile)))
(SETQ fuelNeeded (TIMES dist (%@%@ truck Gpm)))
(COND
((GREATERP fuelNeeded (%@ truck fuel))
[SETQ actMile (FIX (FQUOTIENT (%@ truck fuel)
(%@%@ truck Gpm]
[COND
((ZEROP actMile) (* has no fuel -
move to UnionHall)
(RETURN (← self MoveTruck player curLoc (%@ unionHall)
(QUOTE NoFuel]
[SETQ forcedMP (COND
((GREATERP dmile cmile)
(PLUS cmile actMile))
(T (DIFFERENCE cmile actMile]
(← self ForcedMove player curLoc forcedMP (QUOTE LowFuel))
(RETURN NIL))) (* enough fuel for the move)
(* check if room at intended location)
(COND
((← newLoc RoomToPark?))
(T (← self ForcedMove player curLoc dmile (QUOTE NoRoom))
(RETURN NIL)))
(RETURN (← self MoveCheckingHazards player curLoc newLoc reason])
(TruckinGame.RedoGameParameters
[LAMBDA (self) (* dgb: "23-JUN-83 19:06")
(* Dummy. Needed if some game parameters need to be
changed after the players are known)
(←New
($ SSBarChart)
SetUp
(@ players)
(QUOTE cashBox)
"CashBox of Players" 20000 (QUOTE (truck))
NIL
(QUOTE (430 . 630])
(TruckinGame.RemovePlayer
[LAMBDA (self player reason) (* sm: " 8-JUN-83 12:26")
(* removes player from game)
(PROG NIL
(WriteGameStatus (%@ player driver)
" Committed serious violation: " reason)
(COND
((EQ (QUOTE YES)
(INTTY (CONCAT "Should I remove " (%@ player driver)
" from game?")
(QUOTE (YES NO))
"Y to remove. N to let stay in game"))
(←%@
players
(REMOVE player (%@ players)))
(← (%@ gameBoard)
RemovePlayer player)))
(RETURN player])
(TruckinGame.ReplenishQty
[LAMBDA (self) (* sm: " 7-JUN-83 16:21")
(* replenish GasStations qty)
(PROG (gasMan gasStations (prevStop 0)
nextStop unionHall (roadStops (%@ roadStops)))
(SETQ gasStations (for gasStation in roadStops when (AND (← gasStation InstOf!(%$
GasStation))
(← gasStation RoomToPark?)
(ZEROP (%@ gasStation qty)))
collect gasStation))
(COND
(gasStations (for x in gasStations
do (← self GasFill prevStop (SETQ nextStop (FindLocIndex x roadStops))
(GetInitialValue x (QUOTE qty))
(TIMES 2 (%@ x pr)))
(SETQ prevStop nextStop))
(← self GasFill prevStop 0)))
(RETURN gasStations])
(TruckinGame.Sell
[LAMBDA (self commodity qty) (* sm: " 8-JUN-83 17:40")
(* message sent by currentPlayer to sell qty of
commodity at the player's current location.)
(* commodity is either an instance of commodity or a class of commodity. In the latter case, the game master will
try to find the proper instance if any from the cargo of the truck)
(PROG (truck loc commodityIndex cmile)
[COND
((NUMBERP qty)
(SETQ qty (FIX qty]
(SETQ truck (%@ currentPlayer truck))
(SETQ loc (%@ truck location))
(SETQ cmile (FindLocIndex loc (%@ roadStops))) (* check if commodity is class or actual commodity
instance)
(COND
[(type? instance commodity)
(SETQ commodityIndex (FindLocIndex commodity (%@ truck cargo]
(T (SETQ commodityIndex commodity))) (* Update Status Window.)
(WriteGameStatus (%@ currentPlayer driver)
" Wants to sell"
(CONCAT qty " " (ClassName commodity)
" units."))
(RETURN (← self SellRequest currentPlayer cmile commodityIndex qty))
(* check if truck has qty)
])
(TruckinGame.SellMade
[LAMBDA (self player roadPosition reqQty qty cargoPosition reason penalty)
(* dgb: "13-JUN-83 14:38")
(* Performs an actual Sell, once all checking is done)
(PROG [(truck (@ player truck))
commodity
(loc (CAR (NTH (@ roadStops)
roadPosition]
(AuxSellMade player roadPosition reqQty qty cargoPosition reason penalty)
(COND
((ZEROP qty) (* no sell made)
(BrokenRules player (CONCAT "Unable to sell: " reason)
penalty)
(RETURN NIL)))
(SETQ commodity (CAR (NTH (@ truck cargo)
cargoPosition)))
(RETURN (← commodity TransferOwner loc (@ loc pr)
qty])
(TruckinGame.SellRequest
[LAMBDA (self player roadPosition commodityIndex qty) (* sm: " 8-JUN-83 17:41")
(* sm: "25-MAY-83 15:40")
(* message sent to DecisionMaker to sell qty of
commodity at the player's roadPosition.)
(* commodityIndex -
index into cargo of player)
(PROG (truck loc commodity intendedLoc commodities) (* check if truck at a Consumer RoadStop)
(SETQ truck (%@ currentPlayer truck))
(SETQ loc (%@ truck location))
(SETQ intendedLoc (CAR (NTH (%@ roadStops)
roadPosition)))
[COND
((NOT (EQ loc intendedLoc)) (* player is not where he thought he was)
(RETURN (← self SellMade player roadPosition qty 0 commodityIndex (QUOTE IncorrectLoc]
[COND
([NOT (AND (GetObjectRec loc)
(← loc InstOf!(QUOTE Consumer]
(RETURN (← self SellMade player roadPosition qty 0 commodityIndex (QUOTE NotConsumer]
(* check if trying to sell 0)
[COND
((NULL qty)
(SETQ qty (%@ loc qty]
[COND
((ZEROP qty)
(RETURN (← self SellMade player roadPosition qty 0 commodityIndex (QUOTE Zero]
(* check if commodityIndex is class or actual commodity
index)
[COND
[(NUMBERP commodityIndex)
(SETQ commodity (CAR (NTH (%@ truck cargo)
commodityIndex]
([NOT (AND (GetClassRec commodityIndex)
(← (GetClassRec commodityIndex)
InstOf!(QUOTE Commodity]
(← self SellMade player roadPosition qty 0 commodityIndex (QUOTE InvalidCommodity)))
(T (* get commodity instance from cargo)
(SETQ commodities (for x in (%@(%@ player truck)
cargo)
when (← x InstOf! commodityIndex) collect x))
(COND
((NULL commodities)
(← self SellMade player roadPosition qty 0 commodityIndex (QUOTE NotOwned)
.1)
(RETURN NIL))
(T (* get the instance with at least specified qty)
[SETQ commodity (for x in commodities thereis (NOT (LESSP qty (%@ x qty]
(COND
((NULL commodity) (* no instance with qty -
pick any)
(SETQ commodity (CAR commodities] (* Update Status Window.)
(* (WriteGameStatus (%@ currentPlayer driver) " Sells "
(CONCAT qty " " (ClassName commodity) " units.")))
(* check if truck has qty)
[COND
((GREATERP qty (%@ commodity qty))
(RETURN (← self SellMade player roadPosition qty 0 commodityIndex (QUOTE MoreThanOwned)
.1] (* transfer ownership)
(RETURN (COND
((← commodity CanTransfer loc (%@ loc pr)
qty)
(← self SellMade player roadPosition qty qty commodityIndex))
(T (* there was some error during transaction)
(← self SellMade player roadPosition qty 0 commodityIndex FCTReason FCTPenalty]
)
(TruckinGame.SetUpGauges
[LAMBDA (self) (* sm: "25-MAY-83 15:40")
(* Sets up gauges)
(← self AddGauges (QUOTE currentPlayer)
T "Current Player"])
(TruckinGame.SpoilCargo
[LAMBDA (self player commodIndex) (* sm: " 7-JUN-83 14:33")
(* Sent by commodity when it spoils)
(PROG ((truck (%@ player truck))
commod)
(SETQ commod (CAR (NTH (%@ truck cargo)
commodIndex)))
(←%@
commod status NIL)
(WriteGameStatus (CONCAT (%@ player driver)
"'s cargo of: ")
(CONCAT (%@ commod qty)
" "
(ClassName commod)
" units")
" just perished. Tch! Tch!")
(RETURN NIL])
(TruckinGame.WhoWon
[LAMBDA (self) (* sm: "25-MAY-83 17:50")
(* summarizes the game results)
(PROG (atAlice winner)
(printout T 5 .FONT BOLDFONT "Summary of Game" .FONT DEFAULTFONT T)
(WriteGameStatus NIL "Summary of Game")
[SETQ atAlice (for x in (%@ alices) join (for y in (QUOTE (parkingPlace1 parkingPlace2))
when (GetValue x y) collect (GetValue x y]
(printout T "Following players made it to Alices" T T)
(WriteGameStatus "Following players made it to Alices")
(← self GiveAliceBonus atAlice)
[for x in atAlice
do (printout T .FONT BOLDFONT (%@ x driver)
-5 "$" (%@(%@ x truck)
cashBox)
T)
(WriteGameStatus (%@ x driver)
(CONCAT " $" (%@(%@ x truck)
cashBox]
(printout T T .FONT DEFAULTFONT "Summary of all player's status" T)
(for x in (%@ players)
do (← x Show)
(AND truckinLogFlg truckinLogHandle (← x Show truckinLogHandle)))
(printout T T T T)
[COND
((NULL atAlice)
(printout T "Sorry!! No one made it to Alice" T)
(WriteGameStatus "Sorry!! No one made it to Alice"))
(T (SETQ winner (CAR atAlice))
[for x in (CDR atAlice) do (COND
((GREATERP (%@(%@ x truck)
cashBox)
(%@(%@ winner truck)
cashBox))
(SETQ winner x]
(printout T .FONT BOLDFONT "Winner is :" (%@ winner driver)
.FONT DEFAULTFONT T)
(WriteGameStatus "Winner is: " (%@ winner driver]
(RETURN winner])
(TruckinRE
[LAMBDA NIL (* sm: "13-MAY-83 15:02")
(* Calls RE but not charge for time spent in RE)
(PROG (begT endT)
(COND
[(AND (BOUNDP (QUOTE gameMaster))
(GetObjectRec gameMaster))
(SETQ begT (CLOCK))
(RE)
(SETQ endT (CLOCK))
(←%@
gameMaster unchargedTime (IPLUS (%@ gameMaster unchargedTime)
(IDIFFERENCE endT begT]
(T (RE])
(UpdateConsumerDisplay
[LAMBDA (self varName newValue propName activeVal type) (* sm: "21-JAN-83 14:30")
(* This is a putFn for qty for informing consumers to
change displayed quantity)
(PutLocalState activeVal newValue self varName propName type)
(← self DisplayData)
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: "19-MAY-83 13:34")
(* * 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 T where T))
(UE)))
(DISMISS 500))
(SETQ endT (CLOCK))
(PutValue gameMaster (QUOTE unchargedTime)
(IPLUS (%@ gameMaster unchargedTime)
(IDIFFERENCE endT begT])
(WriteGameStatus
[LAMBDA (msg boldMsg moreMsg asIsFlg) (* sm: "19-MAY-83 13:14")
(* 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 gameMaster (QUOTE unchargedTime)
(IPLUS (%@ gameMaster unchargedTime)
(IDIFFERENCE endT begT])
)
(RPAQQ GameCommandX 595)
(RPAQQ GameCommandY 651)
(RPAQQ GameParamRegion (630 650 270 90))
(RPAQQ aliceCount 2)
(RPAQQ banditCount 2)
(RPAQQ banditMoveFrequency 5)
(RPAQQ banditMoveRange 15)
(RPAQQ debugMode T)
(RPAQQ debugTimeTrace NIL)
(RPAQQ defaultGaugesFlg T)
(INTERRUPTCHAR 6 (LIST (FUNCTION TruckinRE)))
(* A fix up for the inspector to allow it to place a window exactly where is is wanted. A patch
until this is put in the system. Used in GameParameter.Setup)
(RPAQQ INSPECTLOC NIL)
(DEFINEQ
(MYINSPECT
[LAMBDA (DATUM ASTYPE INSPECTLOC) (* lmm "24-JUN-83 11:30")
(INSPECT DATUM ASTYPE])
)
(PUTPROPS GETBOXREGION-IN-INSPECTW.CREATE READVICE [(INSPECTW.CREATE . GETBOXREGION)
(BEFORE NIL (COND (INSPECTLOC (RETURN INSPECTLOC])
(READVISE GETBOXREGION-IN-INSPECTW.CREATE)
(DECLARE: DONTCOPY
(FILEMAP (NIL (29955 143288 (AuxBuyMade 29965 . 30652) (AuxMoveMade 30654 . 31249) (AuxSellMade 31251
. 31906) (BanditGotYou? 31908 . 32281) (BrokenRules 32283 . 34416) (ChangeValue 34418 . 35111) (
CheckVictim 35113 . 36402) (CityDump.CanBuy 36404 . 37323) (ColorGameBoard.CreateGameBoard 37325 .
38564) (ColorGameBoard.MakeDriveBitMaps 38566 . 38820) (CommodityClassMeta.New 38822 . 39139) (
CommodityMeta.New 39141 . 40403) (CommodityMeta.Subs! 40405 . 40530) (CreatePlayers 40532 . 42707) (
DrawRoadMarks 42709 . 43833) (Drive 43835 . 46502) (DriveLeft 46504 . 48599) (DriveRight 48601 . 50654
) (ELIMINATE 50656 . 51165) (FindFirstNIL 51167 . 51383) (FindLocIndex 51385 . 51690) (FindRandomNIL
51692 . 52334) (GameBoard.AssignRoadStops 52336 . 54219) (GameBoard.AttachToGame 54221 . 54778) (
GameBoard.CreateGameBoard 54780 . 55214) (GameBoard.DisplayGameBoard 55216 . 56696) (
GameBoard.MakeDriveBitMaps 56698 . 56947) (GameBoard.NewBoard 56949 . 57484) (GameBoard.PlaceRoadStops
57486 . 59111) (GameBoard.RemovePlayer 59113 . 59535) (GameClass.AddCV! 59537 . 60557) (
GameClass.DeleteCV! 60559 . 61124) (GameClass.RenameCV! 61126 . 61648) (GameClass.Subs! 61650 . 61998)
(GameMaster.AttachBoard 62000 . 62363) (GameMaster.ChangeGameParameters 62365 . 63073) (
GameMaster.UnattachBoard 63075 . 63371) (GameMasterMeta.New 63373 . 64460) (GameMetaClass.New 64462 .
66209) (GameObject.AddGauges 66211 . 68825) (GameParameters.LoadPara 68827 . 69461) (
GameParameters.SetUp 69463 . 70337) (GameParameters.StorePara 70339 . 71117) (GenConsumerPr 71119 .
71578) (GenConsumerQty 71580 . 71961) (InCopyCV? 71963 . 72447) (InformBandit&WS 72449 . 74764) (
InitializeTruckin 74766 . 78361) (InvertIcon 78363 . 78772) (MakeDriveBitMaps 78774 . 79214) (
MetaBrowser.GetSubs 79216 . 79524) (MoveTruckin.BeginGame 79526 . 80058) (
MoveTruckin.InitializeGameParameters 80060 . 80705) (MoveTruckin.MoveBandits 80707 . 81157) (
MoveTruckin.RunGame 81159 . 83003) (MoveTruckin.SetUpGauges 83005 . 83320) (NormalizeValue 83322 .
83616) (RandomRoomAvailable 83618 . 84478) (ReflectIcon 84480 . 84991) (STRINGNUM 84993 . 85257) (
SetMachineDepPara 85259 . 85823) (SetUpGame 85825 . 86041) (SettifyCopyCV 86043 . 86423) (
SetupGameBrowsers 86425 . 87399) (SmashCreateCommodity 87401 . 88333) (SmashRandomPerishable 88335 .
88732) (SubstituteStop 88734 . 89235) (TalkinBuyMade 89237 . 89535) (TalkinMoveMade 89537 . 89759) (
TalkinSellMade 89761 . 90055) (TimeTruckin.BeginGame 90057 . 90652) (TimeTruckin.ChargeTime 90654 .
92080) (TimeTruckin.CheckAlice 92082 . 93714) (TimeTruckin.GiveAliceBonus 93716 . 94160) (
TimeTruckin.InitializeGameParameters 94162 . 94904) (TimeTruckin.MoveBandits 94906 . 95480) (
TimeTruckin.RedoGameParameters 95482 . 96825) (TimeTruckin.ReplenishQty 96827 . 97284) (
TimeTruckin.RunGame 97286 . 99363) (TimeTruckin.SetUpGauges 99365 . 99676) (TimeTruckin.UpdateAlice
99678 . 100290) (TimeTruckin.WhoWon 100292 . 101965) (TruckinError 101967 . 102094) (
TruckinGame.BeginGame 102096 . 105306) (TruckinGame.BreakCargo 105308 . 105887) (TruckinGame.Buy
105889 . 106651) (TruckinGame.BuyMade 106653 . 107809) (TruckinGame.BuyRequest 107811 . 110274) (
TruckinGame.CheckAlice 110276 . 111592) (TruckinGame.ContinueGame 111594 . 112766) (
TruckinGame.ForcedMove 112768 . 113745) (TruckinGame.GasFill 113747 . 115325) (
TruckinGame.GiveAliceBonus 115327 . 115542) (TruckinGame.InitializeGameParameters 115544 . 116192) (
TruckinGame.Move 116194 . 117433) (TruckinGame.MoveBandits 117435 . 119367) (
TruckinGame.MoveCheckingHazards 119369 . 120717) (TruckinGame.MoveMade 120719 . 122440) (
TruckinGame.MoveRequest 122442 . 124896) (TruckinGame.MoveTruck 124898 . 126918) (
TruckinGame.RedoGameParameters 126920 . 127386) (TruckinGame.RemovePlayer 127388 . 128020) (
TruckinGame.ReplenishQty 128022 . 128896) (TruckinGame.Sell 128898 . 130267) (TruckinGame.SellMade
130269 . 131117) (TruckinGame.SellRequest 131119 . 134646) (TruckinGame.SetUpGauges 134648 . 134923) (
TruckinGame.SpoilCargo 134925 . 135528) (TruckinGame.WhoWon 135530 . 137319) (TruckinRE 137321 .
137834) (UpdateConsumerDisplay 137836 . 138222) (UpdatePrDisplay 138224 . 138822) (
UpdateProducerSoldout 138824 . 139322) (UpdateQtyDisplay 139324 . 139930) (WSRuleViolated? 139932 .
140678) (WaitIfControlKey 140680 . 141319) (WriteGameStatus 141321 . 143286)) (143845 143990 (
MYINSPECT 143855 . 143988)))))
STOP