(FILECREATED "15-Mar-84 18:34:55" {INDIGO}<LOOPS>SOURCES>LOADLOOPS.;69 31089
changes to: (FNS LOADDEMO)
previous date: " 9-Mar-84 11:17:12" {INDIGO}<LOOPS>SOURCES>LOADLOOPS.;68)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT LOADLOOPSCOMS)
(RPAQQ LOADLOOPSCOMS [(* Copyright (c)
1982 by Xerox Corporation)
(* LoopsDate is set each time one makes a new LOADLOOPS file. This means that ordinary
loading (LOADLOOPS)
will get the LoopsDate from when LOADLOOPS was made. LOADLOOPS (DEBUG)
sets the date when loading.)
(E (SETQ LoopsDate (SUBSTRING (DATE)
1 9)))
(FNS INIT.KBPARC CopyFilesUsingSpecs EnterSys EnterSysForLoopsCourse EnterSysForStandAlone
EnterSysForLeesburg ForceLoadFonts LEESBURG LOADDEMO LOADLOOPS NewRelease SALEESBURG
STANDALONE TESTLOOPS TesterSystem LOADTRUCKIN LOADCOURSE UnMarkChanges WAITMS WAITPAGEFN)
(VARS DEFAULTFILESERVER IndigoReleaseDir KERNELLOOPSFILES LOOPSCOURSEDIR LOOPSFILES
SMALLLOOPSFILES TESTCOMPILEDFILES TESTFILES TESTSOURCEFILES RULESFILES ReleaseFilesSpec
TRUCKINDIR TRUCKINFILES PLAYERFILES PLAYERSDIR DEMODIR DEMOFILES LOOPSCOURSEDIR
LOOPSCOURSEFILES LOOPSCOURSEFILESDIR LispUserFilesForLoops OptionalLispuserFiles
LispUserFilesForTruckin LoopsDate LoopsPatchFiles)
(* Now set Lisp flags standardly for Loops)
(P (INIT.KBPARC))
(GLOBALVARS WaitMSTimer \FIXP)
(VARS WAITPAGEFLG (WaitMSTimer (SETUPTIMER 0)))
(* Function which allows the control key to stop scrolling on the TTYDISPLAYSTREAM)
(ADVISE PAGEFULLFN)
(* * The function SetNetwork must be modified for use on any machine which will not respond
to the function (ETHERHOSTNUMBER)
%. It is called by DB-InitUI which is called every time the user starts up. The variable
NETNUMBER is set by SetNetwork and used in generating unique ids. It is set here to 0 as a
default.)
(INITVARS (NETNUMBER 0)
(LeesburgFlg NIL)
(StandAloneFlg NIL))
(FNS SetNetwork)
(* * Some utility functions and macros we like having around)
(FNS DE FILE i/d PPI PPR LOOPSDIR PROJECTDIR)
(LISPXMACROS ok)
(USERMACROS SHOWD FV)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PPR FILE DE)
(NLAML)
(LAMA])
(* Copyright (c) 1982 by Xerox Corporation)
(* LoopsDate is set each time one makes a new LOADLOOPS file. This means that ordinary loading
(LOADLOOPS) will get the LoopsDate from when LOADLOOPS was made. LOADLOOPS (DEBUG) sets the
date when loading.)
(DEFINEQ
(INIT.KBPARC
[LAMBDA NIL (* dgb: " 8-Mar-84 23:41")
(* Initialization function for KSA)
(CHANGESLICE 100)
(RPAQQ FIXSPELLDEFAULT (QUOTE n))
(RPAQQ DWIMWAIT 30)
(RPAQQ PROMPT%#FLG T)
(RPAQQ CLISPIFYENGLSHFLG NIL)
(RPAQQ EDITCHARACTERS (J (H G)
Z Y N (O NIL))) (* Set up editor single character macros)
(RPAQQ **COMMENT**FLG " (* --) ") (* Set Lisp flgs etc.)
(RPAQQ NORMALCOMMENTSFLG T)
(RPAQQ DWIMIFYCOMPFLG T)
(RPAQQ CLEANUPOPTIONS (RC ST LIST))
(RPAQQ CLOSEBREAKWINDOWFLG ALL)
(RPAQQ AUTOBACKTRACEFLG T)
(SETQ DIRECTORIES (BQUOTE (NIL {INDIGO}<LOOPS>SOURCES> {DSK} ,. LISPUSERSDIRECTORIES)))
(* INITIALSLST is a list each of whose elements is of form -- (loginName firstName initials fileServer
printingHost) -- fileServer is defaulted to the value of DEFAULTFILESERVER if NIL, printingHost to value of
DEFAULTPRINTINGHOST. EnterLoops is the function which installs these defaults, or asks the user if no entry can be
found on INITIALSLST)
(ADDTOVAR INITIALSLST (BOBROW Danny dgb:)
(STEFIK Mark mjs:)
(TONG Chris cht:)
(GADOL Steve sg: "{PHYLUM}<GADOL>")
(BORRIELLO Gaetano gb:)
(DMRussell Dan dmr:)
(ABELL Alan agb:)
(DYM Clive cld:)
(MITTAL Sanjay sm:)
(BERLIN Danny dlsb: "{IVY}<BERLIN>LOOPS")
(YUE Kai kzy:)
(WINOGRAD Terry tw:))
T])
(CopyFilesUsingSpecs
[LAMBDA (specs toDir) (* sm: "27-SEP-83 15:12")
(* copies files specified in specs to toDir)
(* specs format: ((files dir flg) .. (files dir flg)). files -
lispvar which evals to list of files or a list of files. flg -
C compiled only. S file only. B both file and its compiled version)
(PROG (fromDir files option (status T)
copied)
[for x in specs
do [SETQ files (COND
[(LITATOM (CAR x))
[SETQ y (NLSETQ (EVALV (CAR x]
(COND
((NULL y)
(printout TTY "Cannot carryout specs: " x T)
NIL)
(T (CAR y]
(T (CAR x]
(SETQ fromDir (CADR x))
(COND
[files [SETQ option (COND
((NULL (CDDR x))
(QUOTE C))
(T (CADDR x]
(COND
((FMEMB option (QUOTE (S B)))
[SETQ copied (for z in files collect (COPYFILE (MKATOM (CONCAT fromDir z)
)
(MKATOM (CONCAT toDir z]
(COND
((FMEMB NIL copied)
(SETQ status NIL)))
(printout TTY "Copied source files: " files " from: " fromDir " to :"
toDir T)))
(COND
((FMEMB option (QUOTE (C B)))
[SETQ copied (for z in files collect (COPYFILE (MKATOM (CONCAT fromDir z
".DCOM"))
(MKATOM (CONCAT toDir z
".DCOM"]
(COND
((FMEMB NIL copied)
(SETQ status NIL)))
(printout TTY "Copied compiled files: " files " from: " fromDir " to :"
toDir T]
(T (SETQ status NIL]
(RETURN status])
(EnterSys
[LAMBDA (logInFlg) (* dgb: " 8-Mar-84 23:44")
(* Called after logout or after sysout to reinitialize
user name and file directory)
(PROG (userEntry loginHostEntry)
[COND
(LeesburgFlg (* Specialized initialization for Loops courses run in
Leesburg.)
(RETURN (EnterSysForLeesburg)))
(StandAloneFlg (* Specialized initialization for StandAlone Loops
demos.)
(RETURN (EnterSysForStandAlone]
[COND
(logInFlg (LOGIN)
(SETQ USERNAME (USERNAME NIL T]
[COND
((FMEMB (SETQ USERNAME (USERNAME NIL T))
(QUOTE (LOOPSCOURSE LOOPSCOURSE.GUEST)))
(* Special case for loops course)
(RETURN (EnterSysForLoopsCourse)))
((NOT (SETQ userEntry (FASSOC USERNAME INITIALSLST)))
(OR logInFlg (LOGIN))
(COND
((EQ (SETQ USERNAME (MKATOM (USERNAME)))
(QUOTE LOOPSCOURSE)) (* Special case for loops course)
(RETURN (EnterSysForLoopsCourse)))
((NULL (SETQ userEntry (FASSOC USERNAME INITIALSLST)))
(SETQ USERNAME (USERNAME NIL T))
(SETQ INITIALS (QUOTE edited:))
(SETQ LOGINHOST/DIR (QUOTE {DSK}))
(ERSETQ (/CNDIR LOGINHOST/DIR))
(COND
((INFILEP (QUOTE {DSK}INIT.LISP))
(GREET)))
(RETURN T]
(SETQ loginHostEntry (CADDDR userEntry))
(SETQ LOGINHOST/DIR (OR (STRINGP loginHostEntry)
(PACK* "{" (OR loginHostEntry DEFAULTFILESERVER)
"}<" USERNAME ">LISP>")))
(* If entry is a string, then it is a full host,
directory entry e.g. "{INDIGO}<KBVLSI>HGB>LISP>")
(SETQ DEFAULTPRINTINGHOST (OR (CAR (CDDDDR userEntry))
DEFAULTPRINTINGHOST))
(SETQ INITIALS (OR (CADDR userEntry)
(QUOTE edited:)))
(SETQ FIRSTNAME (CADR userEntry))
(ERSETQ (/CNDIR LOGINHOST/DIR])
(EnterSysForLoopsCourse
[LAMBDA NIL (* mjs: " 1-AUG-83 11:24")
(* Called after logout or after sysout to reinitialize
user name and file directory)
(SETQ StudentName (INTTY "What is your last name, please? " NIL))
(SETQ INITIALS (QUOTE edited:))
(SETQ FIRSTNAME (QUOTE Student))
(COND
(LOOPSCOURSEDIR (SETQ LOGINHOST/DIR (PACK* LOOPSCOURSEDIR StudentName))
(ERSETQ (/CNDIR LOGINHOST/DIR])
(EnterSysForStandAlone
[LAMBDA NIL (* sm: " 2-AUG-83 19:33")
(* * Called after logout or after sysout to reinitialize for StandAlone demo.)
(PROG NIL
(WRITE "Welcome to the Loops Demo -- STANDALONE version."])
(EnterSysForLeesburg
[LAMBDA NIL (* sm: " 3-AUG-83 13:51")
(* * Called after logout or after sysout to reinitialize for Leesburg course.)
(PROG NIL
(WRITE "Welcome to Lisp and Loops.")
GetName
(SETQ StudentName (INTTY "What is your last name, please? " NIL
"Enter your name. e.g. JONES. (Use all capitals and no spaces.)"))
(SETQ INITIALS (QUOTE edited:))
(SETQ FIRSTNAME (QUOTE Student))
(SETQ LOGINHOST/DIR (PACK* LOOPSCOURSEDIR StudentName (QUOTE >)))
(COND
((NEQ USERNAME (QUOTE LOOPSCOURSE))
(WRITE "Please LOGIN as LOOPSCOURSE and type the course password.")))
(COND
((DIRECTORYNAMEP LOGINHOST/DIR) (* Here if directory already exists for student.)
(/CNDIR LOGINHOST/DIR))
(T (* Here if directory not recognized.)
(WRITE "No directory exists yet for " LOGINHOST/DIR)
(COND
((EQ (QUOTE N)
(INTTY "Create a new directory (Y/N)? " (QUOTE (Y N))
"Type Y to create a new directory.
Type N to re-enter your last name.")) (* Here if mistyped name.)
(GO GetName))
(T (* Here to create new directory.)
(WRITE "Creating directory for " LOGINHOST/DIR)
(NSCREATEDIRECTORY LOGINHOST/DIR)
(ERSETQ (/CNDIR LOGINHOST/DIR])
(ForceLoadFonts
[LAMBDA NIL (* sm: " 3-AUG-83 13:43")
(* force different fonts to be loaded in)
(PROG NIL
(NEWFONT (QUOTE BIG))
(NEWFONT (QUOTE PARC])
(LEESBURG
[LAMBDA NIL (* sm: " 9-SEP-83 13:51")
(* * Initialize LoopsDemo for Lisp/Loops course -- offered at Leesburg.)
(* Try to force different fonts to be loaded for
isolated version)
(ForceLoadFonts)
(SETQ LeesburgFlg T)
(CHANGENAME (QUOTE \SET.TTYINBOLDFONT)
(QUOTE FONTCOPY)
(QUOTE EVQ))
(SETQ LOOPSCOURSEDIR (QUOTE {FS:}<LOOPSCOURSE>))
(SETQ LISPUSERSDIRECTORIES NIL)
(SETQ FONTDIRECTORIES NIL)
(SETQ FILELST NIL)
(SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
(SETQ USERNAME (QUOTE NotLoggedIn))
(PRINTERMODE (QUOTE INTERPRESS))
(* * Prop-load sources needed for the LOOPS part of the course.)
(* (for FILE in (QUOTE (GAUGES TRUCKINP TRUCKINV
TRUCKINDB LOOPSDEMO)) do (LOAD FILE
(QUOTE PROP))))
(SETQ DEMOFLGSETUP T)
(SETQ FILELST (QUOTE (GAUGES TRUCKINP TRUCKINV TRUCKINDB TRUCKINR LOOPSDEMO)))
(SETQ DIRECTORIES (LIST NIL (QUOTE {FS:}<LOOPS>)))
(SetUpDemo])
(LOADDEMO
[LAMBDA (sourceFlg) (* dgb: "15-Mar-84 17:55")
(* Load GAUGES on the property list so one can examine
it for the course Then load truckin and demo files)
(LOAD (QUOTE GAUGES)
(QUOTE PROP))
(OR (FMEMB DEMODIR DIRECTORIES)
(NCONC1 DIRECTORIES DEMODIR))
(LOADTRUCKIN sourceFlg)
[COND
(sourceFlg (for file in DEMOFILES do (LOAD file)))
(T (DOFILESLOAD DEMOFILES)
(LOADFNS (QUOTE Apple.SetPrice)
(QUOTE TRUCKINDB)
(QUOTE PROP))
(LOADFNS (QUOTE LightRules)
(QUOTE LOOPSDEMO)
(QUOTE PROP]
(NEWFONT (QUOTE BIG))
(NEWFONT (QUOTE PARC])
(LOADLOOPS
[LAMBDA (option sysoutFlg noScreenSetup) (* dgb: " 9-Mar-84 11:03")
(SETQ option (U-CASE option))
(COND
((EQ option (QUOTE ?))
(PRINT
"LOADLOOPS cases:
option=NIL, loads DCOM of LOOPSFILES; sets FILELST to NIL.
option=SMALL loads DCOM of LOOPSFILES not including
LOOPSDATABASE, GAUGES, or RULESFILES files
option=DEBUG loads DCOM of LOOPSFILES. option=DEMO loads DCOM files of LOOPS,DEMO and TRUCKIN,
and sets up demo screen and fonts
option=LEESBURG does a demo load, and then runs function
LEESBURG
option=SALEESBURG does a demo load, and runs SALEESBURG.
Makes a system with ALL needed stuff already loaded.
option=STANDALONE does a demo load, and then runs function
STANDALONE
option=SOURCES, then loads sources of LOOPSFILES.
option=KERNEL, loads DCOM files excluding RULESFILES.
In all above cases, EXCEPT option = KERNEL,
sets up the standard loops screen.
option=TESTER, loads LoopsTester files.
option=?, then LOADLOOPS prints this message.
If sysoutFlg=T then ends with a (SYSOUT 'LOOPS.SYSOUT)"
T)
NIL)
([NOT (FMEMB option (QUOTE (NIL SMALL SALEESBURG LEESBURG STANDALONE DEMO DEBUG SOURCES KERNEL
TESTER]
"Bad option. option can be one of NIL DEBUG SOURCES KERNEL.
For more information type
LOADLOOPS(?)")
(T (APPLY (QUOTE FILESLOAD)
(CONS (QUOTE (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES))
(APPEND LispUserFilesForLoops OptionalLispuserFiles)))
(AND LoopsPatchFiles (DOFILESLOAD LoopsPatchFiles))
(SETQ LispDate (SUBSTRING MAKESYSDATE 1 9))
[for FILE in (CDR LOOPSFILES) when (SELECTQ option
(SMALL (FMEMB FILE SMALLLOOPSFILES))
(KERNEL (FMEMB FILE KERNELLOOPSFILES))
T)
do (LOAD (PACKFILENAME (QUOTE NAME)
FILE
(QUOTE EXTENSION)
(SELECTQ option
(SOURCES NIL)
COMPILE.EXT]
(SETQ LoopsDate (SUBSTRING (DATE)
1 15))
(SELECTQ option
((DEBUG DEMO) (* Keep Loops file names in these cases.
Remember date loaded.)
(SETQ FILELST (APPEND LOOPSFILES)))
(SETQ FILELST NIL))
(COND
([AND (NULL noScreenSetup)
[NOT (FMEMB option (QUOTE (DEMO LEESBURG STANDALONE]
(OR sysoutFlg (NEQ option (QUOTE KERNEL]
(SetUpScreen)))
(COND
((FMEMB option (QUOTE (DEMO SALEESBURG LEESBURG STANDALONE)))
(LOADDEMO)
(LOADCOURSE)
(SetUpDemo)))
[COND
((NOT (MEMBER (QUOTE (DB-InitUI))
AFTERSYSOUTFORMS))
[SETQ AFTERSYSOUTFORMS (APPEND AFTERSYSOUTFORMS (LIST (QUOTE (DB-InitUI]
(SETQ AFTERLOGOUTFORMS (APPEND AFTERLOGOUTFORMS (LIST (QUOTE (DB-InitUI]
(SETQ SYSOUTGAG (LIST (QUOTE EnterSys)))
(SELECTQ option
(LEESBURG (LEESBURG))
(SALEESBURG (SALEESBURG))
(STANDALONE (STANDALONE))
(TESTER (TesterSystem))
NIL)
(UnMarkChanges) (* Don't save any record of changes that have been made
in loading)
(AND sysoutFlg (COND
((NEQ T sysoutFlg)
(/CNDIR sysoutFlg)))
(SYSOUT (COND
((EQ option (QUOTE DEMO))
(QUOTE LOOPSDEMO.SYSOUT))
((EQ option (QUOTE SMALL))
(QUOTE OOPS.SYSOUT))
(T (QUOTE LOOPS.SYSOUT])
(NewRelease
[LAMBDA (indigoPass maxcPass date) (* sm: "28-SEP-83 10:49")
(* makes a new release of Loops by copying files first
to IndigoReleaseDir and then to MaxcReleaseDir)
(* date if passed is the subdir used for
IndigoReleaseDir else current date is used)
(PROG (indigoDir sourceDir status IndigoCleanupCommd MaxcReleaseCommd)
(OR indigoPass (SETQ indigoPass (INTTY "Enter your Indigo password: ")))
(OR maxcPass (SETQ maxcPass (INTTY "Enter password for Maxc Loops directory: ")))
[COND
(date)
(T (SETQ date (SUBSTRING (GDATE)
1 9]
(SETQ sourceDir (MKATOM (CONCAT IndigoReleaseDir date ">")))
(SETQ indigoDir (MKATOM (CONCAT "{indigo}" sourceDir)))
(SETQ IndigoCleanupCommd (CONCAT "dir " sourceDir "
" "del *,
conf
" "q
"))
(CHAT (QUOTE INDIGO)
NIL IndigoCleanupCommd)
(SETQ status (CopyFilesUsingSpecs ReleaseFilesSpec indigoDir))
(COND
((NOT status)
(printout TTY "Files not copied properly to: " indigoDir T "RELEASE ABORTED!!" T)
(RETURN NIL)))
(SETQ MaxcReleaseCommd (CONCAT "1
" "CONN loops " maxcPass "
" "del *.*
" "pupftp indigo
" "log " (USERNAME)
indigoPass "
" "automatic ret " sourceDir "*
" "q
" "logout
" (CHARACTER 3)
"logout
"))
(CHAT (QUOTE MAXC)
NIL MaxcReleaseCommd])
(SALEESBURG
[LAMBDA NIL (* sm: " 9-SEP-83 13:52")
(* For making a fully standalone version for
Leesburg/AAAI)
(* * Initialize LoopsDemo for Lisp/Loops course -- offered at Leesburg.)
(* Try to force different fonts to be loaded for
isolated version)
(ForceLoadFonts)
(SETQ LeesburgFlg T)
(CHANGENAME (QUOTE \SET.TTYINBOLDFONT)
(QUOTE FONTCOPY)
(QUOTE EVQ))
(SETQ LOOPSCOURSEDIR (QUOTE {FS:}<LOOPSCOURSE>))
(SETQ LISPUSERSDIRECTORIES NIL)
(SETQ FONTDIRECTORIES NIL)
(SETQ FILELST NIL)
(SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
(SETQ USERNAME (QUOTE NotLoggedIn))
(PRINTERMODE (QUOTE INTERPRESS))
(* * Prop-load sources needed for the LOOPS part of the course.)
(for FILE in (QUOTE (GAUGES TRUCKINP TRUCKINV TRUCKINDB TRUCKINR LOOPSDEMO))
do (LOAD FILE (QUOTE PROP)))
(SETQ DEMOFLGSETUP T)
(SETQ DIRECTORIES NIL)
(SetUpDemo])
(STANDALONE
[LAMBDA NIL (* sm: " 3-AUG-83 13:43")
(* * Initialize LoopsDemo for remote Loops demos, disconnected from any network.)
(ForceLoadFonts)
(SETQ StandAloneFlg T)
(CHANGENAME (QUOTE \SET.TTYINBOLDFONT)
(QUOTE FONTCOPY)
(QUOTE EVQ))
(SETQ LISPUSERSDIRECTORIES NIL)
(SETQ FONTDIRECTORIES NIL)
(SETQ FILELST NIL)
(SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
(SETQ USERNAME (QUOTE NotLoggedIn))
(PRINTERMODE (QUOTE INTERPRESS))
(* * Prop-load sources needed for possible use in a demo.)
(for FILE in (QUOTE (GAUGES TRUCKINP TRUCKINV TRUCKINDB LOOPSDEMO)) do (LOAD FILE (QUOTE PROP)))
(SETQ DIRECTORIES NIL])
(TESTLOOPS
[LAMBDA (SOURCESFLG) (* dgb: "26-MAY-83 16:45")
(* Load tester -- use symbolics if SOURCEFLG=T and run
test once)
[COND
(SOURCESFLG (PROGN (for x in (QUOTE (LTBASIC LTKER LTDB LTCASES)) do (LOAD x))
(SETQ LTLOADEDREST T)))
(T (LOAD (QUOTE LTBASIC.DCOM]
(TestForever 0])
(TesterSystem
[LAMBDA NIL (* sm: " 5-AUG-83 10:13")
(* * Initialize LoopsDemo for Lisp/Loops course -- offered at Leesburg.)
(* Try to force different fonts to be loaded for
isolated version)
(ForceLoadFonts)
(LOAD (QUOTE {PHYLUM}<LISPCORE>SOURCES>FILEBROWSER.DCOM))
(SETQ FILELST NIL)
(LOAD (QUOTE LTBASIC.DCOM))
(LoadLTSystemCI)
(LOAD (QUOTE LTCASES))
(SETQ LeesburgFlg T)
(CHANGENAME (QUOTE \SET.TTYINBOLDFONT)
(QUOTE FONTCOPY)
(QUOTE EVQ))
(SETQ LOOPSCOURSEDIR (QUOTE {FS:}<LOOPSCOURSE>))
(SETQ LISPUSERSDIRECTORIES NIL)
(SETQ FONTDIRECTORIES NIL)
(SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
(SETQ USERNAME (QUOTE NotLoggedIn))
(PRINTERMODE (QUOTE INTERPRESS))
(SETQ DEMOFLGSETUP T)
(SETQ DIRECTORIES (LIST NIL (QUOTE {FS:}<LOOPS>])
(LOADTRUCKIN
[LAMBDA (sourceFlg) (* sm: " 9-SEP-83 12:53")
(PROG NIL
(* * Load the necessary files.)
(APPLY (QUOTE FILESLOAD)
(CONS (QUOTE (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES))
LispUserFilesForTruckin))
[OR (FMEMB PLAYERSDIR DIRECTORIES)
(COND
((NULL DIRECTORIES)
(SETQ DIRECTORIES (LIST PLAYERSDIR)))
(T (RPLACD DIRECTORIES (CONS PLAYERSDIR (CDR DIRECTORIES]
[OR (FMEMB TRUCKINDIR DIRECTORIES)
(COND
((NULL DIRECTORIES)
(SETQ DIRECTORIES (LIST TRUCKINDIR)))
(T (RPLACD DIRECTORIES (CONS TRUCKINDIR (CDR DIRECTORIES]
(COND
(sourceFlg (for F in TRUCKINFILES do (LOAD F)))
(T (DOFILESLOAD TRUCKINFILES))) (* (LOAD (QUOTE LOOPSGATEWAY.DCOM)))
(* * Initialize the game.)
(InitializeTruckin)
(* * Load the Truckin Player files.)
(COND
(sourceFlg (for F in PLAYERFILES do (LOAD F)))
(T (DOFILESLOAD PLAYERFILES)))
(RETURN NIL])
(LOADCOURSE
[LAMBDA NIL (* sm: " 9-SEP-83 17:03")
(* loads the files needed for the lisp part of the
loops/lisp course)
(PROG NIL
[SETQ DIRECTORIES (CONS NIL (CONS LOOPSCOURSEFILESDIR (CDR DIRECTORIES]
(* * Load exercises for the Lisp part of the course.)
(for FILE in LOOPSCOURSEFILES do (LOAD FILE])
(UnMarkChanges
[LAMBDA (FILES) (* dgb: " 9-Mar-84 11:16")
(* * Unmark all changes that have been made and forget files to list and compile)
(PROG (COMTYPE)
(SETQ NOTLISTEDFILES NIL)
(SETQ NOTCOMPILEDFILES NIL)
[for COM in (MakeChangeComs (QUOTE OLDCHANGES)
FILES)
do (COND
((NEQ (SETQ COMTYPE (CAR COM))
(QUOTE *))
(for ITEM in (CDR COM) do (UNMARKASCHANGED ITEM COMTYPE]
(RETURN OLDCHANGES])
(WAITMS
[LAMBDA (numMS) (* sm: " 9-AUG-83 02:33")
(forDuration (ITIMES numMS \RCLKMILLISECOND) timerUnits (QUOTE TICKS) usingTimer WaitMSTimer
do NIL)
T])
(WAITPAGEFN
[LAMBDA NIL (* dgb: " 7-JUN-82 11:46")
(PROG NIL
LP (COND
((KEYDOWNP (QUOTE CTRL)) (* WAIT IF THE CTRL KEY IS DOWN)
(COND
((KEYDOWNP (QUOTE LSHIFT)) (* Hold page using ordinary page full fn if no
typeahead)
(RETURN NIL)))
(GO LP)))
(COND
(WAITPAGEFLG (* Use ordinary function if WAITPAGEFLG is T)
(RETURN NIL)))
(RETURN T])
)
(RPAQQ DEFAULTFILESERVER IVY)
(RPAQQ IndigoReleaseDir <loops>release>)
(RPAQQ KERNELLOOPSFILES (LOADLOOPS BLOCKLOOKUP LOOPSSCREEN LOOPSSTRUC LOOPSPRINT LOOPSACCESS LOOPSUID
LOOPSAV LOOPSEDIT LOOPSMETHODS LOOPSKERNEL LOOPSUTILITY LOOPSMIXIN
LOOPSDATABASE LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE GAUGES))
(RPAQQ LOOPSCOURSEDIR "{IVY}<LOOPSCOURSE>")
(RPAQQ LOOPSFILES (LOADLOOPS BLOCKLOOKUP LOOPSSCREEN LOOPSSTRUC LOOPSPRINT LOOPSACCESS LOOPSUID
LOOPSAV LOOPSEDIT LOOPSMETHODS LOOPSKERNEL LOOPSUTILITY LOOPSMIXIN
LOOPSDATABASE LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE LOOPSRULES
LOOPSRULESP LOOPSRULESC LOOPSRULESD GAUGES))
(RPAQQ SMALLLOOPSFILES (LOADLOOPS BLOCKLOOKUP LOOPSSCREEN LOOPSSTRUC LOOPSPRINT LOOPSACCESS LOOPSUID
LOOPSAV LOOPSEDIT LOOPSMETHODS LOOPSKERNEL LOOPSUTILITY LOOPSMIXIN
LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE))
(RPAQQ TESTCOMPILEDFILES (LTBASIC LTBCLS LTCASES LTDB LTKER LTLOAD))
(RPAQQ TESTFILES (LTBASIC LTBCLS LTCASES LTDB LTKER LTLOAD LT1.KB))
(RPAQQ TESTSOURCEFILES (LT1.KB))
(RPAQQ RULESFILES (LOOPSRULES LOOPSRULESP LOOPSRULESC LOOPSRULESD))
(RPAQQ ReleaseFilesSpec ((LOOPSFILES {indigo}<LOOPS>SOURCES> B)
(TRUCKINFILES {indigo}<loops>truckin>multi> C)
(PLAYERFILES {indigo}<loops>truckin>multi> B)
(DEMOFILES {indigo}<LOOPS>demo> B)
(TESTSOURCEFILES {indigo}<LOOPS>SOURCES> S)
(TESTCOMPILEDFILES {indigo}<LOOPS>SOURCES> B)))
(RPAQQ TRUCKINDIR {INDIGO}<LOOPS>TRUCKIN>MULTI)
(RPAQQ TRUCKINFILES (TRUCKIN TRUCKINM TRUCKINR TRUCKINI TRUCKINDB TRUCKINP TRUCKINV LOOPSGATEWAY))
(RPAQQ PLAYERFILES (TRAVELER PEDDLER PLANNER))
(RPAQQ PLAYERSDIR {INDIGO}<LOOPS>TRUCKIN>MULTI)
(RPAQQ DEMODIR {INDIGO}<LOOPS>DEMO>)
(RPAQQ DEMOFILES (LOOPSDEMO))
(RPAQQ LOOPSCOURSEDIR "{IVY}<LOOPSCOURSE>")
(RPAQQ LOOPSCOURSEFILES (EXERCISE1 SIMPLEG TRANSLATE DEMOSCRIPT))
(RPAQQ LOOPSCOURSEFILESDIR {INDIGO}<LOOPS>COURSE>)
(RPAQQ LispUserFilesForLoops (GRAPHER ICONW TTY HISTMENU TMENU INMENU READNUMBER ANIMATE))
(RPAQQ OptionalLispuserFiles (SINGLEFILEINDEX PATCHUP BROWSER))
(RPAQQ LispUserFilesForTruckin (EVALSERVER LLCOLOR COLOR))
(RPAQQ LoopsDate "15-Mar-84")
(RPAQQ LoopsPatchFiles NIL)
(* Now set Lisp flags standardly for Loops)
(INIT.KBPARC)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS WaitMSTimer \FIXP)
)
(RPAQQ WAITPAGEFLG NIL)
(RPAQ WaitMSTimer (SETUPTIMER 0))
(* Function which allows the control key to stop scrolling on the TTYDISPLAYSTREAM)
(PUTPROPS PAGEFULLFN READVICE [NIL (BEFORE NIL (COND ((WAITPAGEFN)
(RETURN T])
(READVISE PAGEFULLFN)
(* * The function SetNetwork must be modified for use on any machine which will not respond to
the function (ETHERHOSTNUMBER) %. It is called by DB-InitUI which is called every time the user
starts up. The variable NETNUMBER is set by SetNetwork and used in generating unique ids. It
is set here to 0 as a default.)
(RPAQ? NETNUMBER 0)
(RPAQ? LeesburgFlg NIL)
(RPAQ? StandAloneFlg NIL)
(DEFINEQ
(SetNetwork
[LAMBDA NIL (* edited: " 6-JUL-83 17:07")
(* Fn to set the NETNUMBER. This is a 14-bit number used in generating unique identifiers in LOOPS..
This number should be unique across machines whose users intend to share knowledge bases.)
(PROG (etherHostNumber)
(SETQ etherHostNumber (ETHERHOSTNUMBER))
(COND
((ZEROP etherHostNumber)
(HELPCHECK
"Help -- The ETHERHOSTNUMBER is zero. LOOPS uses this number to make unique identifiers."))
(T (SETQ NETNUMBER (RSH (ETHERHOSTNUMBER)
8])
)
(* * Some utility functions and macros we like having around)
(DEFINEQ
(DE
[NLAMBDA L (* dgb: "26-JUN-83 12:37")
(* Shorthand for defining functions.)
(DEFINE (COND
((LISTP (CAR L))
L)
(T (LIST L)))
T])
(FILE
[NLAMBDA ARGS (* dgb: "26-JUN-83 12:38")
(* * Allows one to create a file giving the commands explicitly e.g. -
(FILE FOO (VARS * FUMVARS) (FNS * FNSLIST)) -
will create FOOCOMS and make file FOO)
[COND
((CDR ARGS)
(/SETATOMVAL (FILECOMS (CAR ARGS))
(COND
((AND (LITATOM (CADR ARGS))
(NULL (CDDR ARGS)))
(GETATOMVAL (CADR ARGS)))
(T (CDR ARGS]
(RESETFORM (RADIX 10)
(MAKEFILE (CAR ARGS])
(i/d
[LAMBDA (item) (* dgb: " 3-DEC-82 01:46")
(* short form of call)
(INSPECT/DATATYPE item])
(PPI
[LAMBDA (INSTANCE RECORDNAME FILE) (* dgb: " 3-DEC-82 01:46")
(* Pretty-prints an instance of a record.)
(PROG [(POS (ADD1 (POSITION FILE)))
(DEC (RECLOOK (OR RECORDNAME (COND
((LISTP INSTANCE)
(CAR INSTANCE))
(T (TYPENAME INSTANCE]
(COND
(DEC (printout FILE "[" %# (for FIELD in (RECORDFIELDNAMES DEC)
unless (EQ FIELD (QUOTE PERFORMOPS))
do (printout NIL .TAB0 POS .P2 FIELD " = " .PPV
(RECORDACCESS FIELD INSTANCE DEC)))
"]" T))
(T (printout FILE .PPV INSTANCE T])
(PPR
[NLAMBDA X (* dgb: " 3-DEC-82 01:47")
(* Prettyprints the record definition of record name
given.)
(RESETFORM (OUTPUT T)
(MAPC (OR (LISTP X)
(LIST X))
(FUNCTION (LAMBDA (R)
[PRINTDEF (OR (APPEND (RECLOOK R)
(FIELDLOOK R))
(CONS R (QUOTE (not found]
(TERPRI T])
(LOOPSDIR
[LAMBDA (SUBDIR) (* dgb: " 8-JUN-83 11:16")
(* * Connects to the directory for saving LOOPS sources.)
(/CNDIR (PACK* (QUOTE {INDIGO}<LOOPS>)
(OR SUBDIR (QUOTE SOURCES])
(PROJECTDIR
[LAMBDA (subDirectory) (* mjs: "14-JUL-82 16:47")
(/CNDIR (CONCAT (QUOTE {INDIGO}<KBVLSI>)
(OR subDirectory (QUOTE LISP))
(QUOTE >])
)
(ADDTOVAR LISPXMACROS (ok (RETFROM (OR (STKPOS (QUOTE USEREXEC))
(QUOTE LISPX))
T T)))
(ADDTOVAR EDITMACROS [SHOWD
NIL UP (ORR ((E (RESETFORM (OUTPUT T)
(PROGN (PRINTDEF (OR [EDITGETD (%#%# 1)
(AND (CDR L)
(EDITL0 L (QUOTE (!0]
(ERROR!))
NIL T)
(TERPRI)))
T))
((E (QUOTE SHOWD?]
(FV NIL (E (FREEVARS (%#%# (ORR (UP 1)
NIL))
T))))
(ADDTOVAR EDITCOMSA SHOWD FV)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PPR FILE DE)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS LOADLOOPS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2566 23873 (INIT.KBPARC 2576 . 4169) (CopyFilesUsingSpecs 4171 . 5876) (EnterSys 5878
. 8082) (EnterSysForLoopsCourse 8084 . 8641) (EnterSysForStandAlone 8643 . 8940) (EnterSysForLeesburg
8942 . 10447) (ForceLoadFonts 10449 . 10745) (LEESBURG 10747 . 11946) (LOADDEMO 11948 . 12691) (
LOADLOOPS 12693 . 15982) (NewRelease 15984 . 17553) (SALEESBURG 17555 . 18717) (STANDALONE 18719 .
19485) (TESTLOOPS 19487 . 19933) (TesterSystem 19935 . 20898) (LOADTRUCKIN 20900 . 22009) (LOADCOURSE
22011 . 22504) (UnMarkChanges 22506 . 23065) (WAITMS 23067 . 23305) (WAITPAGEFN 23307 . 23871)) (26992
27633 (SetNetwork 27002 . 27631)) (27702 30367 (DE 27712 . 27991) (FILE 27993 . 28532) (i/d 28534 .
28751) (PPI 28753 . 29438) (PPR 29440 . 29899) (LOOPSDIR 29901 . 30157) (PROJECTDIR 30159 . 30365))))
)
STOP