184 lines
9.4 KiB
Plaintext
184 lines
9.4 KiB
Plaintext
|
|
<BEGIN-SEGMENT 0>
|
|
<PROPDEF SCENE <> (SCENE "MANY" S:FIX = <> "MANY" <BYTE .S>)>
|
|
<PROPDEF SCORE <> (SCORE N:FIX = 2 <BYTE 0> <BYTE .N>)>
|
|
<DEFINE-ROUTINE PRINT-HIM/HER>
|
|
<DEFINE-ROUTINE CPRINT-HE/SHE>
|
|
<DEFINE-ROUTINE PRINT-HE/SHE>
|
|
<DEFINE-ROUTINE PRINT-HIS/HER>
|
|
<DEFINE-ROUTINE PRINT-PLURAL>
|
|
<DEFINE-ROUTINE PRINTUNDER>
|
|
<DEFINE-ROUTINE CTHE-PRINT-PRSO>
|
|
<DEFINE-ROUTINE CTHE-PRINT-PRSI>
|
|
<DEFINE-ROUTINE CTHE-PRINT>
|
|
<DEFINE-ROUTINE THE-PRINT-PRSO>
|
|
<DEFINE-ROUTINE THE-PRINT-PRSI>
|
|
<DEFINE-ROUTINE THE-PRINT>
|
|
<DEFINE-ROUTINE CPRINTA-PRSO>
|
|
<DEFINE-ROUTINE PRINTA-PRSO>
|
|
<DEFINE-ROUTINE PRINTA-PRSI>
|
|
<DEFINE-ROUTINE PRINTA>
|
|
<DEFINE-ROUTINE DPRINT-PRSO>
|
|
<DEFINE-ROUTINE DPRINT-PRSI>
|
|
<DEFINE-ROUTINE DPRINT>
|
|
<DEFINE-ROUTINE IPRINT>
|
|
<COND (<GASSIGNED? ZILCH> <DEFINE PE (F I) <COND (<TYPE? .I LIST> <FORM .F !.I>
|
|
) (ELSE <FORM .F .I>)>> <DEFMAC P? ('V "OPT" ('O '*) ('I '*) ('W '*) "AUX" (L (
|
|
))) <COND (<N==? .I '*> <SET L (<PE PRSI? .I> !.L)>)> <COND (<N==? .O '*> <COND
|
|
(<OR <==? .V 'WALK> <==? .V ',V?WALK>> <SET L (<PE DIR? .O> !.L)>) (ELSE <SET L
|
|
(<PE PRSO? .O> !.L)>)>)> <COND (<N==? .V '*> <SET L (<PE VERB? .V> !.L)>)> <
|
|
COND (<N==? .W '*> <SET L (<PE WINNER? .W> !.L)>)> <COND (<EMPTY? <REST .L>> <1
|
|
.L>) (ELSE <FORM AND !.L>)>> <DEFMAC NOT-SOLVED? ('OBJ) <FORM FSET? .OBJ ',
|
|
SCOREBIT>> <DEFMAC SOLVED? ('OBJ) <FORM NOT <FORM FSET? .OBJ ',SCOREBIT>>> <
|
|
DEFMAC VERB? ("ARGS" ATMS) <MULTIFROB ',PRSA .ATMS>> <DEFMAC SCENE? ("ARGS"
|
|
ATMS) <MULTIFROB ',SCENE .ATMS>> <DEFMAC CONTEXT? ("ARGS" ATMS) <MULTIFROB '.
|
|
RARG .ATMS>> <DEFMAC ADJ? ("ARGS" ATMS) <MULTIFROB '<PARSE-ADJ ,PARSE-RESULT> .
|
|
ATMS>> <SETG RARG? ,CONTEXT?> <DEFMAC WINNER? ("ARGS" ATMS) <MULTIFROB ',WINNER
|
|
.ATMS>> <DEFMAC PRSO? ("ARGS" ATMS) <MULTIFROB ',PRSO .ATMS>> <DEFMAC DIR? (
|
|
"ARGS" ATMS) <MULTIFROB ',P-WALK-DIR .ATMS>> <DEFMAC PRSI? ("ARGS" ATMS) <
|
|
MULTIFROB ',PRSI .ATMS>> <DEFMAC HERE? ("ARGS" ATMS) <MULTIFROB ',HERE .ATMS>>
|
|
<SETG ROOM? ,HERE?> <DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ())
|
|
ATM SP) <REPEAT () <COND (<EMPTY? .ATMS> <RETURN <COND (<LENGTH? .OO 1> <ERROR
|
|
.X>) (<LENGTH? .OO 2> <NTH .OO 2>) (ELSE <CHTYPE .OO FORM>)>>)> <REST <PUTREST
|
|
.O <SET O (<REPEAT ((LL <FORM EQUAL? .X>) (L <REST .LL>)) <COND (<OR <EMPTY? .
|
|
ATMS> <==? <LENGTH <REST .LL 2>> 3>> <RETURN .LL>)> <SET ATM <NTH .ATMS 1>> <
|
|
PUTREST .L <SET L (<COND (<TYPE? .ATM ATOM> <SET SP <SPNAME .ATM>> <MAKE-GVAL <
|
|
COND (<==? .X ',PRSA> <PARSE <STRING "V?" .SP>>) (<==? .X ',P-WALK-DIR> <COND (
|
|
<AND <G? <LENGTH .SP> 2> <==? <1 .SP> !\P> <==? <2 .SP> !\?>> .ATM) (ELSE <
|
|
PARSE <STRING "P?" .SP>>)>) (<==? .X '.RARG> <COND (<AND <G? <LENGTH .SP> 2> <
|
|
==? <1 .SP> !\M> <==? <2 .SP> !\->> .ATM) (ELSE <PARSE <STRING "M-" .SP>>)>) (
|
|
ELSE .ATM)>>) (ELSE .ATM)>)>> <SET ATMS <REST .ATMS>>>)>>>>>) (ELSE <DEFINE P?
|
|
(V "OPT" (O '*) (I '*) (W '*) "AUX" (L <>)) <AND <OR <==? .W '*> <WINNER? .W>>
|
|
<OR <==? .V '*> <VERB? .V>> <OR <==? .O '*> <PRSO? .O>> <OR <==? .I '*> <PRSI?
|
|
.I>>>> <DEFINE VERB? ("TUPLE" ATMS) <MAPF <> <FUNCTION (A "AUX" ATM) <COND (<
|
|
TYPE? .A ATOM> <COND (<SET ATM <LOOKUP <STRING "V?" <SPNAME .A>> <MOBLIST
|
|
INITIAL>>> <COND (<EQUAL? ,PRSA ,.ATM> <MAPLEAVE T>)>) (ELSE <ERROR NOT-A-VERB?
|
|
.A>)>) (<EQUAL? ,PRSA .A> <MAPLEAVE T>)>> .ATMS>> <DEFINE CONTEXT? ("TUPLE"
|
|
ATMS) <MAPF <> <FUNCTION (A "AUX" ATM) <COND (<TYPE? .A ATOM> <COND (<AND <G? <
|
|
LENGTH <SET ATM <SPNAME .A>>> 2> <==? <1 .ATM> !\M> <==? <2 .ATM> !\->> <COND (
|
|
<EQUAL? .RARG ,.ATM> <MAPLEAVE T>)>) (<SET ATM <LOOKUP <STRING "M-" <SPNAME .A>
|
|
> <MOBLIST INITIAL>>> <COND (<EQUAL? .RARG ,.ATM> <MAPLEAVE T>)>) (ELSE <ERROR
|
|
NOT-A-CONTEXT? .A>)>) (<EQUAL? .RARG .A> <MAPLEAVE T>)>> .ATMS>> <SETG RARG? ,
|
|
CONTEXT?> <DEFINE WINNER? ("TUPLE" ATMS) <MULTIFROB ,WINNER .ATMS>> <DEFINE
|
|
PRSO? ("TUPLE" ATMS) <MULTIFROB ,PRSO .ATMS>> <DEFINE PRSI? ("TUPLE" ATMS) <
|
|
MULTIFROB ,PRSI .ATMS>> <DEFINE HERE? ("TUPLE" ATMS) <MULTIFROB HERE .ATMS>> <
|
|
SETG ROOM? ,HERE?> <DEFINE MULTIFROB (X ATMS) <MAPF <> <FUNCTION (A) <COND (<
|
|
TYPE? .A ATOM> <SET A ,.A>)> <COND (<EQUAL? .X .A> <MAPLEAVE T>)>> .ATMS>>)>
|
|
<COND (<GASSIGNED? ZILCH> <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" (OT <COND (<==? .X FSET?> <FORM OR>) (ELSE <FORM PROG ()>)>)
|
|
(OO <COND (<LENGTH? .OT 1> .OT) (ELSE <REST .OT>)>) (O .OO) ATM) <REPEAT () <
|
|
COND (<EMPTY? .ATMS> <RETURN .OT>)> <SET ATM <NTH .ATMS 1>> <SET ATMS <REST .
|
|
ATMS>> <PUTREST .O <SET O (<FORM .X .OBJ <COND (<TYPE? .ATM FORM> .ATM) (ELSE <
|
|
MAKE-GVAL .ATM>)>>)>>>>) (ELSE <DEFINE BSET (OBJ "TUPLE" BITS) <MULTIBITS ,FSET
|
|
.OBJ .BITS>> <DEFINE BCLEAR (OBJ "TUPLE" BITS) <MULTIBITS ,FCLEAR .OBJ .BITS>>
|
|
<DEFINE BSET? (OBJ "TUPLE" BITS) <MAPF <> <FUNCTION (A) <COND (<FSET? .OBJ ,.A>
|
|
<MAPLEAVE T>)>> .BITS>> <DEFINE MULTIBITS (X OBJ ATMS) <MAPF <> <FUNCTION (A) <
|
|
APPLY .X .OBJ ,.A>> .ATMS>>)>
|
|
<DEFMAC RFATAL () '<RETURN ,M-FATAL>>
|
|
<COND (<GASSIGNED? ZILCH> <DEFMAC PROB ('BASE?) <FORM NOT <FORM L? .BASE? '<
|
|
RANDOM 100>>>>) (ELSE <DEFINE PROB (BASE?) <NOT <L? .BASE? <RANDOM 100>>>>)>
|
|
<DEFINE-ROUTINE PICK-ONE>
|
|
<DEFMAC APPLE? () '<EQUAL? ,MACHINE ,APPLE-2E ,APPLE-2C ,APPLE-2GS>>
|
|
<GLOBAL P-WON <>>
|
|
<GLOBAL SCENE 0>
|
|
<DEFINE-ROUTINE SCENE-SELECT>
|
|
<DEFINE-ROUTINE SCENE-SELECT-F>
|
|
<CONSTANT PART-MENU <LTABLE <TABLE (PURE STRING LENGTH) "START the game "> <
|
|
TABLE (PURE STRING LENGTH) "RESTORE a saved game "> <TABLE (PURE STRING LENGTH)
|
|
"QUIT the game ">>>
|
|
<CONSTANT SCENE-NAMES <PLTABLE "Erasmus" "Anjiro" "Yabu" "Pit" "Rodrigues"
|
|
"Voyage to Osaka" "Toranaga" "Prison" "Mariko" "Escape" "Earthquake"
|
|
"Journey to Yedo" "Ochiba" "Departure" "Seppuku" "Ninja" "Yokohama" "Aftermath"
|
|
"Epilogue">>
|
|
<DEFMAC SCENE-CONSTANTS ("TUPLE" SS "AUX" (CNT 0)) <MAPF ,PLTABLE <FUNCTION (S)
|
|
<EVAL <FORM CONSTANT .S <SET CNT <+ .CNT 1>>>>> .SS>>
|
|
<CONSTANT SCENES <SCENE-CONSTANTS S-ERASMUS S-ANJIRO S-YABU S-PIT S-RODRIGUES
|
|
S-VOYAGE S-TORANAGA S-PRISON S-MARIKO S-ESCAPE S-QUAKE S-JOURNEY S-OCHIBA
|
|
S-DEPARTURE S-SEPPUKU S-NINJA S-YOKOHAMA S-AFTERMATH S-EPILOGUE>>
|
|
<CONSTANT SCENE-LOCS <PLTABLE BRIDGE-OF-ERASMUS MURA-HOUSE VILLAGE-SQUARE PIT
|
|
ANJIRO-WATERFRONT GALLEY OUTER-CORRIDOR PRISON MAPLE-GLADE COURTYARD PLATEAU
|
|
YOKOSE-BATH-HOUSE OCHIBA-ROOM FORECOURT FORMAL-GARDEN PRIVATE-QUARTERS YOKOHAMA
|
|
STABLE SEKIGAHARA>>
|
|
<CONSTANT SCENE-PICS <TABLE (PURE BYTE LENGTH) P-STORM P-GARDEN P-YABU-SEG
|
|
P-PIT P-RODRIGUES-SEG P-CONFUSION P-OSAKA P-PRISON-SEG P-MARIKO-SEG
|
|
P-PROCESSION P-QUAKE P-BATH P-OCHIBA-SEG P-DEPARTURE-SEG P-SEPPUKU P-NINJA
|
|
P-VINCK P-AFTERMATH-SEG P-CREST>>
|
|
<GLOBAL MACHINE <>>
|
|
<GLOBAL WIDTH 0>
|
|
<END-SEGMENT>
|
|
<BEGIN-SEGMENT STARTUP>
|
|
<DEFINE-ROUTINE GO>
|
|
<DEFINE-ROUTINE SLIDE-SHOW>
|
|
<DEFINE-ROUTINE END-DEMO>
|
|
<END-SEGMENT>
|
|
<BEGIN-SEGMENT 0>
|
|
<CONSTANT S-FULL 7>
|
|
<DEFINE-ROUTINE SETUP-FULL>
|
|
<DEFINE-ROUTINE SETUP-DISPLAY>
|
|
<DEFINE-ROUTINE REPAINT-DISPLAY>
|
|
<DEFINE-ROUTINE GOTO-SCENE>
|
|
<DEFINE-ROUTINE TOUCH-SEG>
|
|
<DEFINE-ROUTINE GAME-VERB?>
|
|
<GLOBAL P-MULT <>>
|
|
<GLOBAL P-NOT-HERE 0>
|
|
<DEFINE-ROUTINE END-QUOTE>
|
|
<GLOBAL CLOCK-WAIT <>>
|
|
<GLOBAL C-TABLE <ITABLE 13 <> <>>>
|
|
<CONSTANT C-INTLEN 4>
|
|
<CONSTANT C-RTN 0>
|
|
<CONSTANT C-TICK 1>
|
|
<CONSTANT C-TABLELEN 52>
|
|
<GLOBAL C-INTS 52>
|
|
<DEFINE-ROUTINE DEQUEUE>
|
|
<DEFINE-ROUTINE QUEUED?>
|
|
<DEFINE-ROUTINE QUEUE>
|
|
<GLOBAL STATIONARY? <>>
|
|
<GLOBAL STATIONARY-CNT <>>
|
|
<GLOBAL CLOCK-HAND <>>
|
|
<DEFINE-ROUTINE CLOCKER>
|
|
<DEFINE-ROUTINE DEQUEUE-ALL>
|
|
<DEFINE PSEUDO ("TUPLE" V) <MAPF ,PLTABLE <FUNCTION (OBJ) <COND (<N==? <LENGTH
|
|
.OBJ> 3> <ERROR BAD-THING .OBJ>)> <MAPRET <COND (<NTH .OBJ 1> <VOC <SPNAME <NTH
|
|
.OBJ 1>> ADJECTIVE>)> <COND (<NTH .OBJ 2> <VOC <SPNAME <NTH .OBJ 2>> NOUN>)>>>
|
|
.V>>
|
|
<DEFINE-ROUTINE PERFORM-PRSA>
|
|
<DEFINE-ROUTINE NEW-VERB>
|
|
<DEFINE-ROUTINE SWAP-VERB>
|
|
<DEFINE-ROUTINE NEW-PRSO>
|
|
<DEFINE-ROUTINE NEW-WINNER-PRSO>
|
|
<DEFINE-ROUTINE REDIRECT>
|
|
<GLOBAL DELAY-CNT 0>
|
|
<COND (<GASSIGNED? ZILCH> <DEFMAC ZLINES ('VAR:<PRIMTYPE ATOM> "ARGS" LINES:
|
|
LIST "AUX" (CNT:FIX 0) SETTER:ATOM (DELAYS:<OR FALSE LIST> <>)) <COND (<TYPE? .
|
|
VAR ATOM> <EVAL <FORM GLOBAL .VAR 0>> <SET SETTER <CHTYPE .VAR GVAL>>) (<TYPE?
|
|
.VAR GVAL> <EVAL <FORM GLOBAL <CHTYPE .VAR ATOM> 0>> <SET SETTER 'SETG>) (<
|
|
TYPE? .VAR LVAL> <EVAL <FORM GLOBAL <CHTYPE .VAR ATOM> 0>> <SET SETTER 'SET>)>
|
|
<SET DELAYS <MAPF ,LIST <FUNCTION (LINE:LIST) <COND (<EMPTY? .LINE> <MAPRET>) (
|
|
<==? <1 .LINE> DELAY> <MAPRET (<FORM EQUAL? .VAR .CNT> !<REST .LINE!>)>) (ELSE
|
|
<COND (<AND <NOT <EMPTY? .LINE>> <TYPE? <1 .LINE> FIX>> <SET CNT <+ .CNT <1 .
|
|
LINE>>> <SET LINE <REST .LINE>>) (ELSE <SET CNT <+ .CNT 1>>)> <MAPRET>)>> .
|
|
LINES>> <SET CNT 0> <COND (<NOT <EMPTY? .DELAYS>> <SET DELAYS ('<SETG DELAY-CNT
|
|
<+ ,DELAY-CNT 1>> <FORM COND !.DELAYS> '<SETG DELAY-CNT 0>)>)> <FORM PROG () !.
|
|
DELAYS <FORM .SETTER <CHTYPE .VAR ATOM> <FORM + .VAR 1>> <FORM COND !<MAPF ,
|
|
LIST <FUNCTION (LINE:LIST) <COND (<NOT <EMPTY? .LINE>> <COND (<==? <1 .LINE>
|
|
DELAY> <MAPRET>) (<TYPE? <1 .LINE> FIX> <SET CNT <+ .CNT <1 .LINE>>> <SET LINE
|
|
<REST .LINE>>) (ELSE <SET CNT <+ .CNT 1>>)> <LIST <FORM EQUAL? .VAR .CNT> !.
|
|
LINE>) (ELSE <ERROR BAD-ZLINES>)>> .LINES!>>>>) (ELSE <DEFINE ZLINES (VAR
|
|
"ARGS" LINES) <RFALSE>>)>
|
|
<COND (<GASSIGNED? ZILCH> <DEFMAC FOR ('X "ARGS" BODY) <FORM REPEAT (<1 .X>) <
|
|
FORM COND (<FORM NOT <2 .X>> '<RETURN>)> !.BODY <3 .X>>>)>
|
|
<DEFINE-ROUTINE CREWMAN?>
|
|
<DEFINE-ROUTINE WINDEF>
|
|
<GLOBAL FONT-X 7>
|
|
<GLOBAL FONT-Y 10>
|
|
<DEFINE-ROUTINE C-PIXELS>
|
|
<DEFINE-ROUTINE L-PIXELS>
|
|
<DEFINE-ROUTINE CCURSET>
|
|
<DEFINE-ROUTINE IN-SCENE?>
|
|
<DEFINE-ROUTINE REPLACE-SYNONYM>
|
|
<DEFINE-ROUTINE REPLACE-ADJECTIVE>
|
|
<DEFINE-ROUTINE CURSOR-OFF>
|
|
<DEFINE-ROUTINE CURSOR-ON>
|
|
<END-SEGMENT> |