(FILECREATED "15-Mar-84 18:40:03" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;53 38947
changes to: (VARS DemoOutline LRMenuItems DemoWindow TLCVARS)
(FNS SetUpDemo SetUpFarmRoad)
previous date: " 9-Mar-84 15:33:07" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;52)
(* Copyright (c) 1983, 1984 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 DemoScreen FlashLoopsIcon NEWFONT SetUpDemo StartTrafficLight StartTruckin
LoopsIcon2)
(CLASSES DemoPeddler)
(* * Functions for traffic light demo)
(FNS DrawLight LightRules MakeLightIcon MakeSensorIcon NotifyLightIcon NotifySensorIcon
SetUpFarmRoad 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))
(METHODS DemoPeddler.NewInstance DemoPeddler.SetUpGauges Sensor.Poke SensorMeta.New
Timer.Start Timer.TL Timer.TS TrafficLightSystem.Run)
(P (PRINTOUT TTY T .FONT DEFAULTFONT "To set up the demo screen for large fonts, type" T " "
.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])
(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) (* dgb: "15-Mar-84 18:09")
(* * Set up the Loops Demo.)
(for W in (OPENWINDOWS) do (CLOSEW W))
[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 (430 . 425]
(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 (430 . 425]
[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 ?))]
(* * 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])
(SetUpFarmRoad
[LAMBDA NIL (* dgb: "15-Mar-84 18:31")
(* * 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))
(for I in (QUOTE (Red Yellow Green Car NoCar TLS)) do (UNMARKASCHANGED I (QUOTE INSTANCES])
(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 566 . 626)
(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 -- Access 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 (CLEARW TTY)
(CPP "Modularity of simulation and monitored process")
(printout TTY T .FONT BOLDFONT
"A vertical scale is one of a collection
of used to gauges to monitor
values of Loops variables."
T T)
(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)
(BKSYSBUF
"(←New $VerticalScale Attach
($ Apple1) 'price)")))
["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 (CLEARW TTY)
(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 (272 305 152 124)))
(SetUpFarmRoad)
(printout TTY .FONT BOLDFONT
"
Use the Traffic Control
menu to control the system."
T .FONT DEFAULTFONT)))
("Truckin Demo" (StartTruckin))))
(RPAQQ DemoWindow {WINDOW}#11,54372)
(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")
("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 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)))
("Exit Rule Exec" "OK
" "Resume operation of Light Rules")
("Stop TLS" (PROGN (DEL.PROCESS (QUOTE TLS))
"")
"Stop process running Light Rules")))
(RPAQQ LargeInspectAppleRegion (645 350 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)
(InstanceVariables (color #(Off NIL NotifyLightIcon) icon #((MakeLightIcon "FarmLight")
FirstFetch NIL)))]
[DEFCLASS HighLight
(MetaClass Class doc
(* * Traffic Light for HighWay.)
Edited: (* mjs: "20-OCT-82 09:33")
)
(Supers TrafficLight)
(InstanceVariables (color #(Off NIL NotifyLightIcon) icon #((MakeLightIcon "Hiway Light")
FirstFetch NIL)))]
[DEFCLASS Sensor
(MetaClass SensorMeta doc
(* * Detects presence of car (s) on FarmRoad)
Edited: (* dgb: "16-MAR-83 12:38")
)
(Supers Object)
(InstanceVariables (cars #(NIL NIL NotifySensorIcon) icon #((MakeSensorIcon "FR Sensor")
FirstFetch NIL) doc
(* T means car present, or NIL)))]
[DEFCLASS SensorMeta
(MetaClass MetaClass doc
(* * MetaClass for Sensor. Provides special New method.)
Edited: (* mjs: "11-OCT-82 18:19")
)
(Supers Class)]
[DEFCLASS Timer
(MetaClass Class doc
(* * Provides interval delays)
Edited: (* mjs: " 7-OCT-82 16:30")
)
(Supers Object)
[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.)
]]
[DEFCLASS TrafficLight
(MetaClass Class doc
(* * To be used in Traffic Simulation)
Edited: (* dgb: "16-MAR-83 12:32")
)
(Supers Object)
(InstanceVariables (color #(Off NIL ColorChange) doc (* color displayed by light: Red, Yellow, or Green)
))]
[DEFCLASS TrafficLightSystem
(MetaClass Class doc
(* * Controller for the Traffic Lights)
Edited: (* dgb: "16-MAR-83 12:34")
)
(Supers Object)
(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)
))]
(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 ((TLS NIL)
(currentSensor NIL)))
(RPAQQ TLS 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])
[METH DemoPeddler NewInstance (driver truck)
(* method for defining a new demo player)]
[METH DemoPeddler SetUpGauges NIL
(* Put gauges on DemoPeddler)]
[METH Sensor Poke NIL
(* Change the state of the sensor.)]
[METH SensorMeta New (assocList)
(* * New method for Sensor. Initializes global variable currentSensor.)]
[METH Timer Start NIL
(* Start the Timer.)]
[METH Timer TL NIL
(* * Check whether TL time has elapsed.)]
[METH Timer TS NIL
(* Determine whether a TS interval has finished.)]
[METH TrafficLightSystem Run NIL
(* RuleSet LightRules is installed as the selector Run of the class TrafficLightSystem)
(method LightRules RuleSet LightRules)]
(DEFINEQ
(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])
(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])
(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])
)
(PRINTOUT TTY T .FONT DEFAULTFONT "To set up the demo screen for large fonts, type" T " " .FONT
BOLDFONT "SetUpDemo(T)" .FONT DEFAULTFONT T T)
(PUTPROPS LOOPSDEMO COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1927 8091 (Always 1937 . 2169) (CPP 2171 . 2452) (DemoScreen 2454 . 3438) (
FlashLoopsIcon 3440 . 4004) (NEWFONT 4006 . 4818) (SetUpDemo 4820 . 6351) (StartTrafficLight 6353 .
6938) (StartTruckin 6940 . 7586) (LoopsIcon2 7588 . 8089)) (8353 17699 (DrawLight 8363 . 8975) (
LightRules 8977 . 13690) (MakeLightIcon 13692 . 14060) (MakeSensorIcon 14062 . 14475) (NotifyLightIcon
14477 . 14983) (NotifySensorIcon 14985 . 15509) (SetUpFarmRoad 15511 . 16877) (DemoPlayers 16879 .
17697)) (35906 38714 (DemoPeddler.NewInstance 35916 . 36461) (DemoPeddler.SetUpGauges 36463 . 37088) (
Sensor.Poke 37090 . 37361) (SensorMeta.New 37363 . 37700) (Timer.Start 37702 . 37933) (Timer.TL 37935
. 38163) (Timer.TS 38165 . 38454) (TrafficLightSystem.Run 38456 . 38712)))))
STOP