60 lines
3.1 KiB
Plaintext
60 lines
3.1 KiB
Plaintext
|
|
<SETG C-ENABLED? 0>
|
|
<SETG C-ENABLED 1>
|
|
<SETG C-DISABLED 0>
|
|
<TELL-TOKENS (CRLF CR) <CRLF> D * <DPRINT .X <>> N * <PRINTN .X> C * <PRINTC .X
|
|
> DER-NOM * <DER-NOM-PRINT .X> DER-NOM-CAP * <DER-NOM-CAP-PRINT .X> DER-ACC * <
|
|
DER-ACC-PRINT .X> DER-ACC-CAP * <DER-ACC-CAP-PRINT .X> DER-DAT * <DER-DAT-PRINT
|
|
.X> EIN-NOM * <EIN-NOM-PRINT .X> EIN-NOM-CAP * <EIN-NOM-CAP-PRINT .X> EIN-ACC *
|
|
<EIN-ACC-PRINT .X> EIN-ACC-CAP * <EIN-ACC-CAP-PRINT .X> EIN-DAT * <
|
|
EIN-DAT-PRINT .X> PRONOUN-NOM * <PRONOUN-NOM-PRINT .X> PRONOUN-NOM-CAP * <
|
|
PRONOUN-NOM-CAP-PRINT .X> PRONOUN-ACC * <PRONOUN-ACC-PRINT .X>>
|
|
<DEFINE-ROUTINE DO-CURSET>
|
|
<DEFINE-ROUTINE DPRINT>
|
|
<DEFINE-ROUTINE DER-NOM-PRINT>
|
|
<DEFINE-ROUTINE DER-NOM-CAP-PRINT>
|
|
<DEFINE-ROUTINE DER-ACC-PRINT>
|
|
<DEFINE-ROUTINE DER-ACC-CAP-PRINT>
|
|
<DEFINE-ROUTINE DER-DAT-PRINT>
|
|
<DEFINE-ROUTINE EIN-NOM-PRINT>
|
|
<DEFINE-ROUTINE EIN-NOM-CAP-PRINT>
|
|
<DEFINE-ROUTINE EIN-ACC-PRINT>
|
|
<DEFINE-ROUTINE EIN-ACC-CAP-PRINT>
|
|
<DEFINE-ROUTINE EIN-DAT-PRINT>
|
|
<DEFINE-ROUTINE PRONOUN-NOM-PRINT>
|
|
<DEFINE-ROUTINE PRONOUN-NOM-CAP-PRINT>
|
|
<DEFINE-ROUTINE PRONOUN-ACC-PRINT>
|
|
<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? "OPTIONAL" 'LOSER?) <COND (<ASSIGNED? LOSER?> <FORM ZPROB
|
|
.BASE?>) (ELSE <FORM G? .BASE? '<RANDOM 100>>)>>
|
|
<DEFINE-ROUTINE ZPROB>
|
|
<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 RMGL-SIZE ('TBL) <COND (<AND <GASSIGNED? PLUS-MODE> ,PLUS-MODE> <FORM -
|
|
<FORM / <FORM PTSIZE .TBL> 2> 1>) (T <FORM - <FORM PTSIZE .TBL> 1>)>> |