(FILECREATED " 9-Apr-84 15:47:45" {PHYLUM}<LISPCORE>DEMO>DEMOS.;26 10277
changes to: (VARS DEMOSCOMS)
previous date: "21-AUG-83 01:43:36" {PHYLUM}<LISPCORE>DEMO>DEMOS.;25)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT DEMOSCOMS)
(RPAQQ DEMOSCOMS ((FNS DEMO DODEMOS \ADDDEMOPROC \SETNEXTDEMO RUNDEMO RUNNING.PROCESSP)
(FNS CLEANUPDEMOS)
(VARS DEMOS DEFAULTDEMOTIME DEMOWINDOWNAMES (ADDINSTOOFLG NIL
"an undebugged hook to allow more than one thing at a time to run."))
(DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (NLAMA PARSE))
(FILES (SYSLOAD FROM <LISPCORE>DEMO>)
RAIN
(SYSLOAD FROM LISPUSERS)
UTILPROC HANOI LINEDEMO KINETIC BLTDEMO BITMAPFNS WINK PEANO))
(RECORDS DEMOPROC)))
(DEFINEQ
(DEMO
[LAMBDA NIL (* hts: "20-AUG-83 22:25")
(* runs the sequence of demos under menu control. If processes are already running it just calls DODEMOS,
otherwise it turns processes on runs the demos then turns processes off.)
(DECLARE (GLOBALVARS DEMOS DEMOPROCS ADDINSTOOFLG \NEWDEMO DEFAULTDEMOTIME))
[RESETLST NIL [PROG [(DEMOMENU (create MENU
TITLE ← "Demos"
ITEMS ←(APPEND DEMOS (QUOTE (STOP)))
WHENSELECTEDFN ←(QUOTE \SETNEXTDEMO]
[RESETSAVE NIL (LIST (QUOTE CLOSEW)
(ADDMENU DEMOMENU NIL
(create POSITION
XCOORD ← 4
YCOORD ←(IDIFFERENCE
(IDIFFERENCE SCREENHEIGHT
(fetch IMAGEHEIGHT
of DEMOMENU))
4]
[RESETSAVE NIL (LIST (QUOTE SHAPEW)
\TopLevelTtyWindow
(WINDOWPROP \TopLevelTtyWindow (QUOTE REGION]
(SHAPEW \TopLevelTtyWindow (create REGION
LEFT ←(IPLUS 8 (fetch IMAGEWIDTH
of DEMOMENU))
BOTTOM ←(IDIFFERENCE (IDIFFERENCE
SCREENHEIGHT
(fetch IMAGEHEIGHT
of DEMOMENU))
4)
WIDTH ← 250
HEIGHT ←(fetch IMAGEHEIGHT of DEMOMENU]
[RESETSAVE NIL (LIST (QUOTE CARET)
(CARET (QUOTE OFF]
(* DEMOS is a list of demo items. If the item is a list, the second element is a list whose CAR is the fn to be
called and whose CADR is the default length of time the demo should run. The third element should be a help
string.)
(SETQ \NEWDEMO NIL) (* make a list of demoprocesses that can be recontinued
if stopped.)
(SETQ DEMOPROCS (for DEMO in DEMOS collect (create DEMOPROC
DEMOPROCNAME ←(CAR DEMO)
DEMOPROCFORM ←[LIST
(COND
((NLISTP (CADR DEMO))
(CADR DEMO))
(T (CAADR DEMO]
DEMOPROCTIME ←[COND
((NLISTP (CADR DEMO))
DEFAULTDEMOTIME)
(T (CADR (CADR DEMO]
DEMOPROCHANDLE ← NIL)))
(bind (\NEXTDEMO ←(CAR DEMOPROCS))
do (SETQ \NEWDEMO NIL)
(RUNDEMO \NEXTDEMO)
(SETQ \NEXTDEMO (COND
[\NEWDEMO (COND
((EQ \NEWDEMO (QUOTE STOP))
(RETURN))
(T (for DEMOPROC in DEMOPROCS when (EQ (fetch (DEMOPROC
DEMOPROCNAME)
of DEMOPROC)
(CAR \NEWDEMO))
do (RETURN DEMOPROC]
((CADR (FMEMB \NEXTDEMO DEMOPROCS)))
((CAR DEMOPROCS]
(for DEMOPROC in DEMOPROCS when (fetch (DEMOPROC DEMOPROCHANDLE) of DEMOPROC)
do (DEL.PROCESS (fetch (DEMOPROC DEMOPROCHANDLE) of DEMOPROC])
(DODEMOS
[LAMBDA (STOPPROCESSESWHENDONEFLG) (* rrb "27-JUN-82 20:03")
(DECLARE (GLOBALVARS DEMOS DEMOPROCS ADDINSTOOFLG \NEWDEMO DEFAULTDEMOTIME))
[RESETLST NIL [PROG [(DEMOMENU (create MENU
TITLE ← "Demos"
ITEMS ←(APPEND DEMOS (QUOTE (STOP)))
WHENSELECTEDFN ←(QUOTE \SETNEXTDEMO)))
(ADDINMENU (create MENU
TITLE ← "Addins"
ITEMS ←(QUOTE ((Mirror RSHOWPROC)))
WHENSELECTEDFN ←(QUOTE \ADDDEMOPROC]
[RESETSAVE NIL (LIST (QUOTE CLOSEW)
(ADDMENU DEMOMENU NIL
(create POSITION
XCOORD ← 4
YCOORD ←(IDIFFERENCE
(IDIFFERENCE SCREENHEIGHT
(fetch IMAGEHEIGHT
of DEMOMENU))
4]
[AND ADDINSTOOFLG
(RESETSAVE NIL (LIST (QUOTE CLOSEW)
(ADDMENU ADDINMENU NIL
(create POSITION
XCOORD ←(IPLUS 12
(fetch IMAGEWIDTH
of DEMOMENU))
YCOORD ←(IDIFFERENCE
(IDIFFERENCE SCREENHEIGHT
(fetch IMAGEHEIGHT
of ADDINMENU))
4]
(SHAPEW (TTYDISPLAYSTREAM)
(create REGION
LEFT ←(IPLUS 8 (COND
(ADDINSTOOFLG (IPLUS 8 (fetch IMAGEWIDTH
of ADDINMENU)))
(T 0))
(fetch IMAGEWIDTH of DEMOMENU))
BOTTOM ←(IDIFFERENCE (IDIFFERENCE SCREENHEIGHT
(fetch IMAGEHEIGHT
of DEMOMENU))
4)
WIDTH ← 250
HEIGHT ←(fetch IMAGEHEIGHT of DEMOMENU]
[RESETSAVE NIL (LIST (QUOTE CARET)
(CARET (QUOTE OFF]
(* DEMOS is a list of demo items. If the item is a list, the second element is a list whose CAR is the fn to be
called and whose CADR is the default length of time the demo should run. The third element should be a help
string.)
(SETQ \NEWDEMO NIL) (* make a list of demoprocesses that can be recontinued
if stopped.)
(SETQ DEMOPROCS (for DEMO in DEMOS collect (create DEMOPROC
DEMOPROCNAME ←(CAR DEMO)
DEMOPROCFORM ←[LIST
(COND
((NLISTP (CADR DEMO))
(CADR DEMO))
(T (CAADR DEMO]
DEMOPROCTIME ←[COND
((NLISTP (CADR DEMO))
DEFAULTDEMOTIME)
(T (CADR (CADR DEMO]
DEMOPROCHANDLE ← NIL)))
(bind (\NEXTDEMO ←(CAR DEMOPROCS))
do (SETQ \NEWDEMO NIL)
(RUNDEMO \NEXTDEMO)
(SETQ \NEXTDEMO (COND
[\NEWDEMO (COND
((EQ \NEWDEMO (QUOTE STOP))
(RETURN))
(T (for DEMOPROC in DEMOPROCS when (EQ (fetch (DEMOPROC
DEMOPROCNAME)
of DEMOPROC)
(CAR \NEWDEMO))
do (RETURN DEMOPROC]
((CADR (FMEMB \NEXTDEMO DEMOPROCS)))
((CAR DEMOPROCS]
(for DEMOPROC in DEMOPROCS when (fetch (DEMOPROC DEMOPROCHANDLE) of DEMOPROC)
do (DEL.PROCESS (fetch (DEMOPROC DEMOPROCHANDLE) of DEMOPROC)))
(COND
(STOPPROCESSESWHENDONEFLG (PROCESSWORLD (QUOTE OFF])
(\ADDDEMOPROC
[LAMBDA (ITEM) (* adds a process into the fray)
(ADD.PROCESS (LIST (CADR ITEM))
(CAR ITEM)
(QUOTE NO])
(\SETNEXTDEMO
[LAMBDA (NEW)
(DECLARE (GLOBALVARS \NEWDEMO)) (* hts: "20-AUG-83 22:31")
(SETQ \NEWDEMO NEW)
(WAKE.PROCESS (QUOTE EXEC])
(RUNDEMO
[LAMBDA (DEMOPROC) (* hts: "20-AUG-83 22:34")
(* runs a demo process for a time quantam.
If it has to be stopped, its handle is saved so it can
be recontinued.)
(* the idea is for this guy to start a process doing the
demo and stop it after time has ellapsed.)
(PROG ((ENDTIME (SETUPTIMER (fetch (DEMOPROC DEMOPROCTIME) of DEMOPROC)))
PROCHANDLE)
[COND
((AND (SETQ PROCHANDLE (fetch (DEMOPROC DEMOPROCHANDLE) of DEMOPROC))
(RUNNING.PROCESSP PROCHANDLE))
(WAKE.PROCESS PROCHANDLE))
(T (SETQ PROCHANDLE (ADD.PROCESS (fetch (DEMOPROC DEMOPROCFORM) of DEMOPROC)
(fetch (DEMOPROC DEMOPROCNAME) of DEMOPROC)
(QUOTE NO]
LP (BLOCK)
(COND
((OR \NEWDEMO (NULL (RUNNING.PROCESSP PROCHANDLE))
(TIMEREXPIRED? ENDTIME)) (* The demo stopped on its own, time has ellapsed or a
different demo was selected.)
(replace (DEMOPROC DEMOPROCHANDLE) of DEMOPROC with (SETQ PROCHANDLE (RUNNING.PROCESSP
PROCHANDLE)))
(AND PROCHANDLE (SUSPEND.PROCESS PROCHANDLE))
(RETURN))
(T (GO LP])
(RUNNING.PROCESSP
[LAMBDA (X) (* hts: "20-AUG-83 22:27")
(AND (PROCESSP X)
X])
)
(DEFINEQ
(CLEANUPDEMOS
[LAMBDA NIL (* hts: "21-AUG-83 01:41")
(* closes all of the windows from the demos)
[for WIN in DEMOWINDOWNAMES do (COND
((TYPENAMEP (EVALV WIN)
(QUOTE WINDOW))
(CLOSEW (EVALV WIN]
(BLOCK 10000])
)
(RPAQQ DEMOS ((Hanoi (HANOIDEMO 60000))
(Polygons (POLYGONSDEMO 60000))
(Rain (RAINDEMO 60000))
(Winker (WINKERDEMO 40000))
(Kinetic (KINETICDEMO 60000))
(Mover (MOVEPICTUREDEMO 60000))
(Peano (PEANODEMO 120000))
(Activity (ACTIVITYDEMO 60000))
(Mirror RSHOWPROC)
(CleanUp (CLEANUPDEMOS 20000))))
(RPAQQ DEFAULTDEMOTIME 60000)
(RPAQQ DEMOWINDOWNAMES (PEANOWINDOW RAINWINDOW KINETICWINDOW HANOIWINDOW POLYGONSWINDOW
EINSTEINWINDOW WINKWINDOW RSHOWWINDOW BOUNCEWINDOW))
(RPAQ ADDINSTOOFLG NIL "an undebugged hook to allow more than one thing at a time to run.")
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR NLAMA PARSE)
(FILESLOAD (SYSLOAD FROM <LISPCORE>DEMO>)
RAIN
(SYSLOAD FROM LISPUSERS)
UTILPROC HANOI LINEDEMO KINETIC BLTDEMO BITMAPFNS WINK PEANO)
)
[DECLARE: EVAL@COMPILE
(RECORD DEMOPROC (DEMOPROCNAME DEMOPROCFORM DEMOPROCTIME DEMOPROCHANDLE))
]
(PUTPROPS DEMOS COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (786 8834 (DEMO 796 . 3669) (DODEMOS 3671 . 6901) (\ADDDEMOPROC 6903 . 7083) (
\SETNEXTDEMO 7085 . 7270) (RUNDEMO 7272 . 8689) (RUNNING.PROCESSP 8691 . 8832)) (8835 9225 (
CLEANUPDEMOS 8845 . 9223)))))
STOP