(FILECREATED "27-JUN-83 00:21:55" {INDIGO}<LOOPS>TRUCKIN>TRUCKINP.;11 39782
changes to: (CLASSES Player)
(FNS SystemPlayer.SetUpPlayer DemoPlayerMeta.New DemoPeddler.SetUpGauges)
(VARS TRUCKINPCLASSES)
previous date: "16-JUN-83 19:46:46" {INDIGO}<LOOPS>TRUCKIN>TRUCKINP.;10)
(PRETTYCOMPRINT TRUCKINPCOMS)
(RPAQQ TRUCKINPCOMS ((* Copyright (c)
1983 by Xerox Corporation.)
(* Generic Players and Trucks for the TRUCKIN game. TRUCKIN 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.")
(* Written in January 1983 by the Loops Group -- Daniel Bobrow, Sanjay Mittal,
and Mark Stefik.)
(* System classes for Players. Includes an interactive manual player.)
(CLASSES * TRUCKINPCLASSES)
(VARS * TRUCKINPVARS)
(* Kinds of Trucks.)
(CLASSES * Trucks)
(* Bandit Classes)
(CLASSES * BANDITCLASSES)
(* Lisp Fns.)
(FNS * TRUCKINPFNS)))
(* Copyright (c) 1983 by Xerox Corporation.)
(* Generic Players and Trucks for the TRUCKIN game. TRUCKIN 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.")
(* Written in January 1983 by the Loops Group -- Daniel Bobrow, Sanjay Mittal, and Mark Stefik.
)
(* System classes for Players. Includes an interactive manual player.)
(RPAQQ TRUCKINPCLASSES (GasPlayer GasPlayerMeta InteractivePlayer Player PlayerMeta SystemPlayer
DemoPlayerMeta DemoPeddler))
(DEFCLASSES GasPlayer GasPlayerMeta InteractivePlayer Player PlayerMeta SystemPlayer DemoPlayerMeta
DemoPeddler)
[DEFCLASS GasPlayer
(MetaClass GasPlayerMeta doc
(* * SystemPlayer used to refresh qty at GasStations.)
Edited: (* mjs: "16-MAR-83 18:32")
)
(Supers SystemPlayer)
(ClassVariables)
(InstanceVariables)
(Methods (SelectTruck GasPlayer.SelectTruck args NIL doc
(* Selects GasTruck for GasPlayer)))]
[DEFCLASS GasPlayerMeta
(MetaClass GameMetaClass doc
(* * MetaClass for GasPlayers.)
Edited: (* mjs: "16-MAR-83 18:32")
)
(Supers GameClass)
(ClassVariables)
(InstanceVariables)
(Methods (New GasPlayerMeta.New args (driver)
doc (* instantiate a GasPlayer)
))]
[DEFCLASS InteractivePlayer
(MetaClass PlayerMeta doc
(* * Specialization of Player used for debugging. Pops up an interactive window for getting the Player moves
directly from the the mouse instead of using knowledge encoded in rules.)
Edited: (* sm: "16-JUN-83 19:35")
)
(Supers Player)
(ClassVariables (UnChangedIVs (name driver truck icon reverseIcon window x y))
(Handicap 600000))
(InstanceVariables (window NIL doc (* Window in which User interaction takes place.)
dontSave Value)
(x NIL doc (* x Origin of interaction window))
(y NIL doc (* y Origin of interaction window.)))
(Methods (Interact InteractivePlayer.Interact args NIL doc
(* * Pops up the appropriate Windows, menus, and number pads for interactive play.)
)
(PositionWindow InteractivePlayer.PositionWindow args NIL doc
(* * Locates the interaction window on the gameBoard in a location distant from the current position of the
player.)
)
(TakeTurn InteractivePlayer.TakeTurn args NIL doc
(* * Sets up the windows and menus for an Interactive TRUCKIN Player.)
))]
[DEFCLASS Player
(MetaClass PlayerMeta doc (* Participant in the Truckin Simulation.)
Edited: (* sm: "18-MAY-83 08:31")
)
(Supers SystemPlayer)
(ClassVariables (Handicap 0 doc (* Free time allowed to compensate for slowness)
)
(HandicapRatio 1 doc (* the time charged is multiplied by this ratio)
))
(InstanceVariables (timeUsed 0 DefaultGauge LCD doc (* total time used so far))
(movesMade 0 DefaultGauge LCD doc (* actual number of moves made.
Used by TimeGameMaster)))
(Methods (AnyRoadStop Player.AnyRoadStop args (roadStopType numMoves direction roomToParkFlg)
doc (* Randomly picks one of the RoadStops of type
roadStopType, where roadStopType is the name of a super
of some RoadStop.)
)
(Buyers Player.Buyers doc
(* Returns all of the Buyers wishing to purchase the Commodity. If numMoves is provided, it returns only those
within that distance. A common case is to use maxMove for numMoves. If includeCDFlg is T includes CityDumps also.)
args
(commodityClass numMoves includeCDFlg))
(CheckTruck Player.CheckTruck doc (* Check the validity of a Truck for a Player.)
)
(DirectionOf Player.DirectionOf args (toRoadStop fromRoadStop)
doc
(* * Returns direction of travel for going from fromRoadStop to toRoadStop. If fromRoadStop is not given, then the
location of the currentPlayer is assumed.)
)
(Distance Player.Distance args (toRoadStop fromRoadStop)
doc
(* * Computes the distance between fromRoadStop and toRoadStop. If fromRoadStop is NIL, assumes the location of
the currentPlayer.)
)
(FurthestRoadStop Player.FurthestRoadStop args (roadStops fromRoadStop)
doc
(* * Returns the RoadStop furthest from fromRoadStop (excluding fromRoadStop) in the list of roadStops.
If fromRoadStop is not given, assumes the position of the currentPlayer.)
)
(NearestRoadStop Player.NearestRoadStop args (roadStops fromRoadStop)
doc (* Returns the RoadStop nearest to fromRoadStop in the
list of roadStops.)
)
(NthRoadStop Player.NthRoadStop args (numMiles direction fromRoadStop roomToParkFlg)
doc
(* Returns the Nth roadStop in the given direction from fromRoadStop. If roomToParkFlg, it picks the farthest
RoadStop under numMiles in which there is room. If no room at all, returns fromRoadStop.)
)
(Range Player.Range args NIL doc (* Computers the travel range for the current player as
limited only by fuel.))
(Range1 Player.Range1 args NIL doc (* Computers the travel range in a single move for the
current player as limited only by fuel maxMove.)
)
(RemovePlayer Player.RemovePlayer args NIL doc
(* Sent to player when player removed from game.
Currently dummy))
(RoadStops Player.RoadStops args (roadStopType numMoves direction roomToParkFlg)
doc (* Returns all of the RoadStops of type roadStopType,
where roadStopType is the name of a super of some
RoadStop.)
)
(SelectTruck Player.SelectTruck args NIL doc (* ask player what truck he wants))
(Sellers Player.Sellers args (commodityClass numMoves)
doc (* Returns all of the Sellers having the Commodity for
sale.)
)
(SetUpGauges Player.SetUpGauges args NIL doc (* offer to put gauges))
(Show Player.Show doc (* Prints a report about the status of the current
player. Used for debugging.)
args
(file))
(TakeTurn Player.TakeTurn args (squares)
doc
(* * Dummy Fn for Player moves. Replaced by Player's RuleSet.)
RuleSet TakeTurnTravelerRules)
(TimeAtStop Player.TimeAtStop args NIL doc (* Returns the time spent by player at the stop where
currently parked.))
(TurnsAtStop Player.TurnsAtStop args NIL doc (* how many turns parked at current location)
))]
[DEFCLASS PlayerMeta
(MetaClass GameMetaClass doc (* MetaClass for Player. Provides interactive method for
defining new players.)
Edited: (* mjs: "16-MAR-83 16:19")
)
(Supers GameClass)
(ClassVariables)
(InstanceVariables)
(Methods (New PlayerMeta.New args NIL doc
(* * Interactive method for defining a new player.)
)
(TurnOn PlayerMeta.TurnOn args (compilerOption)
doc (* Turns on the compiler option for every method of self
that is implemented as a RuleSet.)
)
(TurnOff PlayerMeta.TurnOff args (compilerOption)
doc (* Turns Off the compiler option for every method of
self that is implemented as a RuleSet.)
))]
[DEFCLASS SystemPlayer
(MetaClass GameAbstractClass Edited: (* mjs: "16-MAR-83 16:20"))
(Supers GameObject)
(ClassVariables (UnChangedIVs (name driver truck icon reverseIcon)
doc (* list of IVs not to be changed)
)
(Width 35 doc (* Width of a player icon in pixels.))
(Height 25 doc (* Height of a player icon in pixels.)))
(InstanceVariables (truck NIL doc (* Truck object used by player.))
(reverseIcon NIL doc (* Cache for BitMap for player's truck going backwards.)
)
(icon NIL doc (* Cache for BitMap containing icon for player's truck
as well as player's name. Created by MakeIcon msg.)
)
(driver "Name1" doc (* String name to appear with the truck on the first
line on the board. Six chars or fewer.)))
(Methods (CanBuy SystemPlayer.CanBuy args (commod pr qty seller)
doc (* CanBuy for player)
)
(CanBuyFuel SystemPlayer.CanBuyFuel args (commod pr qty seller)
doc (* CanBuyFuel for Player)
)
(CheckTruck SystemPlayer.CheckTruck args (truckClassName)
doc (* No checking for SystemPlayers.)
)
(Initialize SystemPlayer.Initialize args ? doc
(* Initializes IVs of player from class))
(MakeIcon SystemPlayer.MakeIcon args (reverseFlg)
doc
(* * Creates an icon for the player from the firstName, lastName, and truck icon. Shows truck going backwards if
reverseFlg=T.)
)
(MakeIcons SystemPlayer.MakeIcons args ? doc
(* * Make icon and the reversed-direction icon for a player.)
)
(SetUpPlayer SystemPlayer.SetUpPlayer args (driver ptruck)
doc
(* * Method for instantiating a player. The argument driver and ptruck is optional.)
))]
[DEFCLASS DemoPlayerMeta
(MetaClass GameMetaClass Edited: (* dgb: "23-JUN-83 17:36"))
(Supers PlayerMeta)
(ClassVariables)
(InstanceVariables)
(Methods (New DemoPlayerMeta.New args (driver truck)
doc (* method for defining a new demo player)
))]
[DEFCLASS DemoPeddler
(MetaClass DemoPlayerMeta Edited: (* dgb: "23-JUN-83 18:23"))
(Supers Peddler)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables)
(Methods (SetUpGauges DemoPeddler.SetUpGauges args NIL doc
(* Put gauges on DemoPeddler)))]
(RPAQQ TRUCKINPVARS ((interactiveGameMenu NIL)))
(RPAQQ interactiveGameMenu NIL)
(* Kinds of Trucks.)
(RPAQQ Trucks (MacTruck GMCTruck GasTruck FordTruck PeterBiltTruck))
(DEFCLASSES MacTruck GMCTruck GasTruck FordTruck PeterBiltTruck)
[DEFCLASS MacTruck
(MetaClass GameClass doc
(* * Good Workhorse truck. Medium in range, weight, and speed.)
Edited: (* sm: "21-FEB-83 15:56")
)
(Supers Truck)
(ClassVariables (InitCash 10000)
(Icon MacTruckIcon)
(Gpm 2)
(MaxDist 30)
(MaxWeight 2000)
(MaxVolume 2000)
(MaxFuel 160))
(InstanceVariables)
(Methods)]
[DEFCLASS GMCTruck
(MetaClass GameClass doc
(* * GMC is a big fast mover, but spends a lot on fuel.)
Edited: (* sm: "21-FEB-83 15:56")
)
(Supers Truck)
(ClassVariables (InitCash 10000)
(Icon GMCTruckIcon)
(Gpm 3)
(MaxDist 24)
(MaxWeight 4000)
(MaxVolume 2000)
(MaxFuel 240))
(InstanceVariables)
(Methods)]
[DEFCLASS GasTruck
(MetaClass Class doc (* Truck used by Gas Player.)
Edited: (* mjs: "16-MAR-83 14:45")
)
(Supers SystemTruck)
(ClassVariables (Icon GasTruckIcon))
(InstanceVariables)
(Methods)]
[DEFCLASS FordTruck
(MetaClass GameClass doc
(* * Ford is a good lightweight truck. Fast with high mileage, but a low capacity.)
Edited: (* sm: "14-FEB-83 08:46")
)
(Supers Truck)
(ClassVariables (InitCash 10000)
(Icon FordTruckIcon)
(Gpm 1)
(MaxDist 50)
(MaxWeight 500)
(MaxVolume 500)
(MaxFuel 80))
(InstanceVariables)
(Methods)]
[DEFCLASS PeterBiltTruck
(MetaClass GameClass doc (* PeterBilt is a good heavy long distance mover, with
an efficient engine. But he is slow.)
Edited: (* mjs: "16-MAR-83 15:03")
)
(Supers Truck)
(ClassVariables (InitCash 10000)
(Icon PeterBiltTruckIcon)
(Gpm 4)
(MaxDist 15)
(MaxWeight 5000)
(MaxVolume 5000)
(MaxFuel 320))
(InstanceVariables)
(Methods)]
(* Bandit Classes)
(RPAQQ BANDITCLASSES (BanditCarMeta BanditCar BanditMeta Bandit))
(DEFCLASSES BanditCarMeta BanditCar BanditMeta Bandit)
[DEFCLASS BanditCarMeta
(MetaClass GameMetaClass Edited: (* sm: "26-JAN-83 16:38"))
(Supers GameClass)
(ClassVariables)
(InstanceVariables)
(Methods (New BanditCarMeta.New args (driver)
doc (* instantiates BanditCar and puts in driver name if
specified)
))]
[DEFCLASS BanditCar
(MetaClass BanditCarMeta Edited: (* sm: " 7-JUN-83 14:18"))
(Supers SystemTruck)
(ClassVariables (CopyCV (InitCash MaxFuel MaxVolume MaxWeight MaxDamage MaxDist Gpm Icon))
(Icon BlackMariaIcon)
(Gpm 1)
(MaxDist 100)
(MaxDamage 100)
(MaxWeight 1000)
(MaxVolume 1000)
(MaxFuel 10000)
(InitCash 0))
(InstanceVariables)
(Methods (VisitUnionHall BanditCar.VisitUnionHall args NIL doc
(* set qty on bandit to max so can rob more)
))]
[DEFCLASS BanditMeta
(MetaClass GameMetaClass Edited: (* mjs: "16-MAR-83 16:19"))
(Supers GameClass)
(ClassVariables)
(InstanceVariables)
(Methods (New BanditMeta.New args NIL doc
(* * method for instantiating a new bandit)
))]
[DEFCLASS Bandit
(MetaClass BanditMeta Edited: (* mjs: "16-MAR-83 15:31"))
(Supers SystemPlayer Consumer)
(ClassVariables (CopyCV (Pr Qty Commodity))
(Commodity Commodity)
(Qty 100)
(Pr 0.0))
(InstanceVariables (pr 0.0)
(qty 100)
(driver Capone)
(direction F doc (* direction in which bandit is moving)))
[Methods (CanBuy Bandit.CanBuy args (commodity pr qty seller)
doc (* checks if bandit can take this commodity)
)
(SelectTruck Bandit.SelectTruck args NIL doc (* Bandits drive a BanditCar
(of course))]]
(* Lisp Fns.)
(RPAQQ TRUCKINPFNS (Bandit.CanBuy Bandit.SelectTruck BanditCar.VisitUnionHall BanditCarMeta.New
BanditMeta.New DemoPeddler.SetUpGauges DemoPlayerMeta.New
FindPlayer GasPlayer.SelectTruck GasPlayerMeta.New
InteractivePlayer.Interact InteractivePlayer.PositionWindow
InteractivePlayer.TakeTurn ListPlayers Player.Buyers
Player.CheckTruck Player.RemovePlayer Player.SelectTruck
Player.SetUpGauges Player.Show Player.TakeTurn PlayerMeta.New
PlayerMeta.TurnOff PlayerMeta.TurnOn REPlayer SystemPlayer.CanBuy
SystemPlayer.CanBuyFuel SystemPlayer.CheckTruck
SystemPlayer.Initialize SystemPlayer.MakeIcon
SystemPlayer.MakeIcons SystemPlayer.SetUpPlayer))
(DEFINEQ
(Bandit.CanBuy
[LAMBDA (self commodity pr qty seller) (* sm: "28-JAN-83 18:46")
(* checks if bandit can take this commodity)
(* Returns self if can buy, else NIL)
(PROG NIL (* check if want to buy this commodity)
(COND
((← commodity InstOf!(%@%@ Commodity)))
(T (RETURN NIL))) (* check qty)
(COND
((GREATERP qty (%@ qty))
(RETURN NIL)))
(←%@
qty
(IDIFFERENCE (%@ qty)
qty))
(RETURN self])
(Bandit.SelectTruck
[LAMBDA (self) (* mjs: "16-MAR-83 15:30")
(* Bandits drive a BanditCar
(of course))
(QUOTE BanditCar])
(BanditCar.VisitUnionHall
[LAMBDA (self) (* sm: "28-JAN-83 19:26")
(* set qty on bandit to max so can rob more)
(PROG ((bandit (%@ driver)))
(←%@
bandit qty (%@%@ bandit Qty))
(WriteGameStatus "UnionHall just gave " (%@ bandit driver)
" new license to rob!!")
(RETURN T])
(BanditCarMeta.New
[LAMBDA (self driver) (* sm: "28-JAN-83 17:36")
(* instantiates BanditCar and puts in driver instance if
specified)
(PROG (new)
(SETQ new (←Super
self New))
(PutValue new (QUOTE driver)
driver)
(RETURN new])
(BanditMeta.New
[LAMBDA (self banditIndex) (* mjs: "21-MAR-83 16:34")
(* method for instantiating a new bandit)
(PROG (newPlayer driver)
(* * Get the player Object.)
(COND
((NULL banditIndex)
(SETQ banditIndex 1)))
(SETQ newPlayer (←Super
self New)) (* give bandit a name)
[SETQ driver (CAR (NTH banditNames (COND
((GREATERP banditIndex (FLENGTH banditNames))
1)
(T banditIndex]
(SETQ newPlayer (← newPlayer SetUpPlayer driver))
(RETURN newPlayer])
(DemoPeddler.SetUpGauges
[LAMBDA (self) (* dgb: "23-JUN-83 19:02")
(* Put gauges on DemoPeddler)
(PROG (gauge limit truck)
(SETQ gauge (← ($ Dial)
New))
(SETQ truck (@ truck))
(SETQ limit (GetValue truck (QUOTE fuel)
(QUOTE GaugeLimit)))
(PutValue gauge (QUOTE title)
(CONCAT (@ driver)
"'s fuel"))
(← gauge SetScale (CAR limit)
(CADR limit))
(← gauge Attach truck (QUOTE fuel)
NIL NIL NIL NIL gaugeX gaugeY])
(DemoPlayerMeta.New
[LAMBDA (self driver truck) (* dgb: "23-JUN-83 18:35")
(* method for defining a new demo player)
(* Should be used to only create players for Demo from
DemoPlayers)
(PROG (newPlayer) (* check if in DemoMode)
(COND
((NOT DemoPlayerMode)
(printout T "Not in demo mode. Do not instantiate DemoPlayer" T)
(RETURN NIL)))
(* * Get the player Object.)
(SETQ newPlayer (DoMethod self (QUOTE New)
($ GameClass)))
(← newPlayer SetUpPlayer driver truck)
(← newPlayer SetUpGauges)
(RETURN newPlayer])
(FindPlayer
[LAMBDA (playerName) (* dgb: " 1-FEB-83 11:00")
(for player in (%@ gameMaster players) do (COND
((EQ playerName (%@ player driver))
(RETURN player])
(GasPlayer.SelectTruck
[LAMBDA (self) (* mjs: "16-MAR-83 08:47")
(* Selects GasTruck for GasPlayer)
(QUOTE GasTruck])
(GasPlayerMeta.New
[LAMBDA (self driver) (* mjs: "16-MAR-83 18:31")
(* instantiate a GasPlayer)
(PROG (newPlayer)
(SETQ newPlayer (←Super
self New))
(← newPlayer SetUpPlayer (QUOTE Gas))
(RETURN newPlayer])
(InteractivePlayer.Interact
[LAMBDA (self) (* sm: "12-JUN-83 14:06")
(* * Pops up the appropriate Windows, menus, and number pads for interactive play.)
(PROG (action x y miles qty commodity commodityItems rs truck)
(SETQ x (@ x))
(SETQ y (@ y))
AskAction
(* * Get the action and carry it out.)
(TOTOPW (@ window))
[SETQ action (MENU interactiveGameMenu (create POSITION
XCOORD ←(IPLUS x 5)
YCOORD ←(IPLUS y 10]
(SELECTQ action
(Buy [SETQ qty (RNUMBER "Quantity to Buy" (create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
(← gameMaster Buy qty))
(Sell (SETQ truck (@ truck))
(SETQ commodityItems (for com in (@ truck cargo) collect
(LIST (ClassName com)
com)))
[SETQ commodity
(MENU (create MENU
ITEMS ← commodityItems
TITLE ← "Cargo"
MENUFONT ← gameStatusBoldFont)
(create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
[SETQ qty (RNUMBER (CONCAT "Quantity (Max " (@ commodity qty)
")")
(create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
(← gameMaster Sell commodity qty)
NIL)
(Move [SETQ miles (RNUMBER (CONCAT "Miles up to " maxMove)
(create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
(← gameMaster Move miles))
(Show (← self Show))
(ShowRS [SETQ rs (RNUMBER (CONCAT "Relative Miles")
(create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
(SETQ rs (PLUS (@(@(@ truck)
location)
milePost)
rs))
[COND
((OR (LESSP rs 1)
(GREATERP rs 78))
(SETQ rs (@(@(@ truck)
location)
milePost]
(← (CAR (NTH (@ gameMaster roadStops)
rs))
Show))
(ShowAll (for player in (@ gameMaster players) do (← player Show)))
(UE (printout PPDefault "Type OK to return to Interactive Player." T)
(TruckinUE))
(Done (CLOSEW (@ window))
(RETURN))
NIL)
(* * Loop back and ask again.)
(GO AskAction])
(InteractivePlayer.PositionWindow
[LAMBDA (self) (* mjs: "26-JAN-83 18:51")
(* * Locates the interaction window on the gameBoard in a location distant from the current position of the
player.)
(PROG (x y truck roadStop (lowX 50)
(xWindow (CONSTANT (IDIFFERENCE SCREENWIDTH 275)))
(lowYWindow 10)
(hiYWindow (CONSTANT (IDIFFERENCE SCREENHEIGHT 350)))
(hiYPlayer 300))
(* * Compute coordinates not too near the player.)
(SETQ truck (%@ truck))
(SETQ roadStop (%@ truck location))
(SETQ x xWindow)
(SETQ y (COND
((GREATERP (%@ roadStop y)
hiYPlayer)
lowYWindow)
(T hiYWindow)))
(* * Position the window.)
(←%@
x x)
(←%@
y y)
(MOVEW (%@ window)
x y])
(InteractivePlayer.TakeTurn
[LAMBDA (self) (* sm: "10-FEB-83 09:34")
(* * Sets up the windows and menus for an Interactive TRUCKIN Player.)
(* * Create the interaction window if necessary.)
[COND
((NOT (WINDOWP (%@ window)))
(←%@
window
(CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 250
HEIGHT ← 200)
(CONCAT (%@ driver)
"'s Turn")))
(CLOSEW (%@ window]
(* * Create an interaction menu if necessary.)
[COND
((NULL interactiveGameMenu)
(SETQ interactiveGameMenu (create MENU
ITEMS ←(QUOTE (Buy Sell Move Show ShowRS ShowAll UE Done))
MENUFONT ← gameStatusBoldFont
TITLE ← "Action"]
(* * Position the window.)
(← self PositionWindow)
(WriteGameStatus (%@ driver)
" can Move upto " maxMove)
(* * Carry out the interactions.)
(← self Interact])
(ListPlayers
[LAMBDA NIL (* dgb: " 1-FEB-83 12:38")
(for player in (%@ gameMaster players) collect (%@ player driver])
(Player.Buyers
[LAMBDA (self commodityClass numMoves includeCDFlg) (* sm: "19-MAY-83 16:53")
(* Returns all of the Buyers wishing to purchase the Commodity. If numMoves is provided, it returns only those
within that distance. A common case is to use maxMove for numMoves. If includeCDFlg is T includes CityDumps also.)
(PROG (currentPos startPos stopPos rs roadStops commodity (allRoadStops (%@ gameMaster roadStops))
)
[COND
((NULL (GetObjectRec commodityClass)) (* default to all Commodities.)
(printout T "Commodity class in BUYERS is NIL. Assuming $Commodity" T)
(SETQ commodityClass (%$ Commodity)))
((type? instance commodityClass)
(SETQ commodityClass (Class commodityClass)))
(T (SETQ commodityClass (GetObjectRec commodityClass]
[COND
((NULL numMoves)
(SETQ numMoves (FLENGTH allRoadStops]
(* * Compute search range.)
(SETQ currentPos (%@(%@(%@ currentPlayer truck)
location)
milePost))
(SETQ startPos (MAX 1 (IDIFFERENCE currentPos numMoves)))
(SETQ stopPos (MIN (FLENGTH allRoadStops)
(IPLUS currentPos numMoves)))
(SETQ rs (CAR (NTH allRoadStops startPos)))
(* * Make a list of the relevant Consumers.)
(for pos from startPos to stopPos
do (COND
((AND (← rs InstOf!(QUOTE Consumer))
[OR includeCDFlg (NOT (← rs InstOf!(QUOTE CityDump]
(SETQ commodity (%@%@ rs Commodity))
(NOT (ZEROP (%@ rs qty)))
(← commodityClass Subclass commodity))
(push roadStops rs)))
(SETQ rs (%@ rs next)))
(RETURN roadStops])
(Player.CheckTruck
[LAMBDA (self truckClassName) (* mjs: "16-MAR-83 14:33")
(* Check the validity of a Truck for a Player.)
(FMEMB truckClassName (← (%$ Truck)
List!(QUOTE Subs])
(Player.RemovePlayer
[LAMBDA (self) (* sm: " 8-JUN-83 12:25")
(* Sent to player when player removed from game.
Currently dummy)
self])
(Player.SelectTruck
[LAMBDA (self) (* mjs: "16-MAR-83 13:47")
(* ask player what truck he wants)
(INMENU "What kind of truck do you drive? " (LDIFFERENCE (← (%$ Truck)
List!(QUOTE Subs))
(QUOTE (BanditCar BlackMaria GasTruck)))
"Enter the brand of a truck." T])
(Player.SetUpGauges
[LAMBDA (self) (* dgb: " 9-JUN-83 20:24")
(* offer to put gauges)
(PROG (res)
(SETQ res (INMENU "Attach gauges on your truck? " (QUOTE (YES NO DEFAULT))
"Type Y for gauges,D for default gauges, N otherwise"))
[COND
[(EQ (QUOTE YES)
res)
(← (@ truck)
AddGauges
(QUOTE (cashBox fuel volume weight))
NIL
(LIST (@ driver]
((EQ (QUOTE DEFAULT)
res)
(← (@ truck)
AddGauges
(QUOTE (fuel))
T
(LIST (@ driver]
(RETURN self])
(Player.Show
[LAMBDA (self file) (* sm: "25-MAY-83 12:10")
(* Prints a report about the status of the current
player. Used for debugging.)
(OR file (SETQ file PPDefault))
(RESETLST (RESETSAVE FIRSTCOL 16)
(RESETSAVE (DSPFONT))
(PROG (truck)
(SETQ truck (%@ truck))
(printout file T "****************" T)
(printout file T "Player: " .FONT LAMBDAFONT (%@ driver)
.FONT DEFAULTFONT T T)
(printout file 15 "Current/Max" T)
(for pr in (QUOTE ((fuel MaxFuel)
(volume MaxVolume)
(weight MaxWeight)
(cashBox)))
do (printout file (CAR pr)
15
(GetValue truck (CAR pr))
"/"
(COND
((CDR pr)
(GetClassValue truck (CADR pr)))
(T "NA"))
T))
(for pr in (QUOTE ((timeUsed)
(movesMade)))
do (printout file (CAR pr)
15
(GetValue self (CAR pr))
T)) (* more)
(printout file .FONT BOLDFONT T "Cargo" .FONT DEFAULTFONT T)
(printout file 15 "qty" 20 "pr" 25 "status" T)
(for commodity in (%@ truck cargo) do (printout file (ClassName commodity)
15
(%@ commodity qty)
20
(%@ commodity pr)
26
(%@ commodity status)
T])
(Player.TakeTurn
[LAMBDA (self squares) (* mjs: "23-JAN-83 12:15")
(* * Dummy Fn for Player moves. Replaced by Player's RuleSet.)
(PROG (tr cargo)
(printout T "Your Turn" -3 (%@ driver)
T)
(printout T "You can move once upto" -3 squares -3 "locations in either direction" T)
(SETQ tr (%@ truck))
(SETQ cargo (%@ tr cargo))
(UE)
(RETURN self])
(PlayerMeta.New
[LAMBDA (self driver) (* mjs: "21-MAR-83 16:40")
(* * Interactive method for defining a new player. The argument driver is optional.)
(PROG (newPlayer)
(* * Ask user for driver information if not passed as arg.)
AskAgain
(OR driver (SETQ driver (INTTY "Driver: " NIL
"Enter a name (up to 6 chars) to appear as part of the player icon."
T)))
(COND
((GetObjectRec driver)
(printout T "Sorry! " driver
" is already the name of of an object. Select another name"
T)
(SETQ driver NIL)
(GO AskAgain)))
(* * Get the player Object.)
(SETQ newPlayer (←Super
self New))
(← newPlayer SetUpPlayer driver)
(← newPlayer SetUpGauges)
(RETURN newPlayer])
(PlayerMeta.TurnOff
[LAMBDA (self compilerOption) (* sm: "16-JUN-83 19:20")
(* Turns Off the compiler option for every method of
self that is implemented as a RuleSet.)
(for selector bind ruleSet in (← self List (QUOTE Selectors))
when (AND (SETQ ruleSet (GetMethod self selector (QUOTE RuleSet)))
(NOT (EQ ruleSet NotSetValue)))
do (← ($! ruleSet)
Off compilerOption])
(PlayerMeta.TurnOn
[LAMBDA (self compilerOption) (* sm: "16-JUN-83 19:19")
(* Turns on the compiler option for every method of self
that is implemented as a RuleSet.)
(for selector bind ruleSet in (← self List (QUOTE Selectors))
when (AND (SETQ ruleSet (GetMethod self selector (QUOTE RuleSet)))
(NOT (EQ ruleSet NotSetValue)))
do (← ($! ruleSet)
On compilerOption])
(REPlayer
[LAMBDA (name) (* dgb: " 1-FEB-83 12:38")
(PROG (player (playerName name))
(COND
((NULL playerName)
(GO ASK)))
LP [COND
((NULL (SETQ player (FindPlayer playerName)))
(WRITE "Players must be one of: " (ListPlayers)))
(T (RETURN (REObject player]
ASK (COND
((EQ NIL (SETQ playerName (INTTY
"What is the name of the driver
of the truck to be examined? "
NIL "Name of driver of truck" T)))
(WRITE "Returning.")
(RETURN)))
(GO LP])
(SystemPlayer.CanBuy
[LAMBDA (self commod pr qty seller) (* sm: " 6-JUN-83 18:17")
(* CanBuy for player)
(← (%@ truck)
CanBuy commod pr qty seller])
(SystemPlayer.CanBuyFuel
[LAMBDA (self commod pr qty seller) (* sm: " 6-JUN-83 18:17")
(* CanBuyFuel for Player)
(← (%@ truck)
CanBuyFuel commod pr qty seller])
(SystemPlayer.CheckTruck
[LAMBDA (self truckClassName) (* mjs: "16-MAR-83 14:31")
(* No checking for SystemPlayers.)
T])
(SystemPlayer.Initialize
[LAMBDA (self) (* mjs: "16-MAR-83 14:17")
(* sm: "17-FEB-83 13:17")
(* Initializes IVs of player from class)
(for iv in (← self List (QUOTE IVs)) unless (FMEMB iv (%@%@ UnChangedIVs))
do (PutValue self iv (GetClassIV (Class self)
iv])
(SystemPlayer.MakeIcon
[LAMBDA (self reverseFlg) (* mjs: "16-MAR-83 14:18")
(* mjs: "14-JAN-83 14:15")
(* * Creates an icon for the player from the firstName, lastName, and truck icon. Shows truck going backwards if
reverseFlg=T.)
(PROG (icon iconBitMap tempDS xOffset yOffset (driver (%@ driver))
(yMargin (CONSTANT 3)))
(* * Allocate a bitmap for the icon.)
(SETQ icon (BITMAPCREATE (%@%@ Width)
(%@%@ Height)))
(* * Create a temporary display stream using the icon bitmap and write the driver name into it.)
(SETQ tempDS (DSPCREATE))
(DSPFONT driverFont tempDS)
(DSPDESTINATION icon tempDS)
(DSPYPOSITION yMargin tempDS)
(SETQ xOffset (MAX 0 (IQUOTIENT (IDIFFERENCE (%@%@ Width)
(STRINGWIDTH driver driverFont))
2)))
(DSPXPOSITION xOffset tempDS)
(PRIN2 driver tempDS)
(* * Place the truck icon above the text and centered.)
[SETQ yOffset (IPLUS yMargin (FONTPROP driverFont (QUOTE SIZE]
(SETQ xOffset (IQUOTIENT (IDIFFERENCE (%@%@ Width)
iconSide)
2))
(SETQ iconBitMap (EVALV (%@%@(%@ truck)
Icon)))
[COND
(reverseFlg (SETQ iconBitMap (ReflectIcon iconBitMap]
(BITBLT iconBitMap NIL NIL icon xOffset yOffset)
(RETURN icon])
(SystemPlayer.MakeIcons
[LAMBDA (self) (* mjs: "16-MAR-83 14:18")
(* mjs: "14-JAN-83 14:14")
(* * Make icon and the reversed-direction icon for a player.)
(←%@
icon
(← self MakeIcon))
(←%@
reverseIcon
(← self MakeIcon (QUOTE ReverseFlg])
(SystemPlayer.SetUpPlayer
[LAMBDA (self driver ptruck) (* dgb: "23-JUN-83 17:44")
(* * Method for instantiating a player. The argument driver and ptruck is optional.)
(PROG (truckName truck)
(* * Ask user for driver information if not passed as arg.)
(OR driver (SETQ driver (INTTY "Driver: " NIL
"Enter a name (up to 6 chars) to appear as part of the player icon."
T)))
(←@
self driver driver)
(COND
((GetObjectRec driver)
(← (GetObjectRec driver)
Destroy)))
(← self SetName (MKNAME driver))
[SETQ truckName (COND
(ptruck)
(T (← self SelectTruck] (* Check validity of trucks for User players.)
[COND
((NOT (← self CheckTruck truckName))
(printout T truckName " is not a valid truck." T)
(SETQ truckName (INMENU "Type of truck:" (← ($ Truck)
List!(QUOTE Subs]
(* * Link the truck and the player together.)
(SETQ truck (← (GetClassRec truckName)
New))
(←@
self truck truck)
(←@
truck driver self)
(* * Compute the player icons.)
(← self MakeIcons)
(RETURN self])
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (18116 39760 (Bandit.CanBuy 18126 . 18840) (Bandit.SelectTruck 18842 . 19104) (
BanditCar.VisitUnionHall 19106 . 19541) (BanditCarMeta.New 19543 . 19944) (BanditMeta.New 19946 .
20654) (DemoPeddler.SetUpGauges 20656 . 21281) (DemoPlayerMeta.New 21283 . 22124) (FindPlayer 22126 .
22364) (GasPlayer.SelectTruck 22366 . 22606) (GasPlayerMeta.New 22608 . 22967) (
InteractivePlayer.Interact 22969 . 25297) (InteractivePlayer.PositionWindow 25299 . 26189) (
InteractivePlayer.TakeTurn 26191 . 27188) (ListPlayers 27190 . 27381) (Player.Buyers 27383 . 29103) (
Player.CheckTruck 29105 . 29399) (Player.RemovePlayer 29401 . 29674) (Player.SelectTruck 29676 . 30085
) (Player.SetUpGauges 30087 . 30736) (Player.Show 30738 . 32250) (Player.TakeTurn 32252 . 32735) (
PlayerMeta.New 32737 . 33618) (PlayerMeta.TurnOff 33620 . 34157) (PlayerMeta.TurnOn 34159 . 34692) (
REPlayer 34694 . 35295) (SystemPlayer.CanBuy 35297 . 35554) (SystemPlayer.CanBuyFuel 35556 . 35825) (
SystemPlayer.CheckTruck 35827 . 36055) (SystemPlayer.Initialize 36057 . 36532) (SystemPlayer.MakeIcon
36534 . 38044) (SystemPlayer.MakeIcons 38046 . 38451) (SystemPlayer.SetUpPlayer 38453 . 39758)))))
STOP