644 lines
17 KiB
Plaintext
644 lines
17 KiB
Plaintext
"MISC for
|
||
|
||
ZORK ZERO
|
||
(c) Copyright 1988 Infocom, Inc. All Rights Reserved."
|
||
|
||
<BEGIN-SEGMENT 0>
|
||
|
||
<INCLUDE "PDEFS">
|
||
|
||
;"macros"
|
||
|
||
<TELL-TOKENS (CRLF CR) <CRLF>
|
||
;[D ,SIDEKICK <DPRINT-SIDEKICK>]
|
||
D * <DPRINT .X>
|
||
A * <APRINT .X>
|
||
T ,PRSO <TPRINT-PRSO>
|
||
T ,PRSI <TPRINT-PRSI>
|
||
T * <TPRINT .X>
|
||
AR * <ARPRINT .X>
|
||
TR * <TRPRINT .X>
|
||
N * <PRINTN .X>
|
||
C * <PRINTC .X>
|
||
T-IS-ARE * <IS-ARE-PRINT .X>>
|
||
|
||
<DEFMAC VERB? ("ARGS" ATMS)
|
||
<MULTIFROB PRSA .ATMS>>
|
||
|
||
<DEFMAC PRSO? ("ARGS" ATMS)
|
||
<MULTIFROB PRSO .ATMS>>
|
||
|
||
<DEFMAC PRSI? ("ARGS" ATMS)
|
||
<MULTIFROB PRSI .ATMS>>
|
||
|
||
<DEFMAC ROOM? ("ARGS" ATMS)
|
||
<MULTIFROB HERE .ATMS>>
|
||
|
||
<DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM)
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS>
|
||
<RETURN!- <COND (<LENGTH? .OO 1> <ERROR .X>)
|
||
(<LENGTH? .OO 2> <NTH .OO 2>)
|
||
(ELSE <CHTYPE .OO FORM>)>>)>
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS> <RETURN!->)>
|
||
<SET ATM <NTH .ATMS 1>>
|
||
<SET L
|
||
(<COND (<TYPE? .ATM ATOM>
|
||
<CHTYPE <COND (<==? .X PRSA>
|
||
<PARSE
|
||
<STRING "V?"
|
||
<SPNAME .ATM>>>)
|
||
(ELSE .ATM)> GVAL>)
|
||
(ELSE .ATM)>
|
||
!.L)>
|
||
<SET ATMS <REST .ATMS>>
|
||
<COND (<==? <LENGTH .L> 3> <RETURN!->)>>
|
||
<SET O <REST <PUTREST .O
|
||
(<FORM EQUAL? <CHTYPE .X GVAL> !.L>)>>>
|
||
<SET L ()>>>
|
||
|
||
<DEFMAC BSET ('OBJ "ARGS" BITS)
|
||
<MULTIBITS FSET .OBJ .BITS>>
|
||
|
||
<DEFMAC BCLEAR ('OBJ "ARGS" BITS)
|
||
<MULTIBITS FCLEAR .OBJ .BITS>>
|
||
|
||
<DEFMAC BSET? ('OBJ "ARGS" BITS)
|
||
<MULTIBITS FSET? .OBJ .BITS>>
|
||
|
||
<DEFINE MULTIBITS (X OBJ ATMS "AUX" (O ()) ATM)
|
||
<REPEAT ()
|
||
<COND (<EMPTY? .ATMS>
|
||
<RETURN!- <COND (<LENGTH? .O 1>
|
||
<NTH .O 1>)
|
||
(<EQUAL? .X FSET?>
|
||
<FORM OR !.O>)
|
||
(ELSE
|
||
<FORM PROG () !.O>)>>)>
|
||
<SET ATM <NTH .ATMS 1>>
|
||
<SET ATMS <REST .ATMS>>
|
||
<SET O
|
||
(<FORM .X
|
||
.OBJ
|
||
<COND (<TYPE? .ATM FORM> .ATM)
|
||
(ELSE <FORM GVAL .ATM>)>>
|
||
!.O)>>>
|
||
|
||
<DEFMAC PROB ('BASE?)
|
||
<FORM NOT <FORM L? .BASE? '<RANDOM 100>>>>
|
||
|
||
;"PICK-NEXT expects an LTABLE of strings, with an initial element of 2."
|
||
;<ROUTINE PICK-NEXT (TBL "AUX" CNT STR)
|
||
<SET CNT <GET .TBL 1>>
|
||
<SET STR <GET .TBL .CNT>>
|
||
<INC CNT>
|
||
<COND (<G? .CNT <GET .TBL 0>>
|
||
<SET CNT 2>)>
|
||
<PUT .TBL 1 .CNT>
|
||
<RETURN .STR>>
|
||
|
||
<ROUTINE PICK-ONE (TBL "AUX" LENGTH CNT RND MSG RFROB)
|
||
<SET LENGTH <GET .TBL 0>>
|
||
<SET CNT <GET .TBL 1>>
|
||
<SET LENGTH <- .LENGTH 1>>
|
||
<SET TBL <REST .TBL 2>>
|
||
<SET RFROB <REST .TBL <* .CNT 2>>>
|
||
<SET RND <RANDOM <- .LENGTH .CNT>>>
|
||
<SET MSG <GET .RFROB .RND>>
|
||
<PUT .RFROB .RND <GET .RFROB 1>>
|
||
<PUT .RFROB 1 .MSG>
|
||
<SET CNT <+ .CNT 1>>
|
||
<COND (<==? .CNT .LENGTH>
|
||
<SET CNT 0>)>
|
||
<PUT .TBL 0 .CNT>
|
||
.MSG>
|
||
|
||
<ROUTINE DPRINT (OBJ)
|
||
<COND (<AND <GETP .OBJ ,P?INANIMATE-DESC>
|
||
<NOT <FSET? .OBJ ,ANIMATEDBIT>>>
|
||
<TELL <GETP .OBJ ,P?INANIMATE-DESC>>)
|
||
(<GETP .OBJ ,P?SDESC>
|
||
<TELL <GETP .OBJ ,P?SDESC>>)
|
||
(T
|
||
<PRINTD .OBJ>)>>
|
||
|
||
<ROUTINE APRINT (OBJ "OPT" (NOSP <>) "AUX" LEN)
|
||
<COND (<NOT .NOSP>
|
||
<TELL !\ >)>
|
||
<COND (<AND <SET LEN <GET-OWNER .OBJ>>
|
||
<NOT <EQUAL? .LEN <GETP .OBJ ,P?OWNER>>>>
|
||
<COND (<EQUAL? .LEN ,PROTAGONIST>
|
||
<TELL "your ">)
|
||
(<NOT <EQUAL? .LEN .OBJ>>
|
||
<APRINT .LEN T>
|
||
<TELL "'s ">)>)
|
||
(<NOT <FSET? .OBJ ,NARTICLEBIT>>
|
||
<COND (<FSET? .OBJ ,VOWELBIT>
|
||
<TELL "an ">)
|
||
(T
|
||
<TELL "a ">)>)>
|
||
<DPRINT .OBJ>>
|
||
|
||
<ROUTINE TPRINT (OBJ "OPT" (NOSP <>) "AUX" LEN)
|
||
<COND (<NOT .NOSP>
|
||
<TELL !\ >)>
|
||
<COND (<AND <SET LEN <GET-OWNER .OBJ>>
|
||
<NOT <EQUAL? .LEN <GETP .OBJ ,P?OWNER>>>>
|
||
<COND (<EQUAL? .LEN ,PROTAGONIST>
|
||
<TELL "your ">)
|
||
(<NOT <EQUAL? .LEN .OBJ>>
|
||
<TPRINT .LEN T>
|
||
<TELL "'s ">)>)
|
||
(<NOT <FSET? .OBJ ,NARTICLEBIT>>
|
||
<TELL "the ">)>
|
||
<DPRINT .OBJ>>
|
||
|
||
<ROUTINE TPRINT-PRSO ()
|
||
<TPRINT ,PRSO>>
|
||
|
||
<ROUTINE TPRINT-PRSI ()
|
||
<TPRINT ,PRSI>>
|
||
|
||
<ROUTINE ARPRINT (OBJ)
|
||
<APRINT .OBJ>
|
||
<TELL ,PERIOD-CR>>
|
||
|
||
<ROUTINE TRPRINT (OBJ)
|
||
<TPRINT .OBJ>
|
||
<TELL ,PERIOD-CR>>
|
||
|
||
<ROUTINE IS-ARE-PRINT (OBJ)
|
||
<COND (<FSET? .OBJ ,NARTICLEBIT>
|
||
<TELL " ">)
|
||
(T
|
||
<TELL " the ">)>
|
||
<DPRINT .OBJ>
|
||
<COND (<FSET? .OBJ ,PLURALBIT>
|
||
<TELL " are ">)
|
||
(T
|
||
<TELL " is ">)>>
|
||
|
||
|
||
;<ROUTINE CLEAR-SCREEN ("AUX" (CNT 24))
|
||
<REPEAT ()
|
||
<CRLF>
|
||
<SET CNT <- .CNT 1>>
|
||
<COND (<0? .CNT>
|
||
<RETURN>)>>>
|
||
|
||
<REPLACE-DEFINITION VERB-ALL-TEST
|
||
<ROUTINE VERB-ALL-TEST (OO II "AUX" (L <LOC .OO>))
|
||
;"RTRUE if OO should be included in the ALL, otherwise RFALSE"
|
||
<COND (<EQUAL? .OO ,ROOMS ;,NOT-HERE-OBJECT>
|
||
<SETG P-NOT-HERE <+ ,P-NOT-HERE 1>>
|
||
<RFALSE>)
|
||
(<AND <VERB? TAKE> ;"TAKE prso FROM prsi and prso isn't in prsi"
|
||
<T? .II>
|
||
<NOT <IN? .OO .II>>>
|
||
<RFALSE>)
|
||
;(<NOT <ACCESSIBLE? .OO>> ;"can't get at object"
|
||
<RFALSE>)
|
||
(T ;<EQUAL? ,P-GETFLAGS ,P-ALL> ;"cases for ALL"
|
||
<COND (<AND .II
|
||
<PRSO? .II>>
|
||
<RFALSE>)
|
||
(<VERB? TAKE>
|
||
;"TAKE ALL and object not accessible or takeable"
|
||
<COND (<AND <NOT <FSET? .OO ,TAKEBIT>>
|
||
<NOT <FSET? .OO ,TRYTAKEBIT>>>
|
||
<RFALSE>)
|
||
(<FSET? .OO ,NALLBIT>
|
||
<RFALSE>)
|
||
;(<AND <NOT <EQUAL? .L ,WINNER ,HERE .II>>
|
||
<NOT <EQUAL? .L <LOC ,WINNER>>>>
|
||
<COND (<AND <FSET? .L ,SURFACEBIT>
|
||
<NOT <FSET? .L ,TAKEBIT>>> ;"tray"
|
||
<RTRUE>)
|
||
(T
|
||
<RFALSE>)>)
|
||
(<AND <NOT .II>
|
||
<ULTIMATELY-IN? .OO>> ;"already have it"
|
||
<RFALSE>)
|
||
(T
|
||
<RTRUE>)>)
|
||
(<AND <VERB? DROP PUT PUT-ON GIVE SGIVE>
|
||
;"VERB ALL, object not held"
|
||
<NOT <IN? .OO ,WINNER>>>
|
||
<RFALSE>)
|
||
(<AND <VERB? PUT PUT-ON> ;"PUT ALL IN X,obj already in x"
|
||
<NOT <IN? .OO ,WINNER>>
|
||
<ULTIMATELY-IN? .OO .II>>
|
||
<RFALSE>)
|
||
(<AND <VERB? WEAR>
|
||
<OR <FSET? .OO ,WORNBIT>
|
||
<NOT <FSET? .OO ,WEARBIT>>>>
|
||
;"try to wear only wearable-but-not-yet-worn objects"
|
||
<RFALSE>)
|
||
(<EQUAL? .OO .II>
|
||
;"i.e. PUT ALL IN BOX shouldn't try to put box in box"
|
||
<RFALSE>)
|
||
(T
|
||
<RTRUE>)>)>>>
|
||
|
||
;<GLOBAL FIRST-BUFFER <ITABLE BYTE 100>>
|
||
|
||
;<ROUTINE SAVE-INPUT (TBL "AUX" (OFFS 0) CNT TMP)
|
||
<SET CNT <+ <GETB ,P-LEXV <SET TMP <* 4 ,P-INPUT-WORDS>>>
|
||
<GETB ,P-LEXV <+ .TMP 1>>>>
|
||
<COND (<EQUAL? .CNT 0> ;"failed"
|
||
<RFALSE>)>
|
||
<SET CNT <- .CNT 1>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .OFFS .CNT>
|
||
<PUTB .TBL .OFFS 0>
|
||
<RETURN>)
|
||
(T
|
||
<PUTB .TBL .OFFS <GETB ,P-INBUF <+ .OFFS 1>>>)>
|
||
<SET OFFS <+ .OFFS 1>>>
|
||
<RTRUE>>
|
||
|
||
;<ROUTINE RESTORE-INPUT (TBL "AUX" CHR)
|
||
<REPEAT ()
|
||
<COND (<EQUAL? <SET CHR <GETB .TBL 0>> 0>
|
||
<RETURN>)
|
||
(T
|
||
<PRINTC .CHR>
|
||
<SET TBL <REST .TBL>>)>>>
|
||
|
||
<REPLACE-DEFINITION GAME-VERB?
|
||
<ROUTINE GAME-VERB? () ;"should the verb not run the clock?"
|
||
<COND (<VERB? $RECORD $UNRECORD $COMMAND $RANDOM $VERIFY $REFRESH
|
||
SAVE RESTORE RESTART QUIT SCRIPT UNSCRIPT
|
||
BRIEF SUPERBRIEF VERBOSE VERSION CREDITS
|
||
NOTIFY HINT COLOR SCORE TIME MAP DEFINE MODE>
|
||
<RTRUE>)>>>
|
||
|
||
<ROUTINE THIS-IS-IT (OBJ)
|
||
<COND (<OR <AND <VERB? WALK>
|
||
<PRSO? .OBJ>> ;"PRSO is a direction"
|
||
<EQUAL? .OBJ <> ,ROOMS ;,NOT-HERE-OBJECT ,ME ,PROTAGONIST>>
|
||
<RTRUE>)
|
||
(<DONT-IT .OBJ ,LOBSTER ,W?NUTCRACKER>
|
||
;"or else FIND NUTCRACKER followed by TAKE IT returns
|
||
[But the lobster isn't here!]"
|
||
<RTRUE>)
|
||
(<DONT-IT .OBJ ,SNAKE ,W?ROPE>
|
||
<RTRUE>)
|
||
(<FSET? .OBJ ,FEMALEBIT>
|
||
<COND (<NOT <EQUAL? ,P-HER-OBJECT .OBJ>>
|
||
<FCLEAR ,HER ,TOUCHBIT>)>
|
||
<SETG P-HER-OBJECT .OBJ>)
|
||
(<OR <FSET? .OBJ ,ACTORBIT>
|
||
<EQUAL? .OBJ ,LITTLE-FUNGUS>>
|
||
<COND (<NOT <EQUAL? ,P-HIM-OBJECT .OBJ>>
|
||
<FCLEAR ,HIM ,TOUCHBIT>)>
|
||
<SETG P-HIM-OBJECT .OBJ>
|
||
<COND (<NOT <EQUAL? .OBJ ,JESTER ,EXECUTIONER>>
|
||
;"basically, animals"
|
||
<COND (<NOT <EQUAL? ,P-IT-OBJECT .OBJ>>
|
||
<FCLEAR ,IT ,TOUCHBIT>)>
|
||
<SETG P-IT-OBJECT .OBJ>)>)
|
||
(T
|
||
<COND (<NOT <EQUAL? ,P-IT-OBJECT .OBJ>>
|
||
<FCLEAR ,IT ,TOUCHBIT>)>
|
||
<SETG P-IT-OBJECT .OBJ>)>>
|
||
|
||
<ROUTINE DONT-IT (OBJ1 OBJ2 WRD)
|
||
<COND (<AND <EQUAL? .OBJ1 .OBJ2>
|
||
<NOUN-USED? .OBJ2 .WRD>
|
||
<FSET? .OBJ2 ,ANIMATEDBIT>
|
||
<NOT <VISIBLE? .OBJ2>>>
|
||
<RTRUE>)
|
||
(T
|
||
<RFALSE>)>>
|
||
|
||
;<REPLACE-DEFINITION NUMBER?
|
||
;"from suspect"
|
||
|
||
<GLOBAL P-EXCHANGE 0>
|
||
|
||
<ROUTINE NUMBER? (PTR "AUX" CNT BPTR CHR (SUM 0) (TIM <>) (EXC <>))
|
||
<SET CNT <GETB <REST ,P-LEXV <* .PTR 2>> 2>>
|
||
<SET BPTR <GETB <REST ,P-LEXV <* .PTR 2>> 3>>
|
||
<REPEAT ()
|
||
<COND (<L? <SET CNT <- .CNT 1>> 0>
|
||
<RETURN>)
|
||
(T
|
||
<SET CHR <GETB ,P-INBUF .BPTR>>
|
||
<COND (<==? .CHR 58>
|
||
<COND (.EXC
|
||
<RFALSE>)>
|
||
<SET TIM .SUM>
|
||
<SET SUM 0>)
|
||
(<==? .CHR 45 %<ASCII !\/>>
|
||
<COND (.TIM
|
||
<RFALSE>)>
|
||
<SET EXC .SUM>
|
||
<SET SUM 0>)
|
||
(<G? .SUM 9999>
|
||
<RFALSE>)
|
||
(<AND <L? .CHR 58>
|
||
<G? .CHR 47>>
|
||
<SET SUM <+ <* .SUM 10> <- .CHR 48>>>)
|
||
(T
|
||
<RFALSE>)>
|
||
<SET BPTR <+ .BPTR 1>>)>>
|
||
<PUT ,P-LEXV .PTR ,W?NUMBER>
|
||
<COND (<G? .SUM 9999>
|
||
<RFALSE>)
|
||
(.EXC
|
||
<SETG P-EXCHANGE .EXC>)
|
||
(.TIM
|
||
<SETG P-EXCHANGE 0>
|
||
<COND (<G? .TIM 23>
|
||
<RFALSE>)
|
||
(<G? .TIM 19>
|
||
T)
|
||
(<G? .TIM 12>
|
||
<RFALSE>)
|
||
(<G? .TIM 7>
|
||
T)
|
||
(T
|
||
<SET TIM <+ 12 .TIM>>)>
|
||
<SET SUM <+ .SUM <* .TIM 60>>>)
|
||
(T
|
||
<SETG P-EXCHANGE 0>)>
|
||
<SETG P-NUMBER .SUM>
|
||
,W?NUMBER>>
|
||
|
||
<GLOBAL P-NUMBER 0>
|
||
|
||
<ROUTINE PERFORM-PRSA ("OPTIONAL" (O <>) (I <>))
|
||
<PERFORM ,PRSA .O .I>
|
||
<RTRUE>>
|
||
|
||
;<ROUTINE CANT-USE (PTR "AUX" BUF)
|
||
<TELL "[You used the word \"">
|
||
<WORD-PRINT <GETB <REST ,P-LEXV <SET BUF <* .PTR 2>>> 2>
|
||
<GETB <REST ,P-LEXV .BUF> 3>>
|
||
<TELL "\" in a way that I don't understand.]" CR>
|
||
;<SETG QUOTE-FLAG <>>
|
||
<SETG P-OFLAG <>>>
|
||
|
||
<REPLACE-DEFINITION CAPITAL-NOUN?
|
||
<ROUTINE CAPITAL-NOUN? (WRD "AUX" TBL)
|
||
<COND (<EQUAL? .WRD ,W?FLATHEAD ,W?DIMWIT ,W?URSULA ,W?MEGABOZ ,W?JOHN
|
||
,W?PIERPONT ,W?STONEWALL ,W?LUCREZIA ,W?SEBASTIAN
|
||
,W?DAVISON ,W?THOMAS ,W?ALVA ,W?LEONARDO ,W?JOHANN
|
||
,W?RALPH ,W?PAUL ,W?FRANK ,W?LLOYD ,W?BABE ,W?ZILBO
|
||
,W?MERETZKY ,W?FOOBUS ,W?BARBAZZO ,W?FERNAP
|
||
,W?MUMBERTHRAX ,W?BOZBO ,W?MUMBO ,W?PHLOID ,W?BELWIT>
|
||
<RTRUE>)
|
||
(<AND <SET TBL <GETPT ,SAINTS ,P?SYNONYM>>
|
||
<INTBL? .WRD .TBL </ <PTSIZE .TBL> 2>>>
|
||
<RTRUE>)
|
||
(<INTBL? .WRD ,FUNGUS-WORDS 12>
|
||
<RTRUE>)
|
||
(<INTBL? .WRD ,MID-NAME-WORDS 12>
|
||
<RTRUE>)
|
||
(T
|
||
<RFALSE>)>>>
|
||
|
||
<REPLACE-DEFINITION LIT?
|
||
<ROUTINE LIT? ("OPT" (RM <>) (RMBIT T) "AUX" OHERE (LIT <>) (RES ,SEARCH-RES))
|
||
<COND (<AND <EQUAL? ,HERE ,UNDERWATER ,LAKE-BOTTOM>
|
||
<NOT <FSET? ,EXTERIOR-LIGHT ,ONBIT>>>
|
||
<RFALSE>)>
|
||
<COND (<NOT .RM>
|
||
<SET RM ,HERE>)>
|
||
<SET OHERE ,HERE>
|
||
<SETG HERE .RM>
|
||
<COND (<AND .RMBIT
|
||
<FSET? .RM ,ONBIT>>
|
||
<SET LIT ,HERE>)
|
||
(<AND <FSET? ,WINNER ,ONBIT>
|
||
<ULTIMATELY-IN? ,WINNER .RM>>
|
||
<SET LIT ,WINNER>)
|
||
(T
|
||
<MAKE-FIND-RES 'FIND-RES .RES 'FIND-RES-COUNT 0>
|
||
<MAKE-FINDER 'FINDER ,FINDER 'FIND-APPLIC ,ONBIT
|
||
'FIND-RES .RES
|
||
'FIND-FLAGS ,FIND-FLAGS-GWIM>
|
||
<COND (<EQUAL? .OHERE .RM>
|
||
<FIND-DESCENDANTS ,WINNER
|
||
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
|
||
,FD-NEST? ;,FD-NOTOP?>>
|
||
<COND (<AND <NOT <EQUAL? ,WINNER ,PROTAGONIST>>
|
||
<IN? ,PROTAGONIST .RM>>
|
||
<FIND-DESCENDANTS ,PROTAGONIST
|
||
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
|
||
,FD-NEST? ;,FD-NOTOP?>>)>)>
|
||
<COND (<0? <FIND-RES-COUNT .RES>:FIX>
|
||
<COND (<AND <FSET? <LOC ,WINNER> ,VEHBIT>
|
||
<NOT <FSET? <LOC ,WINNER> ,OPENBIT>>>
|
||
<FIND-DESCENDANTS <LOC ,WINNER>
|
||
%<ORB ,FD-INCLUDE? ,FD-SEARCH?
|
||
,FD-NEST? ;,FD-NOTOP?>>)>
|
||
<FIND-DESCENDANTS .RM %<ORB ,FD-INCLUDE? ,FD-SEARCH?
|
||
,FD-NEST? ;,FD-NOTOP?>>)>
|
||
<COND (<G? <FIND-RES-COUNT .RES>:FIX 0>
|
||
<SET LIT <FIND-RES-OBJ1 .RES>>)>)>
|
||
<SETG HERE .OHERE>
|
||
.LIT>>
|
||
|
||
;"CLOCKER and related routines"
|
||
|
||
<CONSTANT C-TABLE %<COND (<GASSIGNED? ZILCH>
|
||
'<ITABLE NONE 30>)
|
||
(T
|
||
'<ITABLE NONE 60>)>> ;"2x largest num of interrupts"
|
||
|
||
<GLOBAL CLOCK-WAIT <>>
|
||
|
||
<GLOBAL C-INTS 60> ;"2x largest number of concurrent of interrupts"
|
||
|
||
<GLOBAL C-MAXINTS 60> ;"2x largest number of concurrent of interrupts"
|
||
|
||
<GLOBAL CLOCK-HAND <>>
|
||
|
||
<CONSTANT C-TABLELEN 60>
|
||
<CONSTANT C-INTLEN 4> ;"length of an interrupt entry"
|
||
<CONSTANT C-RTN 0> ;"offset of routine name"
|
||
<CONSTANT C-TICK 1> ;"offset of count"
|
||
|
||
<ROUTINE DEQUEUE (RTN)
|
||
<COND (<SET RTN <QUEUED? .RTN>>
|
||
<PUT .RTN ,C-RTN 0>)>>
|
||
|
||
<ROUTINE QUEUED? (RTN "AUX" C E)
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<SET C <REST ,C-TABLE ,C-INTS>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .C .E>
|
||
<RFALSE>)
|
||
(<EQUAL? <GET .C ,C-RTN> .RTN>
|
||
<COND (<ZERO? <GET .C ,C-TICK>>
|
||
<RFALSE>)
|
||
(T
|
||
<RETURN .C>)>)>
|
||
<SET C <REST .C ,C-INTLEN>>>>
|
||
|
||
<ROUTINE RUNNING? (RTN "AUX" C E)
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<SET C <REST ,C-TABLE ,C-INTS>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .C .E>
|
||
<RFALSE>)
|
||
(<EQUAL? <GET .C ,C-RTN> .RTN>
|
||
<COND (<OR <ZERO? <GET .C ,C-TICK>>
|
||
<G? <GET .C ,C-TICK> 1>>
|
||
<RFALSE>)
|
||
(T
|
||
<RTRUE>)>)>
|
||
<SET C <REST .C ,C-INTLEN>>>>
|
||
|
||
<ROUTINE QUEUE (RTN TICK "AUX" C E (INT <>)) ;"automatically enables as well"
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<SET C <REST ,C-TABLE ,C-INTS>>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? .C .E>
|
||
<COND (.INT
|
||
<SET C .INT>)
|
||
(T
|
||
<COND (<L? ,C-INTS ,C-INTLEN>
|
||
<TELL "**Too many ints!**" CR>)>
|
||
<SETG C-INTS <- ,C-INTS ,C-INTLEN>>
|
||
<COND (<L? ,C-INTS ,C-MAXINTS>
|
||
<SETG C-MAXINTS ,C-INTS>)>
|
||
<SET INT <REST ,C-TABLE ,C-INTS>>)>
|
||
<PUT .INT ,C-RTN .RTN>
|
||
<RETURN>)
|
||
(<EQUAL? <GET .C ,C-RTN> .RTN>
|
||
<SET INT .C>
|
||
<RETURN>)
|
||
(<ZERO? <GET .C ,C-RTN>>
|
||
<SET INT .C>)>
|
||
<SET C <REST .C ,C-INTLEN>>>
|
||
<COND (<AND ,CLOCK-HAND
|
||
%<COND (<GASSIGNED? ZILCH>
|
||
'<G? .INT ,CLOCK-HAND>)
|
||
(T
|
||
'<L? <LENGTH .INT> <LENGTH ,CLOCK-HAND>>)>>
|
||
<SET TICK <- <+ .TICK 3>>>)>
|
||
<PUT .INT ,C-TICK .TICK>
|
||
.INT>
|
||
|
||
<ROUTINE CLOCKER ("AUX" E TICK RTN (FLG <>) (Q? <>) OWINNER)
|
||
<COND (,CLOCK-WAIT
|
||
<SETG CLOCK-WAIT <>>
|
||
<RFALSE>)
|
||
(,TIME-STOPPED
|
||
;"don't run interrupts, but do increment moves"
|
||
<SETG MOVES <+ ,MOVES 1>>
|
||
<RFALSE>)>
|
||
<SETG CLOCK-HAND <REST ,C-TABLE ,C-INTS>>
|
||
<SET E <REST ,C-TABLE ,C-TABLELEN>>
|
||
<SET OWINNER ,WINNER>
|
||
<SETG WINNER ,PROTAGONIST>
|
||
<REPEAT ()
|
||
<COND (<EQUAL? ,CLOCK-HAND .E>
|
||
<SETG CLOCK-HAND .E>
|
||
<SETG MOVES <+ ,MOVES 1>>
|
||
<SETG WINNER .OWINNER>
|
||
<RETURN .FLG>)
|
||
(<NOT <ZERO? <GET ,CLOCK-HAND ,C-RTN>>>
|
||
<SET TICK <GET ,CLOCK-HAND ,C-TICK>>
|
||
<COND (<L? .TICK -1>
|
||
<PUT ,CLOCK-HAND ,C-TICK <- <- .TICK> 3>>
|
||
<SET Q? ,CLOCK-HAND>)
|
||
(<NOT <ZERO? .TICK>>
|
||
<COND (<G? .TICK 0>
|
||
<SET TICK <- .TICK 1>>
|
||
<PUT ,CLOCK-HAND ,C-TICK .TICK>)>
|
||
<COND (<NOT <ZERO? .TICK>>
|
||
<SET Q? ,CLOCK-HAND>)>
|
||
<COND (<NOT <G? .TICK 0>>
|
||
<SET RTN
|
||
%<COND (<GASSIGNED? ZILCH>
|
||
'<GET ,CLOCK-HAND ,C-RTN>)
|
||
(ELSE
|
||
'<NTH ,CLOCK-HAND
|
||
<+ <* ,C-RTN 2>
|
||
1>>)>>
|
||
<COND (<ZERO? .TICK>
|
||
<PUT ,CLOCK-HAND ,C-RTN 0>)>
|
||
<COND (<APPLY .RTN>
|
||
<SET FLG T>)>
|
||
<COND (<AND <NOT .Q?>
|
||
<NOT
|
||
<ZERO?
|
||
<GET ,CLOCK-HAND
|
||
,C-RTN>>>>
|
||
<SET Q? T>)>)>)>)>
|
||
<SETG CLOCK-HAND <REST ,CLOCK-HAND ,C-INTLEN>>
|
||
<COND (<NOT .Q?>
|
||
<SETG C-INTS <+ ,C-INTS ,C-INTLEN>>)>>>
|
||
|
||
"stuff for handling opcodes that want pixels"
|
||
|
||
<GLOBAL FONT-X 7>
|
||
<GLOBAL FONT-Y 10>
|
||
|
||
<CONSTANT PICINF-TBL
|
||
<TABLE 0 0>>
|
||
|
||
<ROUTINE C-PIXELS (X)
|
||
<+ <* <- .X 1> ,FONT-X> 1>>
|
||
|
||
<ROUTINE L-PIXELS (Y)
|
||
<+ <* <- .Y 1> ,FONT-Y> 1>>
|
||
|
||
;<ROUTINE PIXELS-C (X)
|
||
<+ </ <- .X 1> ,FONT-X> 1>>
|
||
|
||
;<ROUTINE PIXELS-L (Y)
|
||
<+ </ <- .Y 1> ,FONT-Y> 1>>
|
||
|
||
;<ROUTINE PIXELS-LR (Y)
|
||
</ <- <+ .Y ,FONT-Y> 1> ,FONT-Y>>
|
||
|
||
<ROUTINE CCURSET (Y X)
|
||
<CURSET <L-PIXELS .Y> <C-PIXELS .X>>>
|
||
|
||
;<ROUTINE CCURGET (TBL)
|
||
<CURGET .TBL>
|
||
<PUT .TBL 0 <PIXELS-L <GET .TBL 0>>>
|
||
<PUT .TBL 1 <PIXELS-C <GET .TBL 1>>>
|
||
.TBL>
|
||
|
||
;<ROUTINE CSPLIT (Y)
|
||
<SPLIT <* .Y ,FONT-Y>>>
|
||
|
||
;<ROUTINE CWINPOS (W Y X)
|
||
<WINPOS .W <L-PIXELS .Y> <C-PIXELS .X>>>
|
||
|
||
;<ROUTINE CWINSIZE (W Y X)
|
||
<WINSIZE .W <* .Y ,FONT-Y> <* .X ,FONT-X>>>
|
||
|
||
;<ROUTINE CMARGIN (L R)
|
||
<MARGIN <* .L ,FONT-X> <* .R ,FONT-X>>>
|
||
|
||
;<ROUTINE CPICINF (P TBL)
|
||
<PICINF .P .TBL>
|
||
<PUT .TBL 0 </ <GET .TBL 0> ,FONT-Y>>
|
||
<PUT .TBL 1 </ <GET .TBL 1> ,FONT-X>>>
|
||
|
||
;<ROUTINE CDISPLAY (P Y X)
|
||
<DISPLAY .P
|
||
<COND (<ZERO? .Y> 0)
|
||
(ELSE <L-PIXELS .Y>)>
|
||
<COND (<ZERO? .X> 0)
|
||
(ELSE <C-PIXELS .X>)>>>
|
||
|
||
;<ROUTINE CDCLEAR (P Y X)
|
||
<DCLEAR .P
|
||
<COND (<ZERO? .Y> 0)
|
||
(ELSE <L-PIXELS .Y>)>
|
||
<COND (<ZERO? .X> 0)
|
||
(ELSE <C-PIXELS .X>)>>>
|
||
|
||
;<ROUTINE CSCROLL (W Y)
|
||
<SCROLL .W <* .Y ,FONT-Y>>>
|
||
|
||
<END-SEGMENT> |