(FILECREATED "14-Jan-85 16:15:06" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;61 40886
changes to: (METHODS DemoPeddler.NewInstance DemoPeddler.SetUpGauges Sensor.Poke
SensorMeta.New Timer.Start Timer.TL Timer.TS)
(FNS DemoPeddler.NewInstance DemoPeddler.SetUpGauges Sensor.Poke SensorMeta.New
Timer.Start Timer.TL Timer.TS)
previous date: " 4-Jan-85 20:22:29" {INDIGO}<LOOPS>DEMO>LOOPSDEMO.;60)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(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)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
BIG)
(FNS Always CPP DemoScreen FlashLoopsIcon 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
(TTYINEDITWINDOW (CREATEW (CREATEREGION 431 262 591 526)
"TTYIN Edit Window"))
(DEMOFLGSETUP))
(CLASSES * TLCCLASSES)
(INSTANCES * TLCINSTANCES)
(VARS * TLCVARS)
(BITMAPS BigAppleIcon BWLoopsIconBM)
(METHODS DemoPeddler.NewInstance DemoPeddler.SetUpGauges Sensor.Poke
SensorMeta.New Timer.Start Timer.TL Timer.TS TrafficLightSystem.Run)
(ALISTS (FONTDEFS BIGLOOPS STANDARDLOOPS))))
(* 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)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
BIG)
(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) (* smL " 2-Jan-85 14:12")
(SetUpScreen)
(CLEARW TTY)
(TERPRI TTY)
(DSPFONT LAMBDAFONT PROMPTWINDOW)
(OPENW DemoWindow) (* Create DemoOutline Menu)
(BIGCW [COND
(bigFont (QUOTE (713 . 638)))
(T (QUOTE (616 . 585]
Hand HandShadow) (* Create the big cursor)
(* Create the Interlisp-Loops combination)
(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])
(FlashLoopsIcon
[LAMBDA NIL (* edited: "21-Apr-84 22:21")
(* * 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 (GetValue (← ($ LoopsIcon)
Prototype)
(QUOTE window))
NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS 100)
(BITBLT NIL NIL NIL (GetValue (← ($ LoopsIcon)
Prototype)
(QUOTE window))
NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS 100])
(SetUpDemo
[LAMBDA (bigFontFlg) (* smL " 2-Jan-85 12:46")
(* * Set up the Loops Demo.)
(for W in (OPENWINDOWS) do (CLOSEW W))
[COND
[bigFontFlg (NEWFONT (QUOTE BIGLOOPS)) (* 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 STANDARDLOOPS))
(for X in ParcFontWindows 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]
[OR DEMOFLGSETUP (PROGN (DemoPlayers)
(← ($ MainCommInterface)
New)
(SETQ CommLattice (←New
($ ClassBrowser)
Show
(QUOTE (Commodity CommodityTransportability))
(CREATEW (QUOTE (426 0 569 406))
"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 (* edited: "21-Apr-84 22:46")
(* * Demo fn to start the Truckin simulation.)
(for W in (ACTIVEWINDOWS) do (CLOSEW W))
(←Proto
($ LoopsIcon)
Open)
(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) (* dgb: "26-Nov-84 15:20")
(* RuleSet LightRules Lisp code)
(PROG (↑auditRecord ↑value ↑triedRule1)
↑firstRules
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 "NZT0.H<N5.←;<.1238")))
(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 "NZT0.H<N5.←;<.1239")))
(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 "NZT0.H<N5.←;<.1240")))
(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 "NZT0.H<N5.←;<.1241")))
(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 "NZT0.H<N5.←;<.1242")))
(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 "NZT0.H<N5.←;<.1243")))
(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
↑lastRules
(RETURN ↑value])
(MakeLightIcon
[LAMBDA (lightName) (* dgb: "11-Sep-84 14:24")
(* * Make a Traffic Light icon for the TLC display.)
(PROG (icon)
(SETQ icon (← ($ LatticeBrowser)
New))
(←@
icon title lightName)
(← icon Browse (QUOTE (Green Yellow Red)))
(RETURN icon])
(MakeSensorIcon
[LAMBDA (sensorName) (* dgb: "11-Sep-84 14:25")
(* * Make a Sensor icon for the TLC display.)
(PROG (icon)
(SETQ icon (← ($ LatticeBrowser)
New))
(←@
icon title sensorName)
(← icon Browse (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 (* smL " 2-Jan-85 14:30")
(* * 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))
(← (@(@ farmLight)
color icon)
Move
(IPLUS xpos 65)
(IPLUS ypos 95))
(← (@(@ highLight)
color icon)
Move
(IPLUS xpos -80)
(IPLUS ypos 10))
(← (@(@ farmRoadSensor)
cars icon)
Move
(IPLUS xpos 65)
(IPLUS ypos -50))
(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 350 . 0)
(histIconPosition 275 . 0)
(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)
(SETQ AppleInspectWindow (← ($ 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 (CLOSEW PPDefault)
(TMenu LRMenuItems "Traffic Control"
(QUOTE (272 300 152 130)))
(SetUpFarmRoad)
(printout TTY .FONT BOLDFONT
"
Use the Traffic Control
menu to control the system."
T .FONT DEFAULTFONT)))
("Truckin Demo" (StartTruckin))))
(RPAQQ DemoWindow {WINDOW}%#15,42702)
(RPAQQ InspectAppleRegion (678 421 339 114))
(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 (ADD.PROCESS (QUOTE (← ($ LightRules)
ER))
(QUOTE NAME)
(QUOTE EditLightRules))
"")
"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 (681 404 342 153))
(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 421 339 114))
(RPAQQ SmallLoopsIcon2Region (505 625 343 180))
(RPAQQ standAloneFlg NIL)
(RPAQ TTYINEDITWINDOW (CREATEW (CREATEREGION 431 262 591 526)
"TTYIN Edit Window"))
(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))
[METH NIL NIL NIL
NIL (method ? methodClass RuleSet UID "OGR@@u")
(perspectiveNode #&(RuleSetNode "OGR@@u"))
(name #(LightRules NIL RememberName))
(compiledRules LightRules)
(workSpace TrafficLightSystem)
(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 "JBU0.C=N5.Z[8.752"))
(#&(Rule "JBU0.C=N5.Z[8.753"))
(#&(Rule "JBU0.C=N5.Z[8.754"))
(#&(Rule "JBU0.C=N5.Z[8.755"))
(#&(Rule "JBU0.C=N5.Z[8.756"))
(#&(Rule "JBU0.C=N5.Z[8.757"))))
(perspectiveNode #&(RuleSetNode "OGR@@u"))
(created " 7-OCT-82 15:28:09")
(creator STEFIK)
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(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;")]
[DEFINST Rule ("JBU0.C=N5.Z[8.752")
(source
"(* Rules for controlling a TrafficLightSystem.)
{1} THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(ruleNumber 1)
(ruleSet #&(RuleSet "OGR@@u"))]
[DEFINST Rule ("JBU0.C=N5.Z[8.753")
(source
" IF highLight:color = 'Green farmRoadSensor:cars timer.TL
THEN highLight:color ← 'Yellow timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(ruleNumber 2)
(ruleSet #&(RuleSet "OGR@@u"))]
[DEFINST Rule ("JBU0.C=N5.Z[8.754")
(source
" IF highLight:color = 'Yellow timer.TS
THEN highLight:color ← 'Red farmLight:color←'Green timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(ruleNumber 3)
(ruleSet #&(RuleSet "OGR@@u"))]
[DEFINST Rule ("JBU0.C=N5.Z[8.755")
(source
" IF farmLight:color = 'Green ~farmRoadSensor:cars
THEN farmLight:color ← 'Yellow timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(ruleNumber 4)
(ruleSet #&(RuleSet "OGR@@u"))]
[DEFINST Rule ("JBU0.C=N5.Z[8.756")
(source
" IF farmLight:color = 'Green timer.TL
THEN farmLight:color ← 'Yellow timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(ruleNumber 5)
(ruleSet #&(RuleSet "OGR@@u"))]
[DEFINST Rule ("JBU0.C=N5.Z[8.757")
(source
" IF farmLight:color = 'Yellow timer.TS
THEN farmLight:color ← 'Red highLight:color ← 'Green timer.Start;")
(edited " 2-Jan-85 13:59:57")
(editor LANNING)
(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@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@")
[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
[Method ((DemoPeddler NewInstance)
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
(Method ((DemoPeddler SetUpGauges)
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
[Method ((Sensor Poke)
self) (* mjs: "12-OCT-82 13:27")
(* Change the state of the sensor.)
(COND
(self (←@
cars
(NOT (@ cars])
(SensorMeta.New
(Method ((SensorMeta New)
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
(Method ((Timer Start)
self) (* mjs: " 7-OCT-82 16:24")
(* Start the Timer.)
(←@
time
(CLOCK 0))))
(Timer.TL
(Method ((Timer TL)
self) (* SDG "16-MAR-83 10:15")
(* * Check whether TL time has elapsed.)
(GREATERP (DIFFERENCE (CLOCK 0)
(@ time))
3000)))
(Timer.TS
(Method ((Timer TS)
self) (* SDG "16-MAR-83 10:14")
(* Determine whether a TS interval has finished.)
(IGREATERP (IDIFFERENCE (CLOCK 0)
(@ time))
700)))
)
(ADDTOVAR FONTDEFS [BIGLOOPS (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (HELVETICA 18)
(GACHA 8))
(BOLDFONT 2 (HELVETICA 18 BRR)
(HELVETICA 8 BRR))
(LITTLEFONT 3 (HELVETICA 12 MRR)
(TIMESROMAN 8 MIR))
(BIGFONT 4 (HELVETICAD 24 MRR)
(TIMESROMAN 10 BRR))
(USERFONT BOLDFONT)
(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))
(COMMENTFONT 8 (HELVETICA 12 ITALIC)
(HELVETICA 10 ITALIC]
[STANDARDLOOPS (FONTCHANGEFLG . ALL)
(FILELINELENGTH . 102)
(COMMENTLINELENGTH 116 . 126)
(LAMBDAFONTLINELENGTH . 95)
(FIRSTCOL . 60)
(PRETTYLCOM . 25)
(FONTPROFILE (DEFAULTFONT 1 (HELVETICA 10)
(GACHA 8))
(BOLDFONT 2 (HELVETICA 12 BRR)
(TIMESROMAN 10 BRR))
(LITTLEFONT 3 (HELVETICA 10 BRR)
(TIMESROMAN 8 BRR))
(BIGFONT 4 (HELVETICA 12 BRR)
(TIMESROMAN 10 BRR))
(USERFONT BOLDFONT)
(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))
(COMMENTFONT 8 (HELVETICA 10 ITALIC)
(HELVETICA 8 ITALIC])
(PUTPROPS LOOPSDEMO COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2288 7880 (Always 2298 . 2530) (CPP 2532 . 2813) (DemoScreen 2815 . 3771) (
FlashLoopsIcon 3773 . 4450) (SetUpDemo 4452 . 6108) (StartTrafficLight 6110 . 6695) (StartTruckin 6697
. 7375) (LoopsIcon2 7377 . 7878)) (8142 18477 (DrawLight 8152 . 8764) (LightRules 8766 . 14356) (
MakeLightIcon 14358 . 14726) (MakeSensorIcon 14728 . 15141) (NotifyLightIcon 15143 . 15649) (
NotifySensorIcon 15651 . 16175) (SetUpFarmRoad 16177 . 17655) (DemoPlayers 17657 . 18475)) (35917
38741 (DemoPeddler.NewInstance 35927 . 36518) (DemoPeddler.SetUpGauges 36520 . 37246) (Sensor.Poke
37248 . 37539) (SensorMeta.New 37541 . 37917) (Timer.Start 37919 . 38170) (Timer.TL 38172 . 38424) (
Timer.TS 38426 . 38739)))))
STOP