mirror of
https://github.com/historicalsource/minizork2-1988
synced 2024-06-26 03:41:06 +03:00
77 lines
3.4 KiB
Plaintext
77 lines
3.4 KiB
Plaintext
|
|
<SETG C-ENABLED? 0>
|
|
<SETG C-ENABLED 1>
|
|
<SETG C-DISABLED 0>
|
|
<DEFMAC TELL ("ARGS" A) <FORM PROG () !<MAPF ,LIST <FUNCTION ("AUX" E P O) <
|
|
COND (<EMPTY? .A> <MAPSTOP>) (<SET E <NTH .A 1>> <SET A <REST .A>>)> <COND (<
|
|
TYPE? .E ATOM> <COND (<OR <=? <SET P <SPNAME .E>> "CRLF"> <=? .P "CR">> <MAPRET
|
|
'<CRLF>>) (<EMPTY? .A> <ERROR INDICATOR-AT-END? .E>) (ELSE <SET O <NTH .A 1>> <
|
|
SET A <REST .A>> <COND (<OR <=? <SET P <SPNAME .E>> "DESC"> <=? .P "D"> <=? .P
|
|
"OBJ"> <=? .P "O">> <MAPRET <FORM PRINTD .O>>) (<OR <=? .P "A"> <=? .P "AN">> <
|
|
MAPRET <FORM PRINTA .O>>) (<OR <=? .P "NUM"> <=? .P "N">> <MAPRET <FORM PRINTN
|
|
.O>>) (<OR <=? .P "CHAR"> <=? .P "CHR"> <=? .P "C">> <MAPRET <FORM PRINTC .O>>)
|
|
(ELSE <MAPRET <FORM PRINT <FORM GETP .O .E>>>)>)>) (<TYPE? .E STRING ZSTRING> <
|
|
MAPRET <FORM PRINTI .E>>) (<TYPE? .E FORM LVAL GVAL> <MAPRET <FORM PRINT .E>>)
|
|
(ELSE <ERROR UNKNOWN-TYPE .E>)>>!>>>
|
|
<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> <FORM GVAL <
|
|
COND (<==? .X PRSA> <PARSE <STRING "V?" <SPNAME .ATM>>>) (ELSE .ATM)>>) (ELSE .
|
|
ATM)> !.L)> <SET ATMS <REST .ATMS>> <COND (<==? <LENGTH .L> 3> <RETURN>)>> <SET
|
|
O <REST <PUTREST .O (<FORM EQUAL? <FORM GVAL .X> !.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>) (<==? .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 RFATAL () '<PROG () <PUSH 2> <RSTACK>>>
|
|
<DEFMAC PROB ('BASE?) <FORM G? .BASE? '<RANDOM 100>>>
|
|
<DEFINE-ROUTINE RANDOM-ELEMENT>
|
|
<DEFINE-ROUTINE PICK-ONE>
|
|
<DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
|
|
<DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
|
|
<DEFMAC FLAMING? ('OBJ) <FORM AND <FORM FSET? .OBJ ',FLAMEBIT> <FORM FSET? .OBJ
|
|
',ONBIT>>>
|
|
<DEFMAC OPENABLE? ('OBJ) <FORM OR <FORM FSET? .OBJ ',DOORBIT> <FORM FSET? .OBJ
|
|
',CONTBIT>>>
|
|
<DEFMAC ABS ('NUM) <FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>) (T .NUM)>>
|
|
<DEFMAC P-SONUMS ('SYN) <FORM / <FORM GETB .SYN ',P-SPREP1> 64>>
|
|
<CONSTANT SERIAL 0>
|
|
<GLOBAL P-WON <>>
|
|
<CONSTANT M-FATAL 2>
|
|
<CONSTANT M-HANDLED 1>
|
|
<CONSTANT M-NOT-HANDLED <>>
|
|
<CONSTANT M-OBJECT <>>
|
|
<CONSTANT M-BEG 1>
|
|
<CONSTANT M-END 6>
|
|
<CONSTANT M-ENTER 2>
|
|
<CONSTANT M-LOOK 3>
|
|
<CONSTANT M-FLASH 4>
|
|
<CONSTANT M-OBJDESC 5>
|
|
<DEFINE-ROUTINE GO>
|
|
<DEFINE-ROUTINE MAIN-LOOP>
|
|
<DEFINE-ROUTINE MAIN-LOOP-1>
|
|
<GLOBAL P-MULT <>>
|
|
<GLOBAL P-NOT-HERE 0>
|
|
<DEFINE-ROUTINE PERFORM>
|
|
<CONSTANT C-TABLELEN 180>
|
|
<GLOBAL C-TABLE <ITABLE NONE 180>>
|
|
<GLOBAL C-DEMONS 180>
|
|
<GLOBAL C-INTS 180>
|
|
<CONSTANT C-INTLEN 6>
|
|
<CONSTANT C-ENABLED? 0>
|
|
<CONSTANT C-TICK 1>
|
|
<CONSTANT C-RTN 2>
|
|
<DEFINE-ROUTINE QUEUE>
|
|
<DEFINE-ROUTINE INT>
|
|
<GLOBAL CLOCK-WAIT <>>
|
|
<GLOBAL MOVES 0>
|
|
<DEFINE-ROUTINE CLOCKER> |