journey/output.zil

430 lines
12 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

"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>)>>)>