(FILECREATED "29-JUL-83 20:11:03" {INDIGO}<LOOPS>DEMO>TTYPATCH.;1 12133
changes to: (VARS TTYPATCHCOMS))
(PRETTYCOMPRINT TTYPATCHCOMS)
(RPAQQ TTYPATCHCOMS ((VARS DemoOutline)
(FNS DemoScreen NEWFONT StartTrafficLight StartTruckin SetUpFarmRoad)
(FNS LEESBURG)
(FNS SetUpScreen)
(VARS LOOPSSCREENCOMS)))
(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
"to provide an integrated programming environment"
T T " for" 8 "Procedure-oriented programming, " T T 8
"Object-oriented programming, "
T T 8 "Access-oriented programming, and " T T 8
"Rule-oriented programming."
T 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 "Classes inherit information from their superclasses." 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 "which will 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 also shows where"
T "inherited structure and methods come from." T T)
(BKSYSBUF "(← $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 "(← $Apple New '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 "(← $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 just 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 "(←@ $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 "(←New $VerticalScale Attach ($ Apple1) '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 "(← $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 "(BreakIt $Apple1 'price)")))
("Traffic Light Example" (SetUpFarmRoad))
("Running the traffic light" (BKSYSBUF "(StartTrafficLight)"))
("Traffic Light Rules" (PROGN (CLEARW TTY)
(printout TTY .FONT BOLDFONT "Type ↑X to exit Rule Editor" T T
"Select OK to leave to rule compiler."
T T T T .FONT DEFAULTFONT T)
(BKSYSBUF "(← ($ LightRules)
ER)")))
("Lisp code for a RuleSet" (PROGN (CLEARW TTY)
(printout TTY T T .FONT BOLDFONT
"RuleSets compile into Lisp code
which is much larger and less clear.
")
(BKSYSBUF "DF(LightRules)")))
("Truckin Demo" (BKSYSBUF "(StartTruckin)
"))))
(DEFINEQ
(DemoScreen
[LAMBDA (bigFont) (* mjs: "29-JUL-83 19:38")
(SetUpScreen)
(SETQ TTY \TopLevelTtyWindow)
(CLEARW TTY)
(TERPRI TTY)
(DSPFONT (CADR LAMBDAFONT)
PROMPTWINDOW)
(OPENW DemoWindow) (* Create DemoOutline Menu)
(BIGCW (QUOTE (442 . 464))
Hand HandShadow) (* Create the big cursor)
[LoopsIcon2 (COND
(bigFont (QUOTE (35 . 222)))
(T (QUOTE (505 . 618]
(SETQ InspectAppleRegion (COND
(bigFont LargeInspectAppleRegion)
(T SmallInspectAppleRegion)))
(BIGCW (QUOTE (827 . 456))
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])
(NEWFONT
[LAMBDA (FONTS) (* mjs: "29-JUL-83 19:39")
(* Used to change a set of fonts.)
(FONTSET FONTS)
(DSPFONT (CADR LITTLEFONT)
WindowTitleDisplayStream)
(SETQ MENUFONT (CADR LITTLEFONT))
[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])
(StartTrafficLight
[LAMBDA NIL (* mjs: "29-JUL-83 19:39")
(PROGN (CLEARW TTY)
(printout TTY .FONT BOLDFONT "Use ↑K to change status of Farm Road Sensor." T T
"Use ↑F to get the Rule Exec"
T T "------------" T 8 "Inside the rule exec:" T T 8
"To see the rule behind the decision,"
T 9 "Type:" T 9 "why farmLight:color" T T 8 "To see all the rules" T 9
"Select LightRules with Middle Button"
T T 8 "To stop examining rules" T 9 "Type ↑X, and select OK in menu" T
"------------"
T T "Use ↑D to stop the Traffic Light simulation." T)
(← TLS Run])
(StartTruckin
[LAMBDA NIL (* mjs: "29-JUL-83 19:39")
(* * Demo fn to start the Truckin simulation.)
(for W in (ACTIVEWINDOWS) do (CLOSEW W))
(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])
(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])
)
(DEFINEQ
(LEESBURG
[LAMBDA NIL (* mjs: "29-JUL-83 19:46")
(* Initialize LoopsDemo for Lisp/Loops course -- offered
at Leesburg.)
(* Initialize variables.)
(SETQ LeesburgFlg T)
(SETQ DIRECTORIES NIL)
(SETQ LISPUSERSDIRECTORIES NIL)
(SETQ FONTDIRECTORIES NIL)
(SETQ FILELST NIL)
(SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
(PRINTERMODE (QUOTE INTERPRESS)) (* Load function defns needed for course.)
(for FILE in (QUOTE (GAUGES TRUCKINP TRUCKINDB EXERCISE1 SIMPLEG TRANSLATE))
do (LOAD FILE (QUOTE PROP])
)
(DEFINEQ
(SetUpScreen
[LAMBDA NIL (* mjs: "29-JUL-83 19:59")
(PROG (w)
(for W in (ACTIVEWINDOWS) do (CLOSEW W))
(CHANGEBACKGROUND BACKGROUNDSHADE)
(TMenu (QUOTE EditCommands)
"Edit Commands" edComsPos)
(DSPOPERATION (QUOTE INVERT)
PROMPTWINDOW)
(WINDOWPROP PROMPTWINDOW (QUOTE TITLE)
(CONCAT "Prompt Window -- Lisp System: " LispDate " Loops Loadup: "
LoopsDate))
(CLEARW PROMPTWINDOW)
(SHAPEW PROMPTWINDOW promptPos)
(SETQ PrintStatusWindow PROMPTWINDOW)
(SETQ PPDefault (SETQ USEREXECDS (CREATEW uePos "User Exec -- PPDefault Window" NIL)))
(DSPSCROLL (QUOTE ON)
USEREXECDS)
(SHRINKW USEREXECDS NIL ueIconPos)
(SETQ TTY \TopLevelTtyWindow)
(SHAPEW TTY ttyPos)
(CLOSEW (SETQ DEditWindow (CREATEW deditPos "DEdit")))
(SHRINKW (SETQ TTYINEDITWINDOW (CREATEW eePos "Edit Work Area"))
NIL eeIconPos)
(HistIcon)
(LoopsIcon])
)
(RPAQQ LOOPSSCREENCOMS ((* Functions for setting up and manipulating the Loops screen)
(FNS HistIcon LoopsIcon SetUpScreen ClassLatticeFn UE PPW PrintScreen
PressScreen PrintWindow PrintLattice PromptEval PromptRead)
(* Positions and regions for various windows on Loops screen)
(VARS * SCREENVARS)
(USERMACROS EE UE OKCLOSE DE)
(LISPXMACROS OKCLOSE)
[P (ADVISE (QUOTE CNDIR)
(QUOTE AFTER)
(QUOTE (PROGN (WINDOWPROP TTY (QUOTE TITLE)
(CONCAT
"Typescript window -- Connected Directory: "
!VALUE))
(PrintStatus (CHARACTER 7)
"Connecting to " !VALUE]
(HORRIBLEVARS WhiteLoopsIconBM BlackLoopsIconBM PalIconBM)
(* (c)
Copyright 1983 Xerox Corporation)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5241 9450 (DemoScreen 5251 . 6145) (NEWFONT 6147 . 6901) (StartTrafficLight 6903 . 7578
) (StartTruckin 7580 . 8197) (SetUpFarmRoad 8199 . 9448)) (9451 10237 (LEESBURG 9461 . 10235)) (10238
11346 (SetUpScreen 10248 . 11344)))))
STOP