(FILECREATED "13-Nov-85 17:55:03" {ERIS}<IRIS>KOTO>LOADIRIS.;4 14158
changes to: (VARS LOADIRISCOMS IRIS.MENU.COMMANDS)
(FNS IRIS.DOMENU LI.LOAD LI.SETUP)
previous date: "12-Nov-85 23:31:12" {ERIS}<IRIS>KOTO>LOADIRIS.;3)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LOADIRISCOMS)
(RPAQQ LOADIRISCOMS ((FILES FREEMENU)
(FNS LI.CIRCLES LI.LOAD LI.MAKEMENU LI.SETUP IRIS.CREATE.ICON IRIS.DOMENU
IRIS.TRY LOADIRIS INSTALLIRIS LI.TRAVEL)
(VARS (IRIS.DIRECTORY (QUOTE {Eris}<Iris>Koto>))
IRIS.MENU.COMMANDS IRISFILES LI.SETUP.ALL LI.SETUP.CLEAR LI.SETUP.DEBUG
LI.SETUP.STANDARD LI.SHADE LOCATED.IRISFILES LOCATED.IRISPATCHFILE
(LI.MENU))
(BITMAPS LI.DOIT LI.IRISLOGO IRIS.ICON IRIS.ICON.MASK)
(P (IRIS.CREATE.ICON)
(printout T "Bug the Iris icon with the left mouse button to proceed" T))))
(FILESLOAD FREEMENU)
(DEFINEQ
(LI.CIRCLES
(LAMBDA (X) (* gbn " 5-Aug-85 15:25")
(for F to (OR X 100)
do (IRIS.COLOR (RAND 0 7))
(IRIS.CIRCF (RAND 0 1000)
(RAND 0 800)
(RAND 50 200)))
(IRIS.GFLUSH)))
(LI.LOAD
[LAMBDA (item window button) (* LeL, " 5-Sep-85 18:17")
(printout PROMPTWINDOW T "[Loading Iris Files]")
(RESETLST [RESETSAVE (BITBLT NIL NIL NIL window NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
LI.SHADE)
(BQUOTE (BITBLT NIL NIL NIL (\, window)
NIL NIL NIL NIL TEXTURE INVERT (\, LI.SHADE]
(* (QUOTE LIST) (QUOTE REDISPLAYW) window)
(for f in (FM.READSTATE window) when (NEQ f T)
do (SETQ f (PACKFILENAME (QUOTE DIRECTORY)
IRIS.DIRECTORY
(QUOTE BODY)
f))
(if (FILENAMEFIELD f (QUOTE EXTENSION))
then (LOAD f)
else (LOAD f (QUOTE PROP])
(LI.MAKEMENU
(LAMBDA NIL (* LeL, " 9-Sep-85 01:56")
(if (WINDOWP LI.MENU)
then (CLOSEW LI.MENU))
(SETQ LI.MENU
(FM.FORMATMENU (BQUOTE ((WINDOWPROPS TITLE "Iris Loadup Panel")
((LABEL Setup: TYPE TITLE FONT (HELVETICA 10 BOLD))
(LABEL CLEAR TYPE MOMENTARY SELECTEDFN LI.SETUP)
(LABEL Standard TYPE MOMENTARY SELECTEDFN LI.SETUP)
(LABEL Debug TYPE MOMENTARY SELECTEDFN LI.SETUP)
(LABEL ALL TYPE MOMENTARY SELECTEDFN LI.SETUP))
(\,@(LET* ((strLength (ADD1 (APPLY (FUNCTION MAX)
(MAPCAR IRISFILES
(FUNCTION NCHARS)))))
(spaces (ALLOCSTRING strLength " ")))
(MAPCAR IRISFILES
(FUNCTION (LAMBDA (f)
(BQUOTE ((LABEL (\, (SUBSTRING (CONCAT f ":"
spaces)
1 strLength))
TYPE TITLE FONT (GACHA 8 BOLD))
(LABEL Dcom ID
(\, (PACKFILENAME 'NAME f
'EXTENSION
'DCOM))
TYPE TOGGLE FONT
(GACHA 8 STANDARD))
(LABEL Source ID (\, f)
TYPE TOGGLE FONT
(GACHA 8 STANDARD)))))))))
((LABEL "Load --" TYPE TITLE FONT (HELVETICA 12 BOLD))
(LABEL (\, LI.IRISLOGO)
TYPE MOMENTARY SELECTEDFN LI.LOAD MESSAGE
"Loads the selected Iris files"))))))
(for setup in LI.SETUP.STANDARD when (CDR setup) do (FM.CHANGESTATE (FM.ITEMFROMID LI.MENU
(CAR setup))
LI.MENU
(CDR setup)))
(printout PROMPTWINDOW T "Please put the LoadIris menu somewhere")
(MOVEW LI.MENU LASTMOUSEX LASTMOUSEY)
(MOVEW LI.MENU)
(printout PROMPTWINDOW " -- thank you.")))
(LI.SETUP
[LAMBDA (item window button) (* LeL, " 5-Sep-85 17:45")
(for setup in [EVALV (PACK* (QUOTE LI.SETUP.)
(U-CASE (FM.ITEMPROP item (QUOTE LABEL]
do (* This is rediculous...)
(if (EQ (FM.CHANGESTATE (FM.ITEMFROMID window (CAR setup))
window
(CDR setup))
(CDR setup))
then (FM.CHANGESTATE (FM.ITEMFROMID window (CAR setup))
window
(CDR setup])
(IRIS.CREATE.ICON
(LAMBDA (position) (* LeL, " 9-Sep-85 01:55")
(if (NOT position)
then (printout PROMPTWINDOW T "Please position the Iris icon somewhere"))
(LET ((window (ICONW IRIS.ICON IRIS.ICON.MASK position)))
(WINDOWPROP window 'SHRINKFN 'DON'T)
(WINDOWPROP window 'BUTTONEVENTFN 'IRIS.DOMENU))
(if (NOT position)
then (printout PROMPTWINDOW " -- thank you."))))
(IRIS.DOMENU
[LAMBDA (window) (* LeL, " 9-Sep-85 01:36")
(if (NOT (WINDOWPROP window (QUOTE MENU)))
then (WINDOWPROP window (QUOTE MENU)
(create MENU
ITEMS ← IRIS.MENU.COMMANDS)))
(MENU (WINDOWPROP window (QUOTE MENU])
(IRIS.TRY
(LAMBDA NIL (* LeL, " 4-Sep-85 15:42")
(* opens a connection and runs two dumb demos)
(OPEN.IRISCONN) (* this defaults to the value of IRISNSHOSTNUMBER)
(IRIS.GINIT) (* must be executed before the iris is ready to accept
graphic commands)
(for I to 5
do (LI.CIRCLES)
(LI.TRAVEL))))
(LOADIRIS
(LAMBDA (options) (* LeL, " 3-Sep-85 11:55")
(* * loads the files necessary to open a connection to the iris and use the graphics library)
(if (FMEMB 'DCOMS options)
then (MAPC LOCATED.IRISFILES (FUNCTION (LAMBDA (file)
(LOAD? (PACK* file '.DCOM))))))
(if (FMEMB 'SOURCES options)
then (MAPC LOCATED.IRISFILES (FUNCTION (LAMBDA (file)
(LOAD? file 'PROP)))))
(if (FMEMB 'PATCHES options)
then (LOAD LOCATED.IRISPATCHFILE))))
(INSTALLIRIS
(LAMBDA (NODCOMS NOSOURCES) (* BDV "19-Jul-85 19:08")
(* * moves the iris files from my working dir to {eris}<iris>current>)
(COPYFILES IRISFILES '{ERIS}<IRIS>CURRENT>)
(COPYFILES (for F in IRISFILES collect (PACK* F ".DCOM"))
'{ERIS}<IRIS>CURRENT>)
(COPYFILES 'IRISIO.DCOM '{ERIS}<IRIS>CURRENT>)))
(LI.TRAVEL
(LAMBDA (COLOR) (* gbn " 5-Aug-85 21:33")
(* dumb demo to try double buffering)
(IRIS.DOUBLEBUFFER)
(IRIS.GCONFIG)
(if (NOT COLOR)
then (SETQ COLOR (RAND 0 6)))
(for I from 5 to 1000 by 10
do (IRIS.COLOR 8)
(IRIS.CLEAR)
(IRIS.COLOR COLOR)
(IRIS.CIRCF I (IQUOTIENT I 2)
(IQUOTIENT I 5))
(IRIS.SWAPBUFFERS))
(IRIS.GFLUSH)
(IRIS.SINGLEBUFFER)
(IRIS.GCONFIG)))
)
(RPAQQ IRIS.DIRECTORY {Eris}<Iris>Koto>)
(RPAQQ IRIS.MENU.COMMANDS (("Create Loadup Panel" (LI.MAKEMENU))
("Enable bootserver" (if (GETD (QUOTE IRISBOOTSERVER))
then
(IRISBOOTSERVER T)
else
(PROMPTPRINT
"IRISNET must be loaded to use the boot server"))
"Allows the Lisp Machine to boot the IRIS")
("Disable bootserver" (if (GETD (QUOTE IRISBOOTSERVER))
then
(IRISBOOTSERVER NIL)
else
(PROMPTPRINT
"IRISNET must be loaded to use the boot server"))
"Prevents the Lisp Machine from booting the IRIS"))
)
(RPAQQ IRISFILES (IRISSTREAM IRISNET IRISIO IRISLIB IRISCONSTANTS IRISPATCH))
(RPAQQ LI.SETUP.ALL ((IRISSTREAM . T)
(IRISSTREAM.DCOM . T)
(IRISNET . T)
(IRISNET.DCOM . T)
(IRISIO . T)
(IRISIO.DCOM . T)
(IRISLIB . T)
(IRISLIB.DCOM . T)
(IRISCONSTANTS . T)
(IRISCONSTANTS.DCOM . T)
(IRISPATCH . T)
(IRISPATCH.DCOM)))
(RPAQQ LI.SETUP.CLEAR ((IRISSTREAM)
(IRISSTREAM.DCOM)
(IRISNET)
(IRISNET.DCOM)
(IRISIO)
(IRISIO.DCOM)
(IRISLIB)
(IRISLIB.DCOM)
(IRISCONSTANTS)
(IRISCONSTANTS.DCOM)
(IRISPATCH)
(IRISPATCH.DCOM)))
(RPAQQ LI.SETUP.DEBUG ((IRISSTREAM . T)
(IRISSTREAM.DCOM . T)
(IRISNET)
(IRISNET.DCOM . T)
(IRISIO . T)
(IRISIO.DCOM . T)
(IRISLIB . T)
(IRISLIB.DCOM . T)
(IRISCONSTANTS)
(IRISCONSTANTS.DCOM)
(IRISPATCH)
(IRISPATCH . T)))
(RPAQQ LI.SETUP.STANDARD ((IRISSTREAM)
(IRISSTREAM.DCOM . T)
(IRISNET)
(IRISNET.DCOM . T)
(IRISIO)
(IRISIO.DCOM . T)
(IRISLIB)
(IRISLIB.DCOM . T)
(IRISCONSTANTS)
(IRISCONSTANTS.DCOM . T)
(IRISPATCH)
(IRISPATCH.DCOM)))
(RPAQQ LI.SHADE 18432)
(RPAQQ LOCATED.IRISFILES ({QV}<PSYCH>IRIS>GL2>IRISLIB {ERIS}<IRIS>IRISSTREAM {ERIS}<IRIS>IRISNET
{QV}<PSYCH>IRIS>GL2>IRISIO
{ERIS}<IRIS>IRISDIGDEMO))
(RPAQQ LOCATED.IRISPATCHFILE {QV}<PSYCH>IRIS>GL2>IRISPATCH)
(RPAQQ LI.MENU NIL)
(RPAQ LI.DOIT (READBITMAP))
(20 12
"@@@@@@@@"
"GOOOL@@@"
"D@@@D@@@"
"EHIGD@@@"
"EEEBD@@@"
"EEEBD@@@"
"EEEBD@@@"
"EHIBD@@@"
"D@@@D@@@"
"GOOOL@@@"
"@@@@@@@@"
"@@@@@@@@")
(RPAQ LI.IRISLOGO (READBITMAP))
(16 16
"@NG@"
"CJEL"
"FBDF"
"CHAL"
"@NG@"
"NCLG"
"KHAM"
"HNGA"
"HBDA"
"KJEM"
"NBDG"
"HJEA"
"CJEL"
"FBDF"
"CJEL"
"@NG@")
(RPAQ IRIS.ICON (READBITMAP))
(75 82
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@N@N@@@@@@@@@"
"@@@@@@@COAOH@@@@@@@@"
"@@@@@@@OOAON@@@@@@@@"
"@@@@@@COOAOOH@@@@@@@"
"@@@@@@OOOAOON@@@@@@@"
"@@@@@COOOAOOOH@@@@@@"
"@@@@@OOLOANGON@@@@@@"
"@@@@COO@OANAOOH@@@@@"
"@@@@OOL@OAN@GON@@@@@"
"@@@COO@@OAN@AOOH@@@@"
"@@@OOL@@OAN@@GON@@@@"
"@@COO@@@OAN@@AOOH@@@"
"@@OOL@@@OAN@@@GON@@@"
"@COO@@@@OAN@@@AOOH@@"
"@OOL@@@@OAN@@@@GON@@"
"AOO@@@@@OAN@@@@AOO@@"
"COL@@@@@OAN@@@@@GOH@"
"COH@@@@@OAN@@@@@COH@"
"CON@@@@@OAN@@@@@OOH@"
"AOOH@@@@OAN@@@@COO@@"
"@OON@@@@OAN@@@@OON@@"
"@COOH@@@OAN@@@COOH@@"
"@@OON@@@OAN@@@OON@@@"
"A@COOH@@OAN@@COOHA@@"
"CL@OON@@OAN@@OON@GH@"
"CO@COOH@OAN@COOHAOH@"
"COL@OON@OAN@OON@GOH@"
"COO@COOHOANCOOHAOOH@"
"COOL@OONCAHOON@GOOH@"
"COOO@COOH@COOHAOOOH@"
"CLOOL@OON@OON@GONGH@"
"CLCOO@COOKOOHAOOHGH@"
"CL@OOL@OOOON@GON@GH@"
"CL@COO@COOOHAOOH@GH@"
"CL@@OOL@OON@GON@@GH@"
"CL@@COO@COHAOOH@@GH@"
"CL@@@OOL@N@GON@@@GH@"
"CL@@@COO@@AOOH@@@GH@"
"CL@@@@OOL@GON@@@@GH@"
"CL@@@@CON@OOH@@@@GH@"
"CL@@@@@OOAON@@@@@GH@"
"CL@@@@BCOAOHH@@@@GH@"
"CL@@@@OHOANCN@@@@GH@"
"CL@@@COLOANGOH@@@GH@"
"CL@@@OOLOANGON@@@GH@"
"CL@@COO@OANAOOH@@GH@"
"CL@@OOL@OAN@GON@@GH@"
"CL@COO@BOANHAOOH@GH@"
"CL@OOL@NOANN@GON@GH@"
"CLCOO@CNOANOHAOOHGH@"
"CLOOL@ONOANON@GONGH@"
"COOO@CONOANOOHAOOOH@"
"COOL@OOLOANGON@GOOH@"
"COO@COO@OANAOOHAOOH@"
"COL@OOL@OAN@GON@GOH@"
"CO@COO@@OAN@AOOHAOH@"
"CL@OOL@@OAN@@GON@GH@"
"A@COO@@@OAN@@AOOHA@@"
"@@OOL@@@OAN@@@GON@@@"
"@COO@@@@OAN@@@AOOH@@"
"@GOL@@@@OAN@@@@GOL@@"
"@OO@@@@@OAN@@@@AON@@"
"@OL@@@@@OAN@@@@@GN@@"
"@OO@@@@@OAN@@@@AON@@"
"@OOL@@@@OAN@@@@GOL@@"
"@COO@@@@OAN@@@AOOH@@"
"@@OOL@@@OAN@@@GON@@@"
"@@COO@@@OAN@@AOOH@@@"
"@@@OOL@@OAN@@GON@@@@"
"@@@COO@@OAN@AOOH@@@@"
"@@@@OOL@OAN@GON@@@@@"
"@@@@COO@OANAOOH@@@@@"
"@@@@@OOLOANGON@@@@@@"
"@@@@@COOOAOOOH@@@@@@"
"@@@@@@OOOAOON@@@@@@@"
"@@@@@@COOAOOH@@@@@@@"
"@@@@@@@OOAON@@@@@@@@"
"@@@@@@@CN@OH@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@")
(RPAQ IRIS.ICON.MASK (READBITMAP))
(75 82
"@@@@@@@COKOH@@@@@@@@"
"@@@@@@@OOOON@@@@@@@@"
"@@@@@@COOOOOH@@@@@@@"
"@@@@@@OOOOOON@@@@@@@"
"@@@@@COOOOOOOH@@@@@@"
"@@@@@OOOOOOOON@@@@@@"
"@@@@COOOOOOOOOH@@@@@"
"@@@@OOOOOOOOOON@@@@@"
"@@@COOOOOOOOOOOH@@@@"
"@@@OOOOOOOOOOOON@@@@"
"@@COOOOOOOOOOOOOH@@@"
"@@OOOOOOOOOOOOOON@@@"
"@COOOOOCOOOIOOOOOH@@"
"@OOOOOLCOOOHGOOOON@@"
"COOOOO@COOOHAOOOOOH@"
"GOOOOL@COOOH@GOOOOL@"
"OOOOO@@COOOH@AOOOON@"
"OOOOL@@COOOH@@GOOON@"
"OOOO@@@COOOH@@AOOON@"
"OOON@@@COOOH@@@GOON@"
"OOOOH@@COOOH@@AOOON@"
"OOOON@@COOOH@@GOOON@"
"OOOOOH@COOOH@AOOOON@"
"GOOOON@COOOH@OOOOOL@"
"OOOOOOHCOOOHCOOOOON@"
"OOOOOONCOOOHOOOOOON@"
"OOOOOOOKOOOKOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOCOOOOOOOOOOOOOION@"
"OO@OOOOOOOOOOOONAON@"
"OO@COOOOOOOOOOOHAON@"
"OO@@OOOOOOOOOON@AON@"
"OO@@COOOOOOOOOH@AON@"
"OO@@@OOOOOOOON@@AON@"
"OO@@@COOOOOOOH@@AON@"
"OO@@@OOOOOOOON@@AON@"
"OO@@COOOOOOOOOH@AON@"
"OO@@OOOOOOOOOON@AON@"
"OO@COOOOOOOOOOOHAON@"
"OO@OOOOOOOOOOOONAON@"
"OOCOOOOOOOOOOOOOION@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOOOOOOOOOOOON@"
"OOOOOOOCOOOIOOOOOON@"
"OOOOOOLCOOOHGOOOOON@"
"OOOOOO@COOOHAOOOOON@"
"GOOOOL@COOOH@GOOOOL@"
"COOOO@@COOOH@AOOOOH@"
"COOOL@@COOOH@@GOOOH@"
"COOO@@@COOOH@@AOOOH@"
"COOOL@@COOOH@@GOOOH@"
"COOOO@@COOOH@AOOOOH@"
"COOOOL@COOOH@GOOOOH@"
"AOOOOO@COOOHAOOOOO@@"
"@OOOOOLCOOOHGOOOON@@"
"@COOOOOCOOOIOOOOOH@@"
"@@OOOOOOOOOOOOOON@@@"
"@@COOOOOOOOOOOOOH@@@"
"@@@OOOOOOOOOOOON@@@@"
"@@@COOOOOOOOOOOH@@@@"
"@@@@OOOOOOOOOON@@@@@"
"@@@@COOOOOOOOOH@@@@@"
"@@@@@OOOOOOOON@@@@@@"
"@@@@@COOOOOOOH@@@@@@"
"@@@@@@OOOOOON@@@@@@@"
"@@@@@@COOOOOH@@@@@@@"
"@@@@@@@OOKON@@@@@@@@")
(IRIS.CREATE.ICON)
(printout T "Bug the Iris icon with the left mouse button to proceed" T)
(PUTPROPS LOADIRIS COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (953 7620 (LI.CIRCLES 963 . 1266) (LI.LOAD 1268 . 2113) (LI.MAKEMENU 2115 . 3978) (
LI.SETUP 3980 . 4557) (IRIS.CREATE.ICON 4559 . 5045) (IRIS.DOMENU 5047 . 5389) (IRIS.TRY 5391 . 5964)
(LOADIRIS 5966 . 6568) (INSTALLIRIS 6570 . 6987) (LI.TRAVEL 6989 . 7618)))))
STOP