(FILECREATED "19-Dec-85 18:26:04" {PHYLUM}<LOOPS>SOURCES>TRUCKIN>TRUCKINP.;2 41917
changes to: (CLASSES PeterBiltTruck)
previous date: "15-Jan-85 10:33:08" {PHYLUM}<LOOPS>SOURCES>TRUCKIN>TRUCKINP.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(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)
(METHODS Bandit.CanBuy Bandit.NewInstance Bandit.SelectTruck BanditCar.VisitUnionHall
BanditCarMeta.New GasPlayer.NewInstance GasPlayer.SelectTruck
InteractivePlayer.Interact InteractivePlayer.PositionWindow
InteractivePlayer.TakeTurn Player.Buyers Player.CheckTruck Player.NewInstance
Player.RemovePlayer Player.SelectTruck Player.SetUpGauges Player.Show
Player.StartGame Player.Summarize Player.TakeTurn PlayerMeta.TurnOff
PlayerMeta.TurnOn RemotePlayer.NewInstance RemotePlayer.Summarize
SystemPlayer.CanBuy SystemPlayer.CanBuyFuel SystemPlayer.CheckTruck
SystemPlayer.Initialize SystemPlayer.MakeIcon SystemPlayer.MakeIcons
SystemPlayer.NewInstance SystemPlayer.SetUpPlayer)))
(* 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 InteractivePlayer Player PlayerMeta RemotePlayer SystemPlayer))
(DEFCLASSES GasPlayer InteractivePlayer Player PlayerMeta RemotePlayer SystemPlayer)
[DEFCLASS GasPlayer
(MetaClass GameClass doc
(* * SystemPlayer used to refresh qty at GasStations.)
Edited: (* sm: "28-JUN-83 14:14")
)
(Supers SystemPlayer)]
[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: " 5-JUL-83 18:47")
)
(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.)))]
[DEFCLASS Player
(MetaClass PlayerMeta doc (* Participant in the Truckin Simulation.)
Edited: (* sm: "16-SEP-83 15:42")
)
(Supers SystemPlayer)
(ClassVariables (Handicap 0 doc (* Free time allowed to compensate for slowness)
))
(InstanceVariables (timeUsed 0 DefaultGauge LCD doc (* total time used so far))
(movesMade 0 DefaultGauge LCD doc (* actual number of moves made.
Used by TimeGameMaster))
(pendingRequest NIL inProcess NIL whenSent 0 doc
(* pending request. inProcess -
is the request already sent to Master for processing.
whenSent -
time when process sent in IDATE form))
(maxMove 0 doc (* maxMove that can be made in current attempt)
)
(processHandle NIL doc (* process handle for the player's UserProcess)
)
(startedAt 0 doc (* CLOCK time when player process was last started)
)
(unchargedTime 0 doc (* time not charged for in a given move)
)
(wakeReason NIL doc (* value to be returned when player process is
resumed))
(staySuspend NIL doc (* set to T when player suspended pending request
completion))
(schCount 0 doc (* number of times player was scheduled)
)
(remoteMachine NIL doc (* name of mc on which running)))]
[DEFCLASS PlayerMeta
(MetaClass GameMetaClass doc (* MetaClass for Player. Provides interactive method
for defining new players.)
Edited: (* mjs: "16-MAR-83 16:19")
)
(Supers GameClass)]
[DEFCLASS RemotePlayer
(MetaClass PlayerMeta Edited: (* sm: "29-JUN-83 12:49")
doc (* Used for players which are running on a separate
machine but simulated on this m/c)
)
(Supers Player)
(ClassVariables (CopyCV)
(UnChangedIVs #((realClass) UnionSuperValue NIL)))
(InstanceVariables (realClass NIL doc (* name of real player class)))]
[DEFCLASS SystemPlayer
(MetaClass GameAbstractClass Edited: (* dgb: "14-JUL-83 18:24"))
(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.)
)
(maxMove 0)
(movesMade 0 doc (* number of MoveMade msgs received for player)
))]
(RPAQQ TRUCKINPVARS (RemotePlayerGaugeFlg (interactiveGameMenu NIL)))
(RPAQQ RemotePlayerGaugeFlg 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))]
[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))]
[DEFCLASS GasTruck
(MetaClass Class doc (* Truck used by Gas Player.)
Edited: (* mjs: "16-MAR-83 14:45")
)
(Supers SystemTruck)
(ClassVariables (Icon GasTruckIcon))]
[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))]
[DEFCLASS PeterBiltTruck
(MetaClass GameClass doc (* PeterBilt is a good heavy long distance mover, with
an efficient engine. But he is slow.)
Edited: (* smL "19-Dec-85 18:10")
)
(Supers Truck)
(ClassVariables (Icon PeterBiltTruckIcon)
(Gpm 4)
(MaxDist 15)
(MaxWeight 5000)
(MaxVolume 5000)
(MaxFuel 320))]
(* Bandit Classes)
(RPAQQ BANDITCLASSES (BanditCarMeta BanditCar Bandit))
(DEFCLASSES BanditCarMeta BanditCar Bandit)
[DEFCLASS BanditCarMeta
(MetaClass GameMetaClass Edited: (* sm: "26-JAN-83 16:38"))
(Supers GameClass)]
[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))]
[DEFCLASS Bandit
(MetaClass GameClass Edited: (* sm: "28-JUN-83 14:07"))
(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)
))]
(* Lisp Fns.)
(RPAQQ TRUCKINPFNS (FindPlayer ListPlayers REPlayer))
(DEFINEQ
(FindPlayer
[LAMBDA (playerName) (* dgb: " 1-FEB-83 11:00")
(for player in (@ gameMaster players) do (COND
((EQ playerName (@ player driver))
(RETURN player])
(ListPlayers
[LAMBDA NIL (* dgb: " 1-FEB-83 12:38")
(for player in (@ gameMaster players) collect (@ player driver])
(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])
)
[METH Bandit CanBuy (commodity pr qty seller)
(* checks if bandit can take this commodity)]
[METH Bandit NewInstance (banditIndex)
(* method for instantiating a new bandit)]
[METH Bandit SelectTruck NIL
(* Bandits drive a BanditCar (of course))]
[METH BanditCar VisitUnionHall NIL
(* set qty on bandit to max so can rob more)]
[METH BanditCarMeta New (driver)
(* instantiates BanditCar and puts in driver name if specified)]
[METH GasPlayer NewInstance (driver)
(* do the needful for new GasPlayer)]
[METH GasPlayer SelectTruck NIL
(* Selects GasTruck for GasPlayer)]
[METH InteractivePlayer Interact NIL
(* * Pops up the appropriate Windows, menus, and number pads for interactive play.)]
[METH InteractivePlayer PositionWindow NIL
(* * Locates the interaction window on the gameBoard in a location distant from the current
position of the player.)]
[METH InteractivePlayer TakeTurn NIL
(* * Sets up the windows and menus for an Interactive TRUCKIN Player.)]
[METH Player Buyers (commodityClass numMoves includeCDFlg)
(* 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.)]
[METH Player CheckTruck NIL
(* Check the validity of a Truck for a Player.)]
[METH Player NewInstance (driver truck type)
(* Interactive method for defining a new player. The arguments driver and truck are optional.)]
[METH Player RemovePlayer NIL
(* Sent to player when player removed from game. Currently dummy)]
[METH Player SelectTruck NIL
(* ask player what truck he wants)]
[METH Player SetUpGauges NIL
(* offer to put gauges)]
[METH Player Show (file)
(* Prints a report about the status of the current player. Used for debugging.)]
[METH Player StartGame NIL
(* Continuously runs player - blocking periodically)]
[METH Player Summarize (file)
(* Prints a report about the status of the current player. Used for debugging.)]
[METH Player TakeTurn (squares)
(* * Dummy Fn for Player moves. Replaced by Player's RuleSet.)]
[METH PlayerMeta TurnOff (compilerOption)
(* Turns Off the compiler option for every method of self that is implemented as a RuleSet.)]
[METH PlayerMeta TurnOn (compilerOption)
(* Turns on the compiler option for every method of self that is implemented as a RuleSet.)]
[METH RemotePlayer NewInstance (driver truck type)
(* defines a RemotePlayer)]
[METH RemotePlayer Summarize (file)
(* Prints a report about the status of the current player. Used for debugging.)]
[METH SystemPlayer CanBuy (commod pr qty seller)
(* CanBuy for player)]
[METH SystemPlayer CanBuyFuel (commod pr qty seller)
(* CanBuyFuel for Player)]
[METH SystemPlayer CheckTruck (truckClassName)
(* No checking for SystemPlayers.)]
[METH SystemPlayer Initialize NIL
(* Initializes IVs of player from class)]
[METH SystemPlayer MakeIcon (reverseFlg)
(* * Creates an icon for the player from the firstName, lastName, and truck icon. Shows truck
going backwards if reverseFlg=T.)]
[METH SystemPlayer MakeIcons NIL
(* * Make icon and the reversed-direction icon for a player.)]
[METH SystemPlayer NewInstance (name truck type)
(* Inherits general NewInstance method)]
[METH SystemPlayer SetUpPlayer (driver ptruck)
(* * Method for instantiating a player. The argument driver and ptruck is optional.)]
(DEFINEQ
(Bandit.CanBuy
(Method ((Bandit CanBuy)
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.NewInstance
(Method ((Bandit NewInstance)
self banditIndex) (* dgb: "22-SEP-83 15:12")
(* method for instantiating a new bandit)
(* banditIndex -
either banditIndex or name)
(PROG (driver)
(←Super
self NewInstance)
(COND
[(OR (NULL banditIndex)
(NUMBERP banditIndex))
(SETQ banditIndex (OR banditIndex 1))
(SETQ driver (CAR (NTH banditNames (COND
((GREATERP banditIndex (FLENGTH banditNames))
1)
(T banditIndex]
(T (SETQ driver banditIndex))) (* give bandit a name)
(← self SetUpPlayer driver)
(RETURN self))))
(Bandit.SelectTruck
(Method ((Bandit SelectTruck)
self) (* mjs: "16-MAR-83 15:30")
(* Bandits drive a BanditCar
(of course))
(QUOTE BanditCar)))
(BanditCar.VisitUnionHall
(Method ((BanditCar VisitUnionHall)
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
(Method ((BanditCarMeta New)
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))))
(GasPlayer.NewInstance
(Method ((GasPlayer NewInstance)
self driver) (* dgb: "22-SEP-83 15:08")
(* do the needful for new GasPlayer)
(PROG NIL
(←Super
self NewInstance)
(← self SetUpPlayer (QUOTE Gas))
(RETURN self))))
(GasPlayer.SelectTruck
(Method ((GasPlayer SelectTruck)
self) (* mjs: "16-MAR-83 08:47")
(* Selects GasTruck for GasPlayer)
(QUOTE GasTruck)))
(InteractivePlayer.Interact
(Method ((InteractivePlayer Interact)
self) (* edited: " 2-AUG-83 14:09")
(* * 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]
(← PlayerInterface Buy self 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]
(← PlayerInterface Sell self commodity qty)
NIL)
(Move [SETQ miles (RNUMBER (CONCAT "Locations up to: " (@ maxMove))
(create POSITION
XCOORD ←(IPLUS x 40)
YCOORD ←(IPLUS y 10]
(← PlayerInterface Move self miles))
(Show (← self Show))
(ShowRS [SETQ rs (RNUMBER (CONCAT "Relative distance")
(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 (@ PlayerInterface roadStops)
rs))
Show))
(ShowAll (for player in (@ Simulator players) do (← player Show)))
(UE (printout PPDefault "Type OK to return to Interactive Player." T)
(EVAL.IN.TTY.PROCESS (TruckinUE)
T))
(Done (CLOSEW (@ window))
(RETURN))
NIL)
(* * Loop back and ask again.)
(GO AskAction))))
(InteractivePlayer.PositionWindow
(Method ((InteractivePlayer PositionWindow)
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
(Method ((InteractivePlayer TakeTurn)
self) (* sm: " 5-JUL-83 18:48")
(* * 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)))
(Player.Buyers
(Method ((Player Buyers)
self commodityClass numMoves includeCDFlg) (* sm: " 5-JUL-83 17:37")
(* 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 (@ Simulator
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 (@(@(@ 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
[Method ((Player CheckTruck)
self truckClassName) (* mjs: "16-MAR-83 14:33")
(* Check the validity of a Truck for a Player.)
(FMEMB truckClassName (← ($ Truck)
List!(QUOTE Subs])
(Player.NewInstance
(Method ((Player NewInstance)
self driver truck type) (* dgb: "22-SEP-83 15:09")
(* Interactive method for defining a new player.
The arguments driver and truck are optional.)
(PROG NIL
(←Super
self NewInstance)
(* * Ask user for driver information if not passed as arg.)
AskAgain
(OR driver (SETQ driver (EVAL.IN.TTY.PROCESS (QUOTE (INTTY "Driver: " NIL
"Enter a name (up to 6 chars) to appear as part of the player icon."
T))
T)))
(COND
([AND (GetObjectRec driver)
(NOT (← (GetObjectRec driver)
InstOf!(QUOTE Player]
(printout TTY "Sorry! " driver
" is already the name of of an object. Select another name"
T)
(SETQ driver NIL)
(GO AskAgain)))
(* * Get the player Object.)
(← self SetUpPlayer driver truck)
(← self SetUpGauges)
(RETURN self))))
(Player.RemovePlayer
(Method ((Player RemovePlayer)
self) (* sm: " 8-JUN-83 12:25")
(* Sent to player when player removed from game.
Currently dummy)
self))
(Player.SelectTruck
(Method ((Player SelectTruck)
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
(Method ((Player SetUpGauges)
self) (* sm: "12-JUL-83 17:13")
(* offer to put gauges)
(PROG (res)
(SETQ res (INMENU (CONCAT "Attach gauges on your truck, " (@ driver)
"?")
(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
[Method ((Player Show)
self file) (* sm: " 5-AUG-83 10:53")
(* Prints a report about the status of the current
player. Used for debugging.)
(OR file (SETQ file PPDefault))
(RESETLST (RESETSAVE FIRSTCOL 16)
(RESETSAVE ([LAMBDA (X)
(DSPFONT X file]
NIL))
(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.StartGame
(Method ((Player StartGame)
self) (* sm: " 8-AUG-83 16:49")
(* Continuously runs player -
blocking periodically)
(PROG (endTime (currentPlayer self))
(until (@ Communicator gameStarted) do (BLOCK))
[SETQ endTime (SETUPTIMER.DATE (GDATE (@ Simulator endTime]
(COND
((NOT (EQ self (@ PlayerInterface runningPlayer)))
(* not running player. suspend)
(← PlayerInterface SuspendPlayer self)))
(until (TIMEREXPIRED? endTime (QUOTE SECONDS))
do (ERSETQ (← self TakeTurn))
(← PlayerInterface SuspendPlayer self))
(RETURN T))))
(Player.Summarize
[Method ((Player Summarize)
self file) (* sm: " 5-AUG-83 10:53")
(* Prints a report about the status of the current
player. Used for debugging.)
(OR file (SETQ file PPDefault))
(RESETLST (RESETSAVE FIRSTCOL 16)
(RESETSAVE ([LAMBDA (X)
(DSPFONT X file]
NIL))
(PROG (truck)
(SETQ truck (@ truck))
(printout file T "****************" T)
(printout file (ClassName self)
" " .FONT LAMBDAFONT (@ driver)
.FONT DEFAULTFONT T)
(printout file (QUOTE cashBox)
15
(GetValue truck (QUOTE cashBox))
T)
(for pr in (QUOTE (timeUsed schCount movesMade))
do (printout file pr 15 (GetValue self pr)
T])
(Player.TakeTurn
(Method ((Player TakeTurn)
self squares) (* edited: " 2-AUG-83 14:10")
(* * Dummy Fn for Player moves. Replaced by Player's RuleSet.)
(PROG (tr cargo)
(printout TTY "Your Turn" -3 (@ driver)
T)
(printout TTY "You can move once upto" -3 squares -3 "locations in either direction"
T)
(SETQ tr (@ truck))
(SETQ cargo (@ tr cargo))
(UE)
(RETURN self))))
(PlayerMeta.TurnOff
(Method ((PlayerMeta TurnOff)
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
(Method ((PlayerMeta TurnOn)
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))))
(RemotePlayer.NewInstance
(Method ((RemotePlayer NewInstance)
self driver truck type) (* dgb: "22-SEP-83 15:11")
(* defines a RemotePlayer)
(PROG NIL
(←Super
self NewInstance)
(* * Ask user for driver information if not passed as arg.)
AskAgain
(OR driver (SETQ driver (EVAL.IN.TTY.PROCESS (QUOTE (INTTY "Driver: " NIL
"Enter a name (up to 6 chars) to appear as part of the player icon."
T))
T)))
(COND
([AND (GetObjectRec driver)
(NOT (← (GetObjectRec driver)
InstOf!(QUOTE Player]
(printout TTY "Sorry! " driver
" is already the name of of an object. Select another name"
T)
(SETQ driver NIL)
(GO AskAgain)))
(* * Get the player Object.)
(← self SetUpPlayer driver truck)
(AND RemotePlayerGaugeFlg (← self SetUpGauges))
(←@
realClass type)
(RETURN self))))
(RemotePlayer.Summarize
[Method ((RemotePlayer Summarize)
self file) (* sm: " 5-AUG-83 10:53")
(* Prints a report about the status of the current
player. Used for debugging.)
(OR file (SETQ file PPDefault))
(RESETLST (RESETSAVE FIRSTCOL 16)
(RESETSAVE ([LAMBDA (X)
(DSPFONT X file]
NIL))
(PROG (truck)
(SETQ truck (@ truck))
(printout file T "****************" T)
(printout file (@ realClass)
" " .FONT LAMBDAFONT (@ driver)
" ("
(ClassName self)
" ON "
(@ remoteMachine)
")" .FONT DEFAULTFONT T)
(printout file (QUOTE cashBox)
15
(GetValue truck (QUOTE cashBox))
T)
(for pr in (QUOTE (movesMade)) do (printout file pr 15 (GetValue self pr)
T])
(SystemPlayer.CanBuy
(Method ((SystemPlayer CanBuy)
self commod pr qty seller) (* sm: " 6-JUN-83 18:17")
(* CanBuy for player)
(← (@ truck)
CanBuy commod pr qty seller)))
(SystemPlayer.CanBuyFuel
(Method ((SystemPlayer CanBuyFuel)
self commod pr qty seller) (* sm: " 6-JUN-83 18:17")
(* CanBuyFuel for Player)
(← (@ truck)
CanBuyFuel commod pr qty seller)))
(SystemPlayer.CheckTruck
(Method ((SystemPlayer CheckTruck)
self truckClassName) (* mjs: "16-MAR-83 14:31")
(* No checking for SystemPlayers.)
T))
(SystemPlayer.Initialize
[Method ((SystemPlayer Initialize)
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
(Method ((SystemPlayer MakeIcon)
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
[Method ((SystemPlayer MakeIcons)
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.NewInstance
(Method ((SystemPlayer NewInstance)
self name truck type) (* dgb: "22-SEP-83 15:07")
(* Inherits general NewInstance method)
(←Super
self NewInstance)))
(SystemPlayer.SetUpPlayer
(Method ((SystemPlayer SetUpPlayer)
self driver ptruck) (* edited: "15-Jan-85 10:21")
(* * 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 (EVAL.IN.TTY.PROCESS (QUOTE (INTTY "Driver: " NIL
"Enter a name (up to 6 chars) to appear as part of the player icon."
T))
T)))
(←@
self driver driver)
(COND
((GetObjectRec driver)
(← (GetObjectRec driver)
Destroy)))
(← self SetName driver)
[SETQ truckName (COND
(ptruck)
(T (← self SelectTruck] (* Check validity of trucks for User players.)
[COND
((NOT (← self CheckTruck truckName))
(printout TTY 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))))
)
(PUTPROPS TRUCKINP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (11006 12053 (FindPlayer 11016 . 11257) (ListPlayers 11259 . 11448) (REPlayer 11450 .
12051)) (15822 41838 (Bandit.CanBuy 15832 . 16582) (Bandit.NewInstance 16584 . 17478) (
Bandit.SelectTruck 17480 . 17771) (BanditCar.VisitUnionHall 17773 . 18242) (BanditCarMeta.New 18244 .
18686) (GasPlayer.NewInstance 18688 . 19072) (GasPlayer.SelectTruck 19074 . 19346) (
InteractivePlayer.Interact 19348 . 22079) (InteractivePlayer.PositionWindow 22081 . 23048) (
InteractivePlayer.TakeTurn 23050 . 24149) (Player.Buyers 24151 . 26036) (Player.CheckTruck 26038 .
26369) (Player.NewInstance 26371 . 27516) (Player.RemovePlayer 27518 . 27816) (Player.SelectTruck
27818 . 28295) (Player.SetUpGauges 28297 . 29128) (Player.Show 29130 . 30822) (Player.StartGame 30824
. 31711) (Player.Summarize 31713 . 32680) (Player.TakeTurn 32682 . 33211) (PlayerMeta.TurnOff 33213
. 33819) (PlayerMeta.TurnOn 33821 . 34423) (RemotePlayer.NewInstance 34425 . 35562) (
RemotePlayer.Summarize 35564 . 36605) (SystemPlayer.CanBuy 36607 . 36892) (SystemPlayer.CanBuyFuel
36894 . 37195) (SystemPlayer.CheckTruck 37197 . 37454) (SystemPlayer.Initialize 37456 . 37983) (
SystemPlayer.MakeIcon 37985 . 39624) (SystemPlayer.MakeIcons 39626 . 40064) (SystemPlayer.NewInstance
40066 . 40359) (SystemPlayer.SetUpPlayer 40361 . 41836)))))
STOP