430 lines
12 KiB
Plaintext
430 lines
12 KiB
Plaintext
"OUTPUT for
|
||
JOURNEY
|
||
(c) Copyright 1988, 1989 Infocom, Inc. All Rights Reserved."
|
||
|
||
<BEGIN-SEGMENT 0>
|
||
|
||
<SETG ANONF-COUNT 0>
|
||
|
||
<DEFINE ACOND ("ARGS" LST "AUX" ATM)
|
||
<SET ATM <PARSE <STRING "ANONF-"
|
||
<UNPARSE <SETG ANONF-COUNT
|
||
<+ ,ANONF-COUNT 1>>>>>>
|
||
<COND (<TYPE? <1 .LST> ATOM>
|
||
<SET ATM <1 .LST>>
|
||
<SET LST <REST .LST>>)>
|
||
<MAPF <>
|
||
<FUNCTION (X "AUX" (XX <1 .X>))
|
||
<COND (<==? .XX T> T)
|
||
(<TYPE? .XX ATOM>
|
||
<PUT .X 1 <FORM ACTION? .XX>>)
|
||
(<TYPE? .XX ADECL>
|
||
<PUT .X 1 <FORM ACTION? <1 .XX>>>
|
||
<COND (<==? <2 .XX> CLEAR>
|
||
<PUTREST .X
|
||
('<UPDATE-FSET ,ACTION-OBJECT
|
||
,DONT-EXAMINE>
|
||
!<REST .X>)>)
|
||
(<==? <2 .XX> REMOVE>
|
||
<COND (<==? <1 .XX> EXAMINE>
|
||
<PUTREST .X
|
||
('<UPDATE-MOVE>
|
||
!<REST .X>)>)
|
||
(<==? <1 .XX> GET-ADVICE>
|
||
<PUTREST .X
|
||
('<UPDATE-FCLEAR ,HERE
|
||
,ADVISE>
|
||
!<REST .X>)>)
|
||
(<OR <==? <1 .XX> SCOUT>
|
||
<==? <1 .XX> LOOK-AROUND>>
|
||
<PUTREST .X
|
||
('<UPDATE-FSET ,HERE
|
||
,DONT-SCOUT>
|
||
'<FSET ,HERE ,SCOUTED>
|
||
!<REST .X>)>)
|
||
(T
|
||
<PUTREST .X
|
||
('<REMOVE-TRAVEL-COMMAND>
|
||
!<REST .X>)>)>)
|
||
(T
|
||
<ERROR BAD-ACOND!-ERRORS>)>)>>
|
||
<REST .LST>>
|
||
<EVAL <FORM ROUTINE .ATM <1 .LST>
|
||
<FORM COND !<REST .LST>>>>
|
||
.ATM>
|
||
|
||
<DEFINE EXECUTE ("ARGS" LST "AUX" ATM)
|
||
<SET ATM <PARSE <STRING "ANONF-"
|
||
<UNPARSE <SETG ANONF-COUNT
|
||
<+ ,ANONF-COUNT 1>>>>>>
|
||
<COND (<TYPE? <1 .LST> FORM>
|
||
<SET LST ('() !.LST)>)>
|
||
<EVAL <FORM ROUTINE .ATM !.LST>>
|
||
.ATM>
|
||
|
||
;"Constants various"
|
||
|
||
<CONSTANT GRAPHICS-WINDOW 3>
|
||
<CONSTANT COMMAND-WINDOW 1>
|
||
<CONSTANT TEXT-WINDOW 0>
|
||
|
||
<CONSTANT S-TEXT 0>
|
||
<CONSTANT S-WINDOW 1>
|
||
|
||
<CONSTANT S-BEEP 1>
|
||
<CONSTANT S-BOOP 2>
|
||
|
||
<CONSTANT H-NORMAL 0>
|
||
<CONSTANT H-INVERSE 1>
|
||
|
||
;"These may not be implemented on a target machine."
|
||
<GLOBAL H-BOLD 2>
|
||
|
||
<CONSTANT D-TABLE-ON 3>
|
||
<CONSTANT D-TABLE-OFF -3>
|
||
|
||
<GLOBAL CHRH 0>
|
||
<GLOBAL CHRV 0>
|
||
|
||
<ROUTINE CHANGE-FONT (F)
|
||
<COND (<EQUAL? .F 3>
|
||
<COND (,FONT3-FLAG <FONT 3>)
|
||
(T <FONT 1>)>)
|
||
(<EQUAL? .F 4>
|
||
<COND (,FWC-FLAG <FONT 4>)
|
||
(T <FONT 1>)>)>>
|
||
|
||
<ROUTINE GPOS (C F)
|
||
<COND (<EQUAL? .F 1> .C)
|
||
(T
|
||
<+ <* <- .C 1> .F> 1>)>>
|
||
|
||
<ROUTINE MAKE-WINDOW (N YL XL YS XS "OPTIONAL" (B 15))
|
||
<WINPOS .N
|
||
<GPOS .YL ,CHRV>
|
||
<GPOS .XL ,CHRH>>
|
||
<WINSIZE .N
|
||
<* .YS ,CHRV>
|
||
<* .XS ,CHRH>>
|
||
<WINATTR .N .B>
|
||
.N>
|
||
|
||
<ROUTINE GCURSET (YL XL)
|
||
<COND (<ZERO? ,CURRENT-SCREEN>
|
||
<SELECT-SCREEN ,COMMAND-WINDOW>)>
|
||
<CURSET <GPOS .YL ,CHRV> <GPOS .XL ,CHRH>>>
|
||
|
||
;"tell macro and friends"
|
||
|
||
<TELL-TOKENS (CRLF CR) <CRLF>
|
||
(NUM N) * <PRINTN .X>
|
||
C * <PRINTC .X>
|
||
S *:STRING <PRINT .X>
|
||
D * <WPRINTD .X>
|
||
TAG <WPRINTTAG>
|
||
CHR * <WPRINTCHR .X>
|
||
AO <WPRINTD ,ACTION-OBJECT>
|
||
ACT <WPRINTD ,ACTOR>
|
||
AOP <WPRINTD-OBJECT-PERIOD>
|
||
MORE <INPUT 1>
|
||
CLEAR <CLEAR ,TEXT-WINDOW>>
|
||
|
||
<ROUTINE WPRINTCHR (CHR)
|
||
<COND (<IN-PARTY? .CHR> <WPRINTD .CHR>)
|
||
(T
|
||
<TELL "[Error: ">
|
||
<WPRINTD .CHR>
|
||
<TELL "]">)>>
|
||
|
||
;"macros"
|
||
|
||
<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>
|
||
|
||
<CONSTANT INF 32000>
|
||
|
||
<OBJECT WINDOWS-UNUSED
|
||
(DESC "arc")
|
||
(FLAGS BUSY SEEN LIT ENCHANTED SCOUTED SUBGROUP SINGLE-CAST
|
||
EXAMINED TRAPPED INCAPACITATED DEAD SOLVED DONT-TAKE TRIED
|
||
DONT-CAST DONT-SCOUT DONT-EXAMINE BLUE-MIX GRAY-MIX TRUTHFUL
|
||
INVENTORIED BLACK-MIX NEVER-DROP USED-UP SHADOW)
|
||
(CAST-LIMIT INF)>
|
||
|
||
<GLOBAL TEXT-WINDOW-LEFT 0>
|
||
|
||
<GLOBAL BASE-PICTURE-HEIGHT 0>
|
||
<GLOBAL BASE-PICTURE-WIDTH 0>
|
||
|
||
<GLOBAL PICINF-TBL <TABLE 0 0>>
|
||
|
||
<ROUTINE SETUP-WINDOWS ("AUX" (PW ,BASE-PICTURE-WIDTH)
|
||
(PH ,BASE-PICTURE-HEIGHT) (OFF 6) (GOOD? <>))
|
||
<COND (<OR <NOT <APPLE2?>>
|
||
<0? ,BASE-PICTURE-HEIGHT>>
|
||
<COND (<SET GOOD? <PICINF 2 ,PICINF-TBL>>
|
||
<SET PH <GET ,PICINF-TBL 0>>
|
||
<SET PW <GET ,PICINF-TBL 1>>
|
||
<SETG BASE-PICTURE-WIDTH .PW>
|
||
<SETG BASE-PICTURE-HEIGHT .PH>)>)
|
||
(T
|
||
<SET GOOD? T>)>
|
||
<COND (.GOOD?
|
||
; "Don't do the PICINF on the apple II if we already have.
|
||
This will, we hope, prevent unnecessary disk flipping on
|
||
refresh/restore. The theory is that all apple II screens
|
||
are the same size, so it isn't necessary."
|
||
<COND (<OR <APPLE2?> <EQUAL? ,INTERPRETER ,INT-PC>>
|
||
;"Shrink margin for max. text space..."
|
||
<SET OFF 3>)
|
||
(<NOT ,BORDER-FLAG>
|
||
<SET OFF 5>)> ;"Added 4/26"
|
||
<SETG TEXT-WINDOW-LEFT <+ .OFF </ <+ .PW ,CHRH> ,CHRH>>>)
|
||
(T
|
||
<SETG TEXT-WINDOW-LEFT ,INIT-TEXT-LEFT>)>
|
||
;"Center top left of graphic window"
|
||
<MAKE-WINDOW ,TEXT-WINDOW
|
||
,TOP-SCREEN-LINE
|
||
,TEXT-WINDOW-LEFT
|
||
<- ,COMMAND-START-LINE ,TOP-SCREEN-LINE 1>
|
||
<- ,SCREEN-WIDTH ,TEXT-WINDOW-LEFT>>
|
||
<COND (<EQUAL? ,INTERPRETER ,INT-PC>
|
||
;"For PC, add a left margin to text window..."
|
||
<MARGIN 4 0 ,TEXT-WINDOW>)
|
||
;(<APPLE2?>
|
||
<MAKE-WINDOW 0
|
||
,TOP-SCREEN-LINE
|
||
,TEXT-WINDOW-LEFT
|
||
<- ,COMMAND-START-LINE ,TOP-SCREEN-LINE 1>
|
||
<- ,SCREEN-WIDTH ,TEXT-WINDOW-LEFT>>)>
|
||
; "Changed as follows per TAA:
|
||
Window is top left of screen, and fills the area to the
|
||
borders drawn around other things. Pictures will be centered
|
||
in this by GRAPHIC. This allows us to ensure that pictures
|
||
will really, seriously, be cleared when needed."
|
||
<COND (,BORDER-FLAG
|
||
<SETG GRAPHIC-WINDOW-Y
|
||
<* <- ,COMMAND-START-LINE 3> ,CHRV>>
|
||
<SETG GRAPHIC-WINDOW-X
|
||
<* <- ,TEXT-WINDOW-LEFT 3> ,CHRH>>)
|
||
(T
|
||
<SETG GRAPHIC-WINDOW-Y
|
||
<* <- ,COMMAND-START-LINE 2> ,CHRV>>
|
||
<SETG GRAPHIC-WINDOW-X
|
||
<* <- ,TEXT-WINDOW-LEFT 2> ,CHRH>>)>
|
||
<COND (,BORDER-FLAG
|
||
<MAKE-WINDOW ,GRAPHICS-WINDOW
|
||
,TOP-SCREEN-LINE
|
||
,TOP-SCREEN-LINE
|
||
<- ,COMMAND-START-LINE 3>
|
||
<- ,TEXT-WINDOW-LEFT 3>
|
||
11>)
|
||
(T
|
||
<MAKE-WINDOW ,GRAPHICS-WINDOW
|
||
,TOP-SCREEN-LINE
|
||
,TOP-SCREEN-LINE
|
||
<- ,COMMAND-START-LINE 2>
|
||
<- ,TEXT-WINDOW-LEFT 2>
|
||
11>)>
|
||
; "Set background color to black for this window"
|
||
<COND (,BLACK-PICTURE-BORDER
|
||
<SCREEN ,GRAPHICS-WINDOW>
|
||
<COLOR 9 2>
|
||
<CLEAR ,GRAPHICS-WINDOW>)>>
|
||
|
||
<ROUTINE WPRINTTAG ()
|
||
<COND (<G? ,TAG-NAME-LENGTH 0>
|
||
<PRINTT <REST ,NAME-TBL 2> ,TAG-NAME-LENGTH>)
|
||
(T
|
||
<PRINT-DESC ,TAG>)>>
|
||
|
||
<ROUTINE WPRINTD (OBJ "OPTIONAL" A) <PRINT-DESC .OBJ>>
|
||
|
||
<GLOBAL WPRINT-EBUF <TABLE (BYTE)
|
||
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
|
||
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
|
||
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
|
||
32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32
|
||
>>
|
||
|
||
<CONSTANT CENTER-TABLE <ITABLE 20>>
|
||
<ROUTINE WCENTER (STR "AUX" WID SWID)
|
||
<SET WID <TEXT-WIDTH .STR>>
|
||
<SET SWID <* <- ,SCREEN-WIDTH ,TEXT-WINDOW-LEFT> ,CHRH>>
|
||
<COND (<L? .WID .SWID>
|
||
<SET SWID <+ 1 </ <- .SWID .WID> 2>>>)
|
||
(T
|
||
<SET SWID 1>)>
|
||
<CURGET ,CURGET-TABLE>
|
||
<CURSET <ZGET ,CURGET-TABLE 0> .SWID>
|
||
<PRINTT <REST ,CENTER-TABLE 2> <GET ,CENTER-TABLE 0>>>
|
||
|
||
<GLOBAL CURRENT-GRAPHIC <>>
|
||
|
||
<ROUTINE GRAPHIC-STAMP (PIC WHERE "OPTIONAL" V H "AUX" CURH CURW TOP LEFT
|
||
NEWH NEWW)
|
||
<SET CURH <GET ,PICINF-TBL 0>>
|
||
<SET CURW <GET ,PICINF-TBL 1>>
|
||
<SET TOP <+ </ <- ,GRAPHIC-WINDOW-Y .CURH> 2> 1>>
|
||
<SET LEFT <+ </ <- ,GRAPHIC-WINDOW-X .CURW> 2> 1>>
|
||
<COND (<AND <ZERO? .WHERE>
|
||
<ASSIGNED? V>
|
||
<ASSIGNED? H>>
|
||
<SET TOP <+ .TOP .V>>
|
||
<SET LEFT <+ .LEFT .H>>)
|
||
(<G? .WHERE 0>
|
||
;"WHERE is a funny picture, specifying the location
|
||
of the stamp relative to the corner of the background
|
||
graphic."
|
||
<PICINF .WHERE ,PICINF-TBL>
|
||
<SET LEFT <+ <GET ,PICINF-TBL 1> .LEFT>>
|
||
<SET TOP <+ <GET ,PICINF-TBL 0> .TOP>>)
|
||
(T
|
||
<PICINF .PIC ,PICINF-TBL>
|
||
<SET NEWH <GET ,PICINF-TBL 0>>
|
||
<SET NEWW <GET ,PICINF-TBL 1>>
|
||
<COND (<NOT <0? <ANDB .WHERE ,STAMP-RIGHT>>>
|
||
<SET LEFT <+ .LEFT <- .CURW .NEWW>>>)>
|
||
<COND (<NOT <0? <ANDB .WHERE ,STAMP-BOTTOM>>>
|
||
<SET TOP <+ .TOP <- .CURH .NEWH>>>)>)>
|
||
;<COND (,GTRACE-FLAG
|
||
<TELL "[STAMP - PIC: " N .PIC
|
||
", TOP: " N .TOP
|
||
", LEFT: " N .LEFT
|
||
"]" CR>)>
|
||
<DISPLAY .PIC .TOP .LEFT>>
|
||
|
||
<GLOBAL CURRENT-STAMP <>>
|
||
<GLOBAL CURRENT-STAMP-LOC <>>
|
||
|
||
<ROUTINE GRAPHIC ("OPTIONAL" (STR <>) (STAMP <>) (WHERE <>))
|
||
;<COND (,GTRACE-FLAG
|
||
<TELL "[GRAPHIC - STR: " N .STR
|
||
", STAMP: " N .STAMP
|
||
", WHERE: " N .WHERE
|
||
"]" CR>)>
|
||
<COND (<OR <NOT ,GRAPHICS-FLAG>
|
||
<EQUAL? .STR ,CURRENT-GRAPHIC>>
|
||
<RTRUE>)>
|
||
<COND (<AND <NOT .STR> <NOT .STAMP>>
|
||
<SET STR ,CURRENT-GRAPHIC>
|
||
<COND (<EQUAL? .STR -1>
|
||
<CAVERN-GRAPHIC>)
|
||
(T
|
||
<SET STAMP ,CURRENT-STAMP>
|
||
<SET WHERE ,CURRENT-STAMP-LOC>)>)
|
||
(.STR
|
||
<SETG CURRENT-GRAPHIC .STR>)>
|
||
<SCREEN ,GRAPHICS-WINDOW>
|
||
<COND (.STR <CLEAR ,GRAPHICS-WINDOW>)>
|
||
<COND (<OR <ZERO? .STR> <EQUAL? .STR -1>> T)
|
||
(<AND <G? .STR 0> <L? .STR 255>>
|
||
<COND (<PICINF .STR ,PICINF-TBL>
|
||
;<COND (,GTRACE-FLAG
|
||
<TELL "[DISPLAY - STR: " N .STR "]" CR>)>
|
||
<DISPLAY .STR
|
||
<+ </ <- ,GRAPHIC-WINDOW-Y <GET ,PICINF-TBL 0>> 2> 1>
|
||
<+ </ <- ,GRAPHIC-WINDOW-X <GET ,PICINF-TBL 1>> 2> 1>>)>)
|
||
(T
|
||
<PRINT .STR>)>
|
||
<COND (.STAMP
|
||
<SETG CURRENT-STAMP .STAMP>
|
||
<SETG CURRENT-STAMP-LOC .WHERE>
|
||
<COND (<G? .STAMP 255> <PRINT .STAMP>)
|
||
(T
|
||
<COND (<PICINF ,CURRENT-GRAPHIC ,PICINF-TBL>
|
||
<GRAPHIC-STAMP .STAMP .WHERE>)>)>)
|
||
(T
|
||
<SETG CURRENT-STAMP <>>)>
|
||
<SCREEN ,TEXT-WINDOW>>
|
||
|
||
<GLOBAL CURRENT-SCREEN 0>
|
||
|
||
<ROUTINE SELECT-SCREEN (N)
|
||
<SCREEN .N>
|
||
<SETG CURRENT-SCREEN .N>>
|
||
|
||
<ROUTINE I/WE ("OPTIONAL" (N 1) (CAPS? <>))
|
||
<COND (<G? ,PARTY-MAX .N>
|
||
<COND (.CAPS? "We") (T "we")>)
|
||
(T "I")>>
|
||
|
||
<ROUTINE I-WAS/WE-WERE ("OPTIONAL" (N 1))
|
||
<COND (<G? ,PARTY-MAX .N> "we were")
|
||
(T "I was")>>
|
||
|
||
<ROUTINE I/EACH ("OPTIONAL" (N 1))
|
||
<COND (<G? ,PARTY-MAX .N> "each of us")
|
||
(T "I")>>
|
||
|
||
<ROUTINE MY/OUR ("OPTIONAL" (N 1))
|
||
<COND (<G? ,PARTY-MAX .N> "our")
|
||
(T "my")>>
|
||
|
||
<ROUTINE ME/US ("OPTIONAL" (N 1))
|
||
<COND (<G? ,PARTY-MAX .N> "us")
|
||
(T "me")>>
|
||
|
||
<ROUTINE PRINT-DESC (OBJ "OPTIONAL" (CMD? <>))
|
||
<COND (<AND <EQUAL? .OBJ ,TAG-OBJECT ,TAG ;"Added 3/14">
|
||
<NOT <ZERO? ,TAG-NAME-LENGTH>>>
|
||
<PRINTT <REST ,NAME-TBL 2>
|
||
,TAG-NAME-LENGTH>)
|
||
(<NOT .CMD?>
|
||
;"Always print full name if not in command area..."
|
||
<PRINT <GETP .OBJ ,P?SDESC>>)
|
||
(T
|
||
<PRINT <GET-DESC .OBJ>>)>>
|
||
|
||
<ROUTINE GET-DESC (OBJ "AUX" STR)
|
||
<COND (<AND <L? ,SCREEN-WIDTH ,8-WIDTH>
|
||
<SET STR <GETP .OBJ ,P?8DESC>>>
|
||
.STR)
|
||
(<AND <L? ,SCREEN-WIDTH ,12-WIDTH>
|
||
<SET STR <GETP .OBJ ,P?12DESC>>>
|
||
.STR)
|
||
(T
|
||
<GETP .OBJ ,P?SDESC>)>>
|
||
|
||
<ROUTINE PRINT-COMMAND (CMD)
|
||
<PRINT <GET-COMMAND .CMD>>>
|
||
|
||
<ROUTINE GET-COMMAND (CMD "AUX" STR)
|
||
<COND (<AND <L? ,COMMAND-WIDTH 12>
|
||
<SET STR <GET .CMD ,COMMAND-ASTR>>>
|
||
.STR)
|
||
(T
|
||
<GET .CMD ,COMMAND-FULL>)>>
|
||
|
||
;"Pix that come up for one move only; can't have a stamp"
|
||
|
||
<ROUTINE SINGLE-MOVE-GRAPHIC (G)
|
||
<SETG SAVED-GRAPHIC ,CURRENT-GRAPHIC>
|
||
<SETG SAVED-GRAPHIC-ROOM ,HERE>
|
||
<GRAPHIC .G>
|
||
<QUEUE I-CLEAR-SINGLE-MOVE-GRAPHIC 1>>
|
||
|
||
<GLOBAL SAVED-GRAPHIC 0>
|
||
<GLOBAL SAVED-GRAPHIC-ROOM 0>
|
||
|
||
<OBJECT I-CLEAR-SINGLE-MOVE-GRAPHIC
|
||
(TIME 0)
|
||
(ACTION
|
||
<EXECUTE ()
|
||
<COND (<EQUAL? ,HERE ,SAVED-GRAPHIC-ROOM>
|
||
<GRAPHIC ,SAVED-GRAPHIC>)>>)>
|
||
|