(FILECREATED "23-SEP-83 11:00:21" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;49 39244
changes to: (FNS DemoPeddler.NewInstance)
previous date: "23-SEP-83 09:46:29" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;48)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT LOOPSDEMOCOMS)
(RPAQQ LOOPSDEMOCOMS ((* Copyright (c)
1983 by Xerox Corp.)
(* This is the standard LOOPS demo. It is used to demo the different programming paradigms of
Loops and the programming environment. It also includes a demo of the Truckin teaching
game.)
(* Prepared by Bobrow, Mittal, Stefik and Gadol)
(FNS Always CPP DemoPeddler.NewInstance DemoPeddler.SetUpGauges DemoScreen FlashLoopsIcon
NEWFONT SetUpDemo StartTrafficLight StartTruckin LoopsIcon2)
(CLASSES DemoPeddler)
(* * Functions for traffic light demo)
(FNS DrawLight LightRules MakeLightIcon MakeSensorIcon NotifyLightIcon NotifySensorIcon
Sensor.Poke SensorMeta.New SetUpFarmRoad Timer.Start Timer.TL Timer.TS
TrafficLightSystem.Run DemoPlayers)
(VARS BigFontWindows DemoOutline DemoWindow InspectAppleRegion LRMenuItems
LargeInspectAppleRegion LargeLoopsIcon2Region ParcFontWindows SmallInspectAppleRegion
SmallLoopsIcon2Region standAloneFlg (DEMOFLGSETUP))
(CLASSES * TLCCLASSES)
(INSTANCES * TLCINSTANCES)
(VARS * TLCVARS)
(BITMAPS BigAppleIcon BWLoopsIconBM)
(ALISTS (FONTDEFS BIG))
(P (PRINTOUT NIL T .FONT DEFAULTFONT "To start the demo with standard fonts," T " type "
.FONT BOLDFONT "SetUpDemo() " T T .FONT DEFAULTFONT "To get large fonts," T
" type "
.FONT BOLDFONT "SetUpDemo(T)" .FONT DEFAULTFONT T T))))
(* Copyright (c) 1983 by Xerox Corp.)
(* This is the standard LOOPS demo. It is used to demo the different programming paradigms of
Loops and the programming environment. It also includes a demo of the Truckin teaching game.)
(* Prepared by Bobrow, Mittal, Stefik and Gadol)
(DEFINEQ
(Always
[LAMBDA NIL (* SDG "16-MAR-83 10:39")
(* Block for half a second and return T)
(BLOCK 500)
T])
(CPP
[LAMBDA (mess) (* mjs: "10-MAR-83 09:06")
(* Used to centerprint things in the prompt window.)
(CPROMPT)
(CENTERPRINTINREGION mess NIL PROMPTWINDOW])
(DemoPeddler.NewInstance
[LAMBDA (self driver truck) (* dgb: "23-SEP-83 10:54")
(* method for defining a new demo player)
(* Should be used to only create players for Demo from
DemoPlayers)
(COND
((NOT DemoPlayerMode)
(printout T "Not in demo mode. Do not instantiate DemoPeddler" T)
NIL)
(T (←Super
self NewInstance driver truck])
(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])
(DemoScreen
[LAMBDA (bigFont) (* sm: "19-SEP-83 15:42")
(SetUpScreen)
(CLEARW TTY)
(TERPRI TTY)
(DSPFONT (CADR LAMBDAFONT)
PROMPTWINDOW)
(OPENW DemoWindow) (* Create DemoOutline Menu)
(BIGCW [COND
(bigFont (QUOTE (638 . 577)))
(T (QUOTE (616 . 585]
Hand HandShadow) (* Create the big cursor)
(LoopsIcon2 [COND
(bigFont (QUOTE (1 . 218)))
(T (QUOTE (505 . 625]
(COND
(bigFont LargeLoopsIcon2Region)
(T SmallLoopsIcon2Region)))
(SETQ InspectAppleRegion (COND
(bigFont LargeInspectAppleRegion)
(T SmallInspectAppleRegion)))
(BIGCW (QUOTE (695 . 554))
BigArrowIcon BigArrowShadow)
(printout TTY T T T "Ready to start Demo!" T "Use the " .FONT BOLDFONT "Loops Demo Menu" .FONT
DEFAULTFONT " on the right for each step in the demo." T T .FONT DEFAULTFONT T])
(FlashLoopsIcon
[LAMBDA NIL (* dgb: "22-SEP-83 17:11")
(* * Fn to animate the Loops icon and move it around the screen. Used to remind demo giver to talk briefly about
the four paradigms.)
(for i from 1 to 10
do (BITBLT NIL NIL NIL LoopsIconWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS 100)
(BITBLT NIL NIL NIL LoopsIconWindow NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS 100])
(NEWFONT
[LAMBDA (FONTS) (* sm: " 3-AUG-83 14:08")
(* Used to change a set of fonts.)
(FONTSET FONTS)
(DSPFONT (CADR LITTLEFONT)
WindowTitleDisplayStream)
[SETQ MENUFONT (CADR (COND
((EQ FONTS (QUOTE BIG))
LITTLEFONT)
(T FONT2]
[SETQ InspectFont (CADR (COND
((EQ FONTS (QUOTE BIG))
LITTLEFONT)
(T DEFAULTFONT]
(SETQ MaxValueLeftMargin (ITIMES 20 (STRINGWIDTH (QUOTE A)
InspectFont)))
(SETQ WindowMenu (SETQ BackgroundMenu (SETQ IconWindowMenu)))
[MAPC (OPENWINDOWS)
(FUNCTION (LAMBDA (X)
(DSPFONT (CADR DEFAULTFONT)
X)
(SHAPEW X (WINDOWPROP X (QUOTE REGION]
(CADR DEFAULTFONT])
(SetUpDemo
[LAMBDA (bigFontFlg) (* sm: "19-SEP-83 16:54")
(* * Set up the Loops Demo.)
[COND
[bigFontFlg (NEWFONT (QUOTE BIG)) (* Make fonts big in all windows.
Reshape Windows.)
(for X in BigFontWindows do (SET (CAR X)
(CDR X)))
(AND (BOUNDP (QUOTE DemoWindow))
(WINDOWP DemoWindow)
(CLOSEW DemoWindow))
(SETQ DemoWindow (ADDMENU (create MENU
ITEMS ← DemoOutline
TITLE ← "Loops Demo")
NIL
(QUOTE (440 . 376]
(T (NEWFONT (QUOTE PARC))
(for X in ParcFontWindows do (SET (CAR X)
(CDR X)))
(SETQ MENUFONT (CADR FONT2))
(AND (BOUNDP (QUOTE DemoWindow))
(WINDOWP DemoWindow)
(CLOSEW DemoWindow))
(SETQ DemoWindow (ADDMENU (create MENU
ITEMS ← DemoOutline
TITLE ← "Loops Demo")
NIL
(QUOTE (440 . 380]
[OR DEMOFLGSETUP (PROGN (DemoPlayers)
(← ($ MainCommInterface)
New)
(SETQ CommLattice (←New
($ ClassBrowser)
Show
(QUOTE (Commodity CommodityTransportability))
(CREATEW (QUOTE (426 0 560 320))
"Commodity Lattice"]
(* Add price as an IV to Apple and add methods for
SetPrice and Display)
(DemoScreen bigFontFlg)
(SETQ DEMOFLGSETUP T])
(StartTrafficLight
[LAMBDA NIL (* dgb: "22-SEP-83 17:42")
(* (CLEARW TTY) (printout TTY .FONT BOLDFONT
"Use ↑K to change status of Farm Road Sensor.
Use ↑F to get the Rule Exec
To see all the rules
Select LightRules with Middle Button
To stop examining rules, Type ↑X,
and select OK in menu
Use ↑D to stop the Traffic Light simulation." T))
(DEL.PROCESS (QUOTE TLS))
(ADD.PROCESS (QUOTE (← TLS Run))
(QUOTE NAME)
(QUOTE TLS])
(StartTruckin
[LAMBDA NIL (* sm: " 3-AUG-83 15:20")
(* * Demo fn to start the Truckin simulation.)
(for W in (ACTIVEWINDOWS) do (CLOSEW W))
(LoopsIcon)
(HistIcon)
(CLEARW TTY)
(SHAPEW TTY (QUOTE (1 631 424 174)))
(SHAPEW PROMPTWINDOW (QUOTE (1 707 424 100)))
(printout TTY .FONT BOLDFONT
"Truckin is a mini-expert system used for teaching
knowledge representation techniques in LOOPS.
Select existing players, or add new ones.
Then select NO to add no more, and game will begin."
T T)
(← PlayerInterface BeginGame])
(LoopsIcon2
[LAMBDA (position region) (* sm: "19-SEP-83 15:23")
(* * Displays the Loops icon. Window argument is optional.)
(PROG (window)
(BITBLT BWLoopsIconBM NIL NIL [SETQ window (LOGOW NIL (OR position (QUOTE (505 . 625]
62 45 NIL NIL NIL (QUOTE PAINT))
(SHAPEW window (OR region SmallLoopsIcon2Region))
(WINDOWPROP window (QUOTE TITLE)
"A Multi-paradigm Knowledge Programming Environment"])
)
(DEFCLASSES DemoPeddler)
[DEFCLASS DemoPeddler
(MetaClass GameClass Edited: (* dgb: " 8-JUL-83 16:22"))
(Supers Peddler)
(ClassVariables (CopyCV (Icon))
(Icon ?))
(InstanceVariables)
(Methods (SetUpGauges DemoPeddler.SetUpGauges args NIL doc
(* Put gauges on DemoPeddler))
(NewInstance DemoPeddler.NewInstance args (driver truck)
doc (* method for defining a new demo player)
))]
(* * Functions for traffic light demo)
(DEFINEQ
(DrawLight
[LAMBDA (POSorX Y) (* dgb: "27-JUN-83 00:05")
(PROG ((w (CREATEW (QUOTE (0 0 200 100))
"Traffic Light Diagram")))
(DRAWLINE 0 20 200 20 4 NIL w)
(DRAWLINE 0 55 90 55 4 NIL w)
(DRAWLINE 97 58 105 58 1 NIL w)
(DRAWLINE 110 55 200 55 4 NIL w)
(DRAWLINE 90 55 90 100 2 NIL w)
(DRAWLINE 110 55 110 100 2 NIL w)
(DRAWLINE 0 40 90 40 1 NIL w)
(DRAWLINE 110 40 200 40 1 NIL w)
(MOVETO 100 36 w)
(PRIN1 "L" w)
(RETURN (MOVEW w POSorX Y])
(LightRules
[LAMBDA (self)
(PROG (↑auditRecord ↑value ↑triedRule1 ↑triedRule1 ↑triedRule1 ↑triedRule1 ↑triedRule1)
cycleLoop
(COND
((NOT (Always)) (* Quit if while condition is not satisfied.)
(GO QUIT)))
[COND
((NOT ↑triedRule1)
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.245")))
(SETQ ↑triedRule1 T)
(PutAuditRec (GetValue self (QUOTE farmLight))
(QUOTE color)
(QUOTE Red)
↑auditRecord)
(PutAuditRec (GetValue self (QUOTE highLight))
(QUOTE color)
(QUOTE Green)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
[COND
((AND (EQ (GetValue (GetValue self (QUOTE highLight))
(QUOTE color))
(QUOTE Green))
(GetValue (GetValue self (QUOTE farmRoadSensor))
(QUOTE cars))
(← (GetValue self (QUOTE timer))
TL))
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.246")))
(PutAuditRec (GetValue self (QUOTE highLight))
(QUOTE color)
(QUOTE Yellow)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
[COND
((AND (EQ (GetValue (GetValue self (QUOTE highLight))
(QUOTE color))
(QUOTE Yellow))
(← (GetValue self (QUOTE timer))
TS))
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.247")))
(PutAuditRec (GetValue self (QUOTE highLight))
(QUOTE color)
(QUOTE Red)
↑auditRecord)
(PutAuditRec (GetValue self (QUOTE farmLight))
(QUOTE color)
(QUOTE Green)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
[COND
([AND (EQ (GetValue (GetValue self (QUOTE farmLight))
(QUOTE color))
(QUOTE Green))
(NOT (GetValue (GetValue self (QUOTE farmRoadSensor))
(QUOTE cars]
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.248")))
(PutAuditRec (GetValue self (QUOTE farmLight))
(QUOTE color)
(QUOTE Yellow)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
[COND
((AND (EQ (GetValue (GetValue self (QUOTE farmLight))
(QUOTE color))
(QUOTE Green))
(← (GetValue self (QUOTE timer))
TL))
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.249")))
(PutAuditRec (GetValue self (QUOTE farmLight))
(QUOTE color)
(QUOTE Yellow)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
[COND
((AND (EQ (GetValue (GetValue self (QUOTE farmLight))
(QUOTE color))
(QUOTE Yellow))
(← (GetValue self (QUOTE timer))
TS))
(SETQ ↑value (PROGN (PROGN (* Make an audit record for this rule and set its audit
values.)
(SETQ ↑auditRecord (← ($ StandardAuditRecord)
NewTemp))
(PutValue ↑auditRecord (QUOTE rule)
(GetObjFromUID "SVS.0.5349.124.40555.250")))
(PutAuditRec (GetValue self (QUOTE farmLight))
(QUOTE color)
(QUOTE Red)
↑auditRecord)
(PutAuditRec (GetValue self (QUOTE highLight))
(QUOTE color)
(QUOTE Green)
↑auditRecord)
(← (GetValue self (QUOTE timer))
Start]
(GO cycleLoop)
QUIT(RETURN ↑value])
(MakeLightIcon
[LAMBDA (lightName) (* mjs: "11-OCT-82 19:03")
(* * Make a Traffic Light icon for the TLC display.)
(PROG (icon)
(SETQ icon (← (%$ LatticeBrowser)
New))
(←%@
icon title lightName)
(← icon Show (QUOTE (Green Yellow Red)))
(RETURN icon])
(MakeSensorIcon
[LAMBDA (sensorName) (* mjs: "11-OCT-82 18:49")
(* * Make a Sensor icon for the TLC display.)
(PROG (icon)
(SETQ icon (← (%$ LatticeBrowser)
New))
(←%@
icon title sensorName)
(← icon Show (QUOTE (Car NoCar)))
(← icon FlipNode (GetObjectRec (QUOTE NoCar)))
(RETURN icon])
(NotifyLightIcon
[LAMBDA (self varName newValue propName activeVal type) (* mjs: "11-OCT-82 19:24")
(* * This is a putFn for notifying the icon of a sensor of the FarmRoad Light.)
(PROG (icon)
(SETQ icon (%@ self color icon))
[COND
((NEQ (%@ color)
(QUOTE Off))
(← icon FlipNode (GetObjectRec (%@ color]
(← icon FlipNode (GetObjectRec newValue))
(RETURN (PutLocalState activeVal newValue self varName propName type])
(NotifySensorIcon
[LAMBDA (self varName newValue propName activeVal type) (* mjs: "11-OCT-82 18:48")
(* This is a putFn for notifying the icon of a sensor of
the FarmRoad Light.)
(PROG (icon)
(SETQ icon (%@ self cars icon))
(← icon FlipNode (GetObjectRec (QUOTE Car)))
(← icon FlipNode (GetObjectRec (QUOTE NoCar)))
(RETURN (PutLocalState activeVal newValue self varName propName type])
(Sensor.Poke
[LAMBDA (self) (* mjs: "12-OCT-82 13:27")
(* Change the state of the sensor.)
(COND
(self (←%@
cars
(NOT (%@ cars])
(SensorMeta.New
[LAMBDA (self assocList) (* sm: "19-SEP-83 16:39")
(* * New method for Sensor. Initializes global variable currentSensor.)
(SETQ currentSensor (←Super
self New))
(INTERRUPTCHAR 11 (LIST (FUNCTION Sensor.Poke)
currentSensor))
currentSensor])
(SetUpFarmRoad
[LAMBDA NIL (* mjs: "29-JUL-83 19:40")
(* * Set up picture of farmRoad for traffic light system TLS)
(PROG (self pos xpos ypos)
(CLEARW TTY)
(printout TTY .FONT BOLDFONT
"Imagine a traffic light at the intersection of
a main road and a farm road.
This examples illustrates the rules governing
the operation of the traffic light"
T)
(* * Create some dummy objects for use in the displays.)
[COND
((NULL (GetObjectRec (QUOTE Red)))
(for objName in (QUOTE (Red Yellow Green Car NoCar)) do (← ($ TextItem)
New objName]
[SETQ self (SETQ TLS (← ($ TrafficLightSystem)
New
(QUOTE TLS]
(SETQ pos (DrawLight))
(SETQ xpos (fetch XCOORD of pos))
(SETQ ypos (fetch YCOORD of pos))
(MOVEW (@(@(@ farmLight)
color icon)
window)
(IPLUS xpos 65)
(IPLUS ypos 80))
(MOVEW (@(@(@ highLight)
color icon)
window)
(IPLUS xpos -80)
(IPLUS ypos 10))
(MOVEW (@(@(@ farmRoadSensor)
cars icon)
window)
(IPLUS xpos 50)
(IPLUS ypos -80])
(Timer.Start
[LAMBDA (self) (* mjs: " 7-OCT-82 16:24")
(* Start the Timer.)
(←%@
time
(CLOCK 0])
(Timer.TL
[LAMBDA (self) (* SDG "16-MAR-83 10:15")
(* * Check whether TL time has elapsed.)
(GREATERP (DIFFERENCE (CLOCK 0)
(%@ time))
3000])
(Timer.TS
[LAMBDA (self) (* SDG "16-MAR-83 10:14")
(* Determine whether a TS interval has finished.)
(IGREATERP (IDIFFERENCE (CLOCK 0)
(%@ time))
700])
(TrafficLightSystem.Run
[LAMBDA (self) (* RuleSet LightRules is installed as the selector Run
of the class TrafficLightSystem)
(← (GetObjectRec (QUOTE LightRules))
Run self])
(DemoPlayers
[LAMBDA NIL (* sm: " 3-AUG-83 13:59")
(* Creates players for demo)
(PROG NIL
(SETQ gaugeX 852)
(SETQ gaugeY 385)
(SETQ DemoPlayerMode T)
(← ($ DemoPeddler)
New
(QUOTE Danny)
(QUOTE PeterBiltTruck))
(SETQ gaugeY (IDIFFERENCE gaugeY 80))
(← ($ DemoPeddler)
New
(QUOTE Sanjay)
(QUOTE GMCTruck))
(SETQ gaugeY (IDIFFERENCE gaugeY 80))
(← ($ DemoPeddler)
New
(QUOTE Mark)
(QUOTE MacTruck))
(SETQ DemoPlayerMode NIL)
(SETQ ExistingPlayers (LIST ($ Danny)
($ Sanjay)
($ Mark)))
(RETURN ExistingPlayers])
)
(RPAQQ BigFontWindows ((loopsIconPosition 440 . 622)
(histIconPosition 442 . 547)
(ttyPos 0 430 424 265)
(promptPos 7 695 1003 109)))
(RPAQQ DemoOutline ((Loops (PROGN (CPP "LOOPS Demonstration")
(CENTERPRINTINREGION
"
Daniel G. Bobrow, Steve Gadol
Sanjay Mittal, and Mark Stefik"
NIL PROMPTWINDOW)
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT "Loops augments Interlisp-D." T 4
"Loops integrates:"
T T "Procedure-oriented programming, " T
"Object-oriented programming, "
T "Access-oriented programming, and " T
"Rule-oriented programming."
T)
(FlashLoopsIcon)))
("Class Lattice" (PROGN (CPP "Graphs of class inheritance lattices")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"Objects in Loops are instances of classes."
T T "Classes inherit information
from their superclasses." T T
"This inheritance relation forms a lattice
shown in a Browser for classes." T T)
(← CommLattice Open)))
["Class Structure" (PROGN (CLEARW PPDefault)
(CPP "The structure of a class")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"Classes have a number of different parts"
T "displayed by the PrintSummary message." T T
"Or by selecting 'Print' (left button)"
T "for the class node in the browser." T T
"The browser 'Whereis' command shows where"
T "inherited structure and methods come from." T T)
(BKSYSBUF (QUOTE (← $Commodity PrintSummary]
["Creating an Instance" (PROGN (CPP "Instance Structure")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"We create an instance by sending "
T "a New message to its class." T T)
(BKSYSBUF (QUOTE (← $Apple New (QUOTE Apple1]
["Invoking a method" (PROGN (CPP "Invoking a method")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"Many instances can respond to the"
T "mesage to Display themselves." T T)
(BKSYSBUF (QUOTE (← $Apple1 Display]
("Instance Structure" (PROGN (CPP "Structure of an Instance")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"We can inspect the structure of an instance"
T "through an Interlisp-D inspect window." T T
"We can also display the locally defined values."
T T)
(← ($ Apple1)
Inspect InspectAppleRegion)))
["Setting an instance value" (PROGN (CPP "Setting an instance value")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"When we set an instance variable,"
T "we can Redisplay the inspect window to see"
T "the current value." T T)
(BKSYSBUF (QUOTE (←@ $Apple1:price 45]
("Active Values" (PROGN (CPP "Active Values -- Data Oriented Programming")
(CLEARW TTY)
(printout TTY .FONT BOLDFONT
"Active values provide a way of
invoking a procedure when the value
of a variable is read or set.
This can be done without changing
the original code which
accesses the variable."
T .FONT DEFAULTFONT)))
("AVs -- Monitoring" (PROGN (CPP "Modularity of simulation and monitored process")
(CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"A vertical scale is one of a collection"
T
"of gauges used to monitor values of
Loops variables."
T T)
[BKSYSBUF (QUOTE (←New $VerticalScale Attach ($ Apple1)
(QUOTE price]
(printout TTY T .FONT BOLDFONT
"To see the active value that links"
T
"the price of Apple1 to its gauge,
Redisplay the inspect window."
T T)))
["Changing Monitored Variable" (PROGN (CLEARW TTY)
(printout TTY T .FONT BOLDFONT
"Changing a value is monitored no matter
how the change is invoked.
Here we set the variable from within
a method.
The active value enables us to
monitor the changing value
without changing the method code."
T T)
(BKSYSBUF (QUOTE (← $Apple1 SetPrice 90]
["AVs -- Debugging Aid" (PROGN (CPP "Break on access to an instance variable")
(printout TTY T T .FONT BOLDFONT
"Breaking on access to a variable
facilitates debugging of large programs."
T T)
(BKSYSBUF (QUOTE (BreakIt $Apple1 (QUOTE price]
("Traffic Light Example" (PROGN (TMenu LRMenuItems "Traffic Control"
(QUOTE (300 320 120 110)))
(SetUpFarmRoad)
(printout TTY .FONT BOLDFONT
"
Use the Traffic Control
menu to control the system."
T .FONT DEFAULTFONT)))
("Asking why" (PROGN (CLEARW TTY)
(printout TTY .FONT BOLDFONT
"
At any time in the rule Exec
one can ask why an audited variable
has its current value."
T T .FONT DEFAULTFONT)
(BKSYSBUF "why farmLight:color
")))
("Lisp code for a RuleSet" (PROGN (CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"
A Ruleset compiles into Lisp code
which executes efficiently but
is much larger and less clear.
")
(DF LightRules)))
("Truckin Demo" (StartTruckin))))
(RPAQQ DemoWindow {WINDOW}#10,133000)
(RPAQQ InspectAppleRegion (678 429 339 106))
(RPAQQ LRMenuItems (("Start TLS" (PROGN (DEL.PROCESS (QUOTE TLS))
(ADD.PROCESS (QUOTE (← TLS Run))
(QUOTE NAME)
(QUOTE TLS))
"")
"Start a process which runs the light rules")
("Change Sensor" (PROGN (← currentSensor Poke)
"")
"Change FR car sensor")
("Enter Rule Exec" (PROGN (PROCESS.EVAL (QUOTE TLS)
(QUOTE (RE)))
"")
"Suspend LightRules, and enter Rule executive")
("Examine Rules" (PROGN (← ($ LightRules)
ER)
"")
"Examine the rules which run Traffic Light System")
("Exit Rule Editor" (QUOTE %)
"Inform editor that editing is done")
("Exit Rule Exec" "OK
" "Resume operation of Light Rules")
("Stop TLS" (PROGN (DEL.PROCESS (QUOTE TLS))
"")
"Stop process running Light Rules")))
(RPAQQ LargeInspectAppleRegion (645 379 370 165))
(RPAQQ LargeLoopsIcon2Region (1 218 415 180))
(RPAQQ ParcFontWindows ((loopsIconPosition 436 . 742)
(histIconPosition 438 . 675)
(ttyPos 0 430 426 318)
(promptPos 0 748 426 60)))
(RPAQQ SmallInspectAppleRegion (678 429 339 106))
(RPAQQ SmallLoopsIcon2Region (505 625 343 180))
(RPAQQ standAloneFlg NIL)
(RPAQQ DEMOFLGSETUP NIL)
(RPAQQ TLCCLASSES (FarmLight HighLight Sensor SensorMeta Timer TrafficLight TrafficLightSystem))
(DEFCLASSES FarmLight HighLight Sensor SensorMeta Timer TrafficLight TrafficLightSystem)
[DEFCLASS FarmLight
(MetaClass Class doc
(* * Traffic Light for Farm Road.)
Edited: (* dgb: "16-MAR-83 12:37")
)
(Supers TrafficLight)
(ClassVariables)
(InstanceVariables (color #(Off NIL NotifyLightIcon) icon #((MakeLightIcon "FarmLight")
FirstFetch NIL)))
(Methods)]
[DEFCLASS HighLight
(MetaClass Class doc
(* * Traffic Light for HighWay.)
Edited: (* mjs: "20-OCT-82 09:33")
)
(Supers TrafficLight)
(ClassVariables)
(InstanceVariables (color #(Off NIL NotifyLightIcon) icon #((MakeLightIcon "Hiway Light")
FirstFetch NIL)))
(Methods)]
[DEFCLASS Sensor
(MetaClass SensorMeta doc
(* * Detects presence of car (s) on FarmRoad)
Edited: (* dgb: "16-MAR-83 12:38")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (cars #(NIL NIL NotifySensorIcon) icon #((MakeSensorIcon "FR Sensor")
FirstFetch NIL) doc
(* T means car present, or NIL)))
(Methods (Poke Sensor.Poke args NIL doc (* Change the state of the sensor.)))]
[DEFCLASS SensorMeta
(MetaClass MetaClass doc
(* * MetaClass for Sensor. Provides special New method.)
Edited: (* mjs: "11-OCT-82 18:19")
)
(Supers Class)
(ClassVariables)
(InstanceVariables)
(Methods (New SensorMeta.New args (assocList)
doc
(* * New method for Sensor. Initializes global variable currentSensor.)
))]
[DEFCLASS Timer
(MetaClass Class doc
(* * Provides interval delays)
Edited: (* mjs: " 7-OCT-82 16:30")
)
(Supers Object)
(ClassVariables)
[InstanceVariables (time 0 doc (* time of day at last check))
(Methods (Start Timer.Start args NIL doc
(* Start the Timer.))
(TL Timer.TL args NIL doc (* Check whether TL time has elapsed.))
(TS Timer.TS args NIL doc (* Determine whether a TS interval has finished.)
]
(Methods (Start Timer.Start args NIL doc (* Start the Timer.))
(TL Timer.TL args NIL doc
(* * Check whether TL time has elapsed.)
)
(TS Timer.TS args NIL doc (* Determine whether a TS interval has finished.)
))]
[DEFCLASS TrafficLight
(MetaClass Class doc
(* * To be used in Traffic Simulation)
Edited: (* dgb: "16-MAR-83 12:32")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (color #(Off NIL ColorChange) doc (* color displayed by light: Red, Yellow, or Green)
))
(Methods)]
[DEFCLASS TrafficLightSystem
(MetaClass Class doc
(* * Controller for the Traffic Lights)
Edited: (* dgb: "16-MAR-83 12:34")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (farmLight #((← ($ FarmLight)
New)
AtCreation NIL) doc (* The traffic light on the farm road))
(highLight #((← ($ HighLight)
New)
AtCreation NIL) doc (* The traffic light on the highway))
(farmRoadSensor #((← ($ Sensor)
New)
AtCreation NIL) doc
(* Senses presence of car (s) on the farm road)
)
(timer #((← ($ Timer)
New)
AtCreation NIL) doc (* Provides time delays for traffic control)
))
(Methods (Run LightRules RuleSet LightRules doc (* RuleSet LightRules is installed as the selector Run
of the class TrafficLightSystem)))]
(RPAQQ TLCINSTANCES (LightRules))
(DEFINST RuleSet (LightRules "OGR@@u")
(perspectiveNode #&(RuleSetNode "OGR@@u"))
(name #(LightRules NIL RememberName))
(compiledRules LightRules)
(workSpace TrafficLightSystem)
(args NIL)
(tempVars NIL)
(taskVars NIL)
(debugVars NIL)
(numRules 6)
(controlStructure WHILEALL)
(whileCondition (%( Always %)))
(compilerOptions (A))
(auditClass NIL)
(metaAssignments NIL)
(ruleClass NIL)
(taskClass)
(arguments)
(ruleVars NIL)
(lispVars)
(classVars NIL))
(DEFINST RuleSetNode ("OGR@@u")
(perspectives ? RuleSet #&(RuleSet "OGR@@u") Source #&(RuleSetSource "OGR@@u")))
(DEFINST RuleSetSource ("OGR@@u")
(indexedVars ((#&(Rule "SVS.0.5349.124.40555.245"))
(#&(Rule "SVS.0.5349.124.40555.246"))
(#&(Rule "SVS.0.5349.124.40555.247"))
(#&(Rule "SVS.0.5349.124.40555.248"))
(#&(Rule "SVS.0.5349.124.40555.249"))
(#&(Rule "SVS.0.5349.124.40555.250"))))
(perspectiveNode #&(RuleSetNode "OGR@@u"))
(created " 7-OCT-82 15:28:09")
(creator STEFIK)
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(sourceRules
"RuleSet Name: LightRules;
WorkSpace Class: TrafficLightSystem;
Control Structure: whileAll; (* One of do1 doAll doNext while1 whileAll whileNext)
While Condition: T ;
Audit Class: StandardAuditRecord;
Audit Specification: (rule←↑ruleObject);
Rule Vars: ;
Task Vars: ;
Lisp Vars: ;
Class Vars: ;
Debug Vars: farmLight:color ;
Compiler Options: T ; (* T (Trace) B (Break) A (Audit) S (Task Stepping))
(* Rules for controlling a TrafficLightSystem.)
{1} THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;
IF highLight:color = 'Green farmRoadSensor:cars timer.TL
THEN highLight:color ← 'Yellow timer.Start;
IF highLight:color = 'Yellow timer.TS
THEN highLight:color ← 'Red farmLight:color←'Green timer.Start;
IF farmLight:color = 'Green ~farmRoadSensor:cars
THEN farmLight:color ← 'Yellow timer.Start;
IF farmLight:color = 'Green timer.TL
THEN farmLight:color ← 'Yellow timer.Start;
IF farmLight:color = 'Yellow timer.TS
THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;")
(ruleObjects)
(Methods))
(DEFINST Rule ("SVS.0.5349.124.40555.245")
(source
"(* Rules for controlling a TrafficLightSystem.)
{1} THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 1)
(ruleSet #&(RuleSet "OGR@@u")))
(DEFINST Rule ("SVS.0.5349.124.40555.246")
(source
" IF highLight:color = 'Green farmRoadSensor:cars timer.TL
THEN highLight:color ← 'Yellow timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 2)
(ruleSet #&(RuleSet "OGR@@u")))
(DEFINST Rule ("SVS.0.5349.124.40555.247")
(source
" IF highLight:color = 'Yellow timer.TS
THEN highLight:color ← 'Red farmLight:color←'Green timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 3)
(ruleSet #&(RuleSet "OGR@@u")))
(DEFINST Rule ("SVS.0.5349.124.40555.248")
(source
" IF farmLight:color = 'Green ~farmRoadSensor:cars
THEN farmLight:color ← 'Yellow timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 4)
(ruleSet #&(RuleSet "OGR@@u")))
(DEFINST Rule ("SVS.0.5349.124.40555.249")
(source
" IF farmLight:color = 'Green timer.TL
THEN farmLight:color ← 'Yellow timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 5)
(ruleSet #&(RuleSet "OGR@@u")))
(DEFINST Rule ("SVS.0.5349.124.40555.250")
(source
" IF farmLight:color = 'Yellow timer.TS
THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;")
(edited "22-SEP-83 18:27:44")
(editor BOBROW)
(ruleNumber 6)
(ruleSet #&(RuleSet "OGR@@u")))
(RPAQQ TLCVARS ((currentSensor NIL)))
(RPAQQ currentSensor NIL)
(RPAQ BigAppleIcon (READBITMAP))
(64 64
"HHHHHHHHHHHHHHHH"
"BBBBBBBBBBBBBBBB"
"BBBBBBBBBBBBBBBB"
"HHHHHHHHHHHHHHHH"
"HHHHHHHHHHHHHHHH"
"BBBBBBBBBBBBBBBB"
"BBBBBBBBBBBBBBBB"
"HHHHHHHHKOHHHHHH"
"HHHHHHHHOOHHHHHH"
"BBBBBBBBOLBBBBBB"
"BBBBBBBCOLBBBBBB"
"HHHHHHHIOHHHHHHH"
"HHHHHHHKLHHHHHHH"
"BBBBBBBGJBBBBBBB"
"BBBBBBBGJBCJBBBB"
"HHHIOOLGHIOONHHH"
"HHHKONNGHOHOKHHH"
"BBBGOOOOCNBBCNBB"
"BBHOJOOOKJBBBOJB"
"HJCH@@KONHHHHKLH"
"HHOHH@HOLHHHHHNH"
"BANBBBBGJBBBBBFB"
"BGLBBBBBBBB@BBGB"
"HOHHHHHHHHHH@HIH"
"HN@HHHHHHHH@@HIL"
"CHBBBBBBBB@@@BBN"
"C@BBBBBBBB@@@@BN"
"KHHHHHHHHH@@@@HF"
"OHHHHHHHHH@@@@HD"
"GBBBBBBBBB@D@@BF"
"FBBBBBBBBB@@@@BB"
"F@HHHHHHHHAA@@@J"
"F@HHHHHHHHIA@@@J"
"GBBBBBBBBB@D@@BB"
"GBBBBBBBBB@D@@BB"
"G@HHHHHHHHIA@@HF"
"K@HHHHHHHHIA@@HD"
"KBBBBBBBBBB@@@BF"
"NBBBBBBBBBB@@@BF"
"F@HHHHHHHHHH@@HF"
"B@HHHHHHHHHHH@HL"
"NBBBBBBBBBBBB@@F"
"FBBBBBBBBBBBBBBF"
"B@HHHHHHHHHHHH@L"
"J@HHHHHHHHHHH@DL"
"CBBBBBBBBBBBB@HF"
"ABBBBBBBBBBB@@BF"
"IHHHHHHHHHHHHHHL"
"IHHHHHHHHHHHH@@H"
"BNBBBBBBBBBB@@CJ"
"BNBBBBBBBBBB@@CB"
"HOHHHHHHHHHH@@KH"
"HMHHHHHHHHHHH@NH"
"BFN@BB@BBB@@@ANB"
"BCCHB@@BBB@B@CJB"
"HINL@L@HHHL@@CHH"
"HHKI@@BHHH@@INHH"
"BBCOB@@GONB@CNBB"
"BBBCNB@CNBB@CBBB"
"HHHHOHHNNHHINHHH"
"HHHHHOKLKMOO@HHH"
"BBBBBCNBBGIHBBBB"
"BBBBBBBBBB@BBBBB"
"HHHHHHHHHHHHHHHH")
(RPAQ BWLoopsIconBM (READBITMAP))
(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@OOH@@@@@@"
"@@@@@@O@@GH@@@@@"
"@@@@@C@@@@F@@@@@"
"@@@@@D@@@@A@@@@@"
"@@@@AH@OOH@L@@@@"
"@@@@F@OOOO@B@@@@"
"@@@@HGOOOOLA@@@@"
"@@@A@HOMOOO@H@@@"
"@@@BAKGMILGHD@@@"
"@@@DGKEEFKONB@@@"
"@@@DCHME@LOOA@@@"
"@@@IIJEEGOGOI@@@"
"@@ACMKDEHHOOLH@@"
"@@BCLOOOOOOOLF@@"
"@@BGNGOOOLGOHB@@"
"@@DOOCOOOKKNFC@@"
"@@HOOLL@CGMMOA@@"
"@@IOONAOLONCOIH@"
"@@IOOOKONOOOOHH@"
"@ACCGKKOOCOOOLH@"
"@CBMGOKOOIOCKDL@"
"@OBMAKKFHLNMKDO@"
"COBMEKKEKFNMKDOL"
"GLGCAKKCHNFALNAN"
"OHGOOKCEKGFMDJ@O"
"OBGOOCGFHOCOONDO"
"OFGOIOOOOOKOONFO"
"OBGOIOOOOOOOOJDO"
"OHGOIOANCJGHONAN"
"OLAOIN@LAHCBGNAN"
"GO@AINDLIIACN@GL"
"AOOAINDLIIIHNAO@"
"@OOOINDLIIINGON@"
"@GOOHB@LAHCBGOL@"
"@@AOHCANCHGHON@@"
"@A@AOOOOOIOOH@H@"
"@@I@@AOOOIN@@A@@"
"@@HN@@@@@I@@GI@@"
"@@DOON@@@OAOOB@@"
"@@DGMOOOOOOCNB@@"
"@@BCKOOOOOOKLD@@"
"@@ACCOGKCAOILH@@"
"@@@HGOGJMFOLHH@@"
"@@@DOOGKGFOOA@@@"
"@@@DGOGKKAONB@@@"
"@@@CAOGJMGOHD@@@"
"@@@@HO@KCGO@H@@@"
"@@@@DCOOOOLC@@@@"
"@@@@B@OOOO@D@@@@"
"@@@@AH@OO@AH@@@@"
"@@@@@F@@@@F@@@@@"
"@@@@@AN@@GH@@@@@"
"@@@@@@AOOH@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@")
(ADDTOVAR FONTDEFS [BIG (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(CHANGECHARTABSTR . "")
(FONTPROFILE (DEFAULTFONT 1 (HELVETICA 18))
(BOLDFONT 2 (HELVETICA 18 BRR))
(LITTLEFONT 3 (HELVETICA 12 BRR))
(BIGFONT 4 (HELVETICAD 24 MRR))
(USERFONT BOLDFONT)
(COMMENTFONT LITTLEFONT)
(LAMBDAFONT BIGFONT)
(SYSTEMFONT)
(CLISPFONT BOLDFONT)
(CHANGEFONT)
(PRETTYCOMFONT BOLDFONT)
(FONT1 DEFAULTFONT)
(FONT2 BOLDFONT)
(FONT3 LITTLEFONT)
(FONT4 BIGFONT)
(FONT5 5 (HELVETICA 10 BIR)
(HELVETICA 8 BIR))
(FONT6 6 (HELVETICA 10 BRR)
(TIMESROMAN 8 BRR))
(FONT7 7 (GACHA 10)
(GACHA 8])
(PRINTOUT NIL T .FONT DEFAULTFONT "To start the demo with standard fonts," T " type " .FONT BOLDFONT
"SetUpDemo() "
T T .FONT DEFAULTFONT "To get large fonts," T " type " .FONT BOLDFONT "SetUpDemo(T)" .FONT
DEFAULTFONT T T)
(PUTPROPS LOOPSDEMO COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1955 9237 (Always 1965 . 2197) (CPP 2199 . 2480) (DemoPeddler.NewInstance 2482 . 3027)
(DemoPeddler.SetUpGauges 3029 . 3654) (DemoScreen 3656 . 4640) (FlashLoopsIcon 4642 . 5206) (NEWFONT
5208 . 6020) (SetUpDemo 6022 . 7497) (StartTrafficLight 7499 . 8084) (StartTruckin 8086 . 8732) (
LoopsIcon2 8734 . 9235)) (9836 20692 (DrawLight 9846 . 10458) (LightRules 10460 . 15173) (
MakeLightIcon 15175 . 15543) (MakeSensorIcon 15545 . 15958) (NotifyLightIcon 15960 . 16466) (
NotifySensorIcon 16468 . 16992) (Sensor.Poke 16994 . 17265) (SensorMeta.New 17267 . 17604) (
SetUpFarmRoad 17606 . 18858) (Timer.Start 18860 . 19091) (Timer.TL 19093 . 19321) (Timer.TS 19323 .
19612) (TrafficLightSystem.Run 19614 . 19870) (DemoPlayers 19872 . 20690)))))
STOP