mirror of
https://github.com/historicalsource/zork
synced 2024-06-17 07:20:44 +03:00
978 lines
26 KiB
Plaintext
978 lines
26 KiB
Plaintext
|
|
||
|
"(c) Copyright 1979, Massachusetts Institute of Technology. All rights reserved."
|
||
|
|
||
|
<OR <TYPE? ,REP SUBR>
|
||
|
<SETG SAVEREP ,REP>>
|
||
|
|
||
|
<DEFINE ZGO ()
|
||
|
<SETG REP ,ZREP>
|
||
|
<ON "BLOCKED"
|
||
|
<FUNCTION (FOO)
|
||
|
<PRINC !\:>>
|
||
|
5>
|
||
|
<ERRET>>
|
||
|
|
||
|
<DEFINE ZREP ZTOP ("AUX" RD)
|
||
|
#DECL ((ZTOP) <SPECIAL ACTIVATION> (RD) ANY)
|
||
|
<REPEAT ()
|
||
|
<CRLF>
|
||
|
<SET RD <READ>>
|
||
|
<CRLF>
|
||
|
<SET RD <ZEVAL .RD>>
|
||
|
<ZPRINT .RD>
|
||
|
.RD>>
|
||
|
|
||
|
<DEFINE ZPRINT (ITEM)
|
||
|
#DECL ((ITEM) ANY)
|
||
|
<COND (<TYPE? .ITEM OBJECT>
|
||
|
<ZOBJ-PRINT .ITEM>)
|
||
|
(<TYPE? .ITEM ROOM>
|
||
|
<ZRM-PRINT .ITEM>)
|
||
|
(<TYPE? .ITEM VERB>
|
||
|
<PRINC "Verb = ">
|
||
|
<PRINC <STRINGP <1 .ITEM>>>)
|
||
|
(<TYPE? .ITEM CEVENT>
|
||
|
<ZEV-PRINT .ITEM>)
|
||
|
(<TYPE? .ITEM LIST>
|
||
|
<ZLST-PRINT .ITEM>)
|
||
|
(<==? .ITEM T>
|
||
|
<PRINC "True">)
|
||
|
(<==? .ITEM <>>
|
||
|
<PRINC "False">)
|
||
|
(<PRIN1 .ITEM>)>>
|
||
|
|
||
|
<DEFINE ZEV-PRINT (CEV)
|
||
|
#DECL ((CEV) CEVENT)
|
||
|
<PRINC "Running ">
|
||
|
<PRINC <SPNAME <2 .CEV>>>
|
||
|
<PRINC " in ">
|
||
|
<PRIN1 <1 .CEV>>
|
||
|
<PRINC " moves">
|
||
|
<COND (<NOT <3 .CEV>>
|
||
|
<PRINC " (disabled)">)>>
|
||
|
|
||
|
<DEFINE ZLST-PRINT (LST)
|
||
|
#DECL ((LST) LIST)
|
||
|
<PRINC "List containing:">
|
||
|
<ZPC .LST>>
|
||
|
|
||
|
<DEFINE ZOBJ-PRINT (OBJ)
|
||
|
#DECL ((OBJ) OBJECT)
|
||
|
<PRINC "Object = ">
|
||
|
<PRINC <ODESC2 .OBJ>>
|
||
|
<COND (<OCAN .OBJ>
|
||
|
<PRINC " (in ">
|
||
|
<PRINC <ODESC2 <OCAN .OBJ>>>
|
||
|
<PRINC ")">)>
|
||
|
<COND (<NOT <EMPTY? <OCONTENTS .OBJ>>>
|
||
|
<PRINC " /Contains:">
|
||
|
<ZPC <OCONTENTS .OBJ>>)>>
|
||
|
|
||
|
<DEFINE ZPC (LST)
|
||
|
#DECL ((LST) LIST)
|
||
|
<PRINC !\ >
|
||
|
<MAPR <>
|
||
|
<FUNCTION (LST2 "AUX" (ITEM <1 .LST2>))
|
||
|
#DECL ((LST2) LIST (ITEM) ANY)
|
||
|
<COND (<TYPE? .ITEM OBJECT>
|
||
|
<PRINC <ODESC2 .ITEM>>)
|
||
|
(<PRIN1 .ITEM>)>
|
||
|
<OR <LENGTH? .LST2 1>
|
||
|
<PRINC " & ">>>
|
||
|
.LST>>
|
||
|
|
||
|
<DEFINE ZRM-PRINT (RM "AUX" (OBJS <ROBJS .RM>))
|
||
|
#DECL ((RM) ROOM (OBJS) <LIST [REST OBJECT]>)
|
||
|
<PRINC "Room = ">
|
||
|
<PRINC <RDESC2 .RM>>
|
||
|
<COND (<NOT <EMPTY? .OBJS>>
|
||
|
<PRINC "
|
||
|
Contains:">
|
||
|
<ZPC .OBJS>)>
|
||
|
<PRINC "
|
||
|
Exits to: ">
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ITM)
|
||
|
#DECL ((ITM) ANY)
|
||
|
<COND (<TYPE? .ITM DIRECTION>
|
||
|
<PRINC <STRINGP .ITM>>
|
||
|
<PRINC !\ >)>>
|
||
|
<REXITS .RM>>>
|
||
|
|
||
|
<SET ZFLUSH
|
||
|
<ON "CHAR"
|
||
|
<FUNCTION (CHR CHN)
|
||
|
#DECL ((CHR) CHARACTER (CHN) CHANNEL)
|
||
|
<COND (<==? .CHR <ASCII 7>>
|
||
|
<INT-LEVEL 0>
|
||
|
<AND <GET BLOCKED!-INTERRUPTS INTERRUPT>
|
||
|
<OFF "BLOCKED">>
|
||
|
<SETG REP ,SAVEREP>
|
||
|
<LISTEN>)>>
|
||
|
8 0 ,INCHAN>>
|
||
|
|
||
|
<DEFINE ZEVAL (ITEM "OPTIONAL" (FLAG <>) "AUX" OPER TEMP)
|
||
|
#DECL ((ITEM TEMP) ANY (OPER) STRING (FLAG) <OR ATOM FALSE>)
|
||
|
<COND (<TYPE? .ITEM FIX FLOAT STRING> .ITEM)
|
||
|
(<TYPE? .ITEM FORM> <EVAL .ITEM>)
|
||
|
(<TYPE? .ITEM ATOM>
|
||
|
<SET OPER <SPNAME .ITEM>>
|
||
|
<COND (<SET TEMP <ZLOOKUP .OPER ,ZERO-POBL>>
|
||
|
<APPLY .TEMP>)
|
||
|
(<ZLOOKUP .OPER ,ZVARS-POBL>)
|
||
|
(<PLOOKUP .OPER ,OBJECT-POBL>)
|
||
|
(<PLOOKUP .OPER ,ROOM-POBL>)
|
||
|
(<PLOOKUP .OPER ,WORDS-POBL>)
|
||
|
(<ZLOOKUP .OPER ,ZOBITS-POBL>)
|
||
|
(<ZLOOKUP .OPER ,ZRBITS-POBL>)
|
||
|
(.FLAG #LOSE 0)
|
||
|
(ELSE <ILLEGAL "Unknown word: " .OPER>)>)
|
||
|
(<TYPE? .ITEM LIST>
|
||
|
<REPEAT (R I S)
|
||
|
#DECL ((R I) ANY (S) STRING)
|
||
|
<COND (<EMPTY? .ITEM> <RETURN <AND <ASSIGNED? R> .R>>)>
|
||
|
<SET I <1 .ITEM>>
|
||
|
<COND (<TYPE? .I ATOM>
|
||
|
<SET S <SPNAME .I>>
|
||
|
<COND (<SET TEMP <ZLOOKUP .S ,ZERO-POBL>>
|
||
|
<SET R <APPLY .TEMP>>)
|
||
|
(<SET TEMP <ZLOOKUP .S ,ONE-POBL>>
|
||
|
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||
|
<TOOFEW .S>)
|
||
|
(ELSE
|
||
|
<SET R
|
||
|
<APPLY .TEMP
|
||
|
<ZEVAL <1 .ITEM>>>>)>)
|
||
|
(<SET TEMP <ZLOOKUP .S ,TWO-POBL>>
|
||
|
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||
|
<TOOFEW .S>)
|
||
|
(<ASSIGNED? R>
|
||
|
<SET R
|
||
|
<APPLY .TEMP
|
||
|
.R
|
||
|
<ZEVAL <1 .ITEM>>>>)
|
||
|
(ELSE
|
||
|
<TOOFEW .S>)>)
|
||
|
(<SET TEMP <ZLOOKUP .S ,ANY-POBL>>
|
||
|
<COND (<EMPTY? <SET ITEM <REST .ITEM>>>
|
||
|
<TOOFEW .S>)
|
||
|
(ELSE
|
||
|
<SET R
|
||
|
<APPLY .TEMP
|
||
|
<OR <NOT <ASSIGNED? R>>
|
||
|
.R>
|
||
|
.ITEM>>
|
||
|
<RETURN .R>)>)
|
||
|
(ELSE <SET R <ZEVAL .I>>)>)
|
||
|
(ELSE <SET R <ZEVAL .I>>)>
|
||
|
<SET ITEM <REST .ITEM>>>)
|
||
|
(<ILLEGAL "ZEVAL of non list, form or atom.">)>>
|
||
|
|
||
|
<DEFINE ZIN (ITM1 ITM2)
|
||
|
#DECL ((ITM1 ITM2) ANY)
|
||
|
<COND (<TYPE? .ITM2 LIST>
|
||
|
<AND <MEMQ .ITM1 .ITM2> T>)
|
||
|
(<TYPE? .ITM1 OBJECT>
|
||
|
<COND (<TYPE? .ITM2 OBJECT>
|
||
|
<==? <OCAN .ITM1> .ITM2>)
|
||
|
(<TYPE? .ITM2 ROOM>
|
||
|
<AND <MEMQ .ITM1 <ROBJS .ITM2>> T>)
|
||
|
(<TYPE? .ITM2 ADV>
|
||
|
<AND <MEMQ .ITM1 <AOBJS ,WINNER>> T>)
|
||
|
(<ILLEGAL "Illegal container - " .OBJ2>)>)
|
||
|
(<ILLEGAL "Illegal object?">)>>
|
||
|
|
||
|
<DEFINE ZEQUALS (ITM1 ITM2)
|
||
|
#DECL ((ITM1 ITM2) ANY)
|
||
|
<COND (<==? <TYPE .ITM1> <TYPE .ITM2>>
|
||
|
<==? .ITM1 .ITM2>)
|
||
|
(<TYPE? .ITM2 FIX>
|
||
|
<COND (<TYPE? .ITM1 OBJECT> <TRNN .ITM1 .ITM2>)
|
||
|
(<TYPE? .ITM1 ROOM> <RTRNN .ITM1 .ITM2>)
|
||
|
(<ILLEGAL "Unknown type?">)>)>>
|
||
|
|
||
|
"ZIF -- fsubr"
|
||
|
|
||
|
<DEFINE ZIF (DUMMY LST "AUX" P (TOKEN then) (R <>))
|
||
|
<COND (<SET P <ZEVAL <1 .LST>>>)
|
||
|
(ELSE <SET TOKEN else>)>
|
||
|
<COND (<SET LST <MEMQ .TOKEN .LST>>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (I)
|
||
|
<AND <==? .I else> <MAPLEAVE .R>>
|
||
|
<SET R <ZEVAL .I>>>
|
||
|
<REST .LST>>)
|
||
|
(ELSE <ILLEGAL "If lacks then/else">)>>
|
||
|
|
||
|
"ZCASE -- fsubr"
|
||
|
|
||
|
<SETG EXPR <ILIST 3>>
|
||
|
|
||
|
<DEFINE ZCASE (DUMMY LST "AUX" OBJ (E ,EXPR))
|
||
|
<SET OBJ <1 .LST>>
|
||
|
<COND (<TYPE? .OBJ ATOM>)(ELSE <SET OBJ <ZEVAL .OBJ>>)>
|
||
|
<SET LST <REST .LST>>
|
||
|
<COND (<EMPTY? .LST> <TOOFEW "case">)
|
||
|
(<TYPE? <SET OPR <1 .LST>> ATOM>
|
||
|
<SET LST <REST .LST>>)>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (I)
|
||
|
<PUT .E 1 .OBJ>
|
||
|
<PUT .E 2 .OPR>
|
||
|
<PUT .E 3 <1 .I>>
|
||
|
<COND (<OR <==? <1 .I> else> <ZEVAL .E>>
|
||
|
<MAPLEAVE <ZEVAL <REST .I>>>)>>
|
||
|
.LST>>
|
||
|
|
||
|
"ZFOR-EACH -- fsubr"
|
||
|
|
||
|
<DEFINE ZFOR-EACH (DUMMY ARGL)
|
||
|
#DECL ((ARGL) LIST)
|
||
|
<COND (<LENGTH? .ARGL 1>
|
||
|
<TOOFEW>)
|
||
|
(<TYPE? <SET LST <ZEVAL <1 .ARGL>>> LIST>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ZITS)
|
||
|
#DECL ((ZITS) <SPECIAL ANY>)
|
||
|
<ZEVAL <REST .ARGL>>>
|
||
|
.LST>)
|
||
|
(<ILLEGAL "Argument-not-list/FOR-EACH">)>>
|
||
|
|
||
|
"ZPLUS -- two args"
|
||
|
|
||
|
<DEFINE ZPLUS (A B)
|
||
|
<COND (<ASSIGNED? B> <+ .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZMINUS -- two args"
|
||
|
|
||
|
<DEFINE ZMINUS (A B)
|
||
|
<COND (<ASSIGNED? B> <- .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZTIMES -- two args"
|
||
|
|
||
|
<DEFINE ZTIMES (A B)
|
||
|
<COND (<ASSIGNED? B> <* .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZDIVIDED -- two args"
|
||
|
|
||
|
<DEFINE ZDIVIDED (A B)
|
||
|
<COND (<ASSIGNED? B> </ .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZLESS -- two args"
|
||
|
|
||
|
<DEFINE ZLESS (A B)
|
||
|
<COND (<ASSIGNED? B> <L? .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZGREATER -- two args"
|
||
|
|
||
|
<DEFINE ZGREATER (A B)
|
||
|
<COND (<ASSIGNED? B> <G? .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZEQUAL -- two args"
|
||
|
|
||
|
<DEFINE ZEQUAL (A B)
|
||
|
<COND (<ASSIGNED? B> <==? .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZAND -- two args"
|
||
|
|
||
|
<DEFINE ZAND (A B)
|
||
|
<COND (<ASSIGNED? B> <AND .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZOR -- two args"
|
||
|
|
||
|
<DEFINE ZOR (A B)
|
||
|
<COND (<ASSIGNED? B> <OR .A .B>)
|
||
|
(ELSE .A)>>
|
||
|
|
||
|
"ZIS -- fsubr"
|
||
|
|
||
|
<DEFINE ZIS (OBJ LIST)
|
||
|
<ZPRED .OBJ .LIST>>
|
||
|
|
||
|
"ZISNT -- fsubr"
|
||
|
|
||
|
<DEFINE ZISNT (OBJ LIST)
|
||
|
<NOT <ZPRED .OBJ .LIST>>>
|
||
|
|
||
|
"ZPRED -- general predicates"
|
||
|
|
||
|
<DEFINE ZPRED (OBJ EXPR "OPTIONAL" (TTYPE <>)
|
||
|
"AUX" (NTTYPE <>) (VAL <>) (NOT? <>) (BOOL? <>))
|
||
|
#DECL ((OBJ) ANY (EXPR) <OR ATOM LIST>)
|
||
|
<COND (<TYPE? .EXPR ATOM>
|
||
|
<COND (<NOT .TTYPE>
|
||
|
<ZEQUALS .OBJ <ZEVAL .EXPR>>)
|
||
|
(<=? .TTYPE in>
|
||
|
<ZIN .OBJ <ZEVAL .EXPR>>)
|
||
|
(ELSE <ERROR UNKNOWN-TTYPE .TTYPE>)>)
|
||
|
(ELSE
|
||
|
<MAPF <>
|
||
|
<FUNCTION (E)
|
||
|
#DECL ((E) <OR ATOM LIST>)
|
||
|
<COND (<AND <TYPE? .E ATOM> <MEMQ .E ,BUZZ>>)
|
||
|
(<==? .E or> <SET BOOL? <>>)
|
||
|
(<==? .E and> <SET BOOL? T>)
|
||
|
(<==? .E not> <SET NOT? <NOT .NOT?>>)
|
||
|
(<MEMQ .E ,TEST-TYPES> <SET NTTYPE .E>)
|
||
|
(ELSE
|
||
|
<SET NVAL <ZPRED .OBJ .E <OR .NTTYPE .TTYPE>>>
|
||
|
<SET NTTYPE <>>
|
||
|
<COND (.NOT?
|
||
|
<SET NVAL <NOT .NVAL>>
|
||
|
<SET NOT? <>>)>
|
||
|
<COND (.BOOL?
|
||
|
<SET VAL <AND .VAL .NVAL>>)
|
||
|
(ELSE
|
||
|
<SET VAL <OR .VAL .NVAL>>)>)>>
|
||
|
.EXPR>
|
||
|
.VAL)>>
|
||
|
|
||
|
"ZLOOKUP -- fsubr"
|
||
|
|
||
|
<DEFINE ZLKUP (DUMMY ARGL "AUX" M LST)
|
||
|
#DECL ((ARGL) LIST (M) <OR FALSE LIST> (LST) ANY)
|
||
|
<COND (<LENGTH? .ARGL 1> <TOOFEW>)
|
||
|
(<TYPE? <SET LST <ZEVAL <2 .ARGL>>> LIST>
|
||
|
<AND <SET M <MEMQ <ZEVAL <1 .ARGL>> .LST>>
|
||
|
<NOT <LENGTH? .M 1>>>
|
||
|
<2 .M>)
|
||
|
(<ILLEGAL "Lookup in non-list?">)>>
|
||
|
|
||
|
"ZCONTENTS -- fsubr"
|
||
|
|
||
|
<DEFINE ZCONTENTS (DUMMY ARGL "AUX" (ARG .ARGL) ITEM)
|
||
|
#DECL ((ARGL ARG) LIST (ITEM) ANY)
|
||
|
<COND (<OR <EMPTY? .ARGL>
|
||
|
<AND <==? <1 .ARGL> of>
|
||
|
<SET ARG <REST .ARG>>
|
||
|
<LENGTH? .ARGL 1>>>
|
||
|
<TOOFEW>)>
|
||
|
<COND (<TYPE? <SET ITEM <ZEVAL <1 .ARG>>> OBJECT>
|
||
|
<OCONTENTS .ITEM>)
|
||
|
(<TYPE? .ITEM ROOM>
|
||
|
<ROBJS .ITEM>)
|
||
|
(<TYPE? .ITEM ADV>
|
||
|
<AOBJS .ITEM>)
|
||
|
(<ILLEGAL "Unknown/CONTENTS">)>>
|
||
|
|
||
|
"ZSET -- fsubr"
|
||
|
|
||
|
<DEFINE ZSET (DUMMY ARGL)
|
||
|
#DECL ((ARGL) LIST)
|
||
|
<COND (<LENGTH? .ARGL 1>
|
||
|
<TOOFEW>)
|
||
|
(<TYPE? <1 .ARGL> ATOM>
|
||
|
<ZINSERT <SPNAME <1 .ARGL>> ,ZVARS-POBL <ZEVAL <2 .ARGL>>>)
|
||
|
(<ILLEGAL "Non-atomic set?">)>>
|
||
|
|
||
|
"ZDEFINE -- fsubr"
|
||
|
|
||
|
<DEFINE ZDEFINE (DUMMY ARGL "AUX" STR)
|
||
|
#DECL ((ARGL) LIST (STR) STRING)
|
||
|
<COND (<N==? <LENGTH .ARGL> 2>
|
||
|
<WNA>)
|
||
|
(<ZINSERT <SET STR <SPNAME <1 .ARGL>>>
|
||
|
,ZVARS-POBL
|
||
|
<2 .ARGL>>
|
||
|
<ZFUNCTION .STR>
|
||
|
<1 .ARGL>)>>
|
||
|
|
||
|
<DEFINE ZFUNCTION (STR)
|
||
|
#DECL ((STR) STRING)
|
||
|
<ZINSERT .STR
|
||
|
<GET INITIAL OBLIST>
|
||
|
<CHTYPE <LIST () <FORM ZEVAL <FORM ZLOOKUP .STR ,ZVARS-POBL>>> FUNCTION>>>
|
||
|
|
||
|
"ZLOAD -- one arg"
|
||
|
|
||
|
<DEFINE ZLOAD (ARG "AUX" STR)
|
||
|
#DECL ((ARG) ANY (STR) ANY)
|
||
|
<COND (<AND <TYPE? .ARG STRING> <SET STR .ARG>>
|
||
|
<COND (<SET C <OPEN "READ" .STR>>
|
||
|
<SET <ZATOM <7 .C>>
|
||
|
<MAPF ,LIST
|
||
|
<FUNCTION ()
|
||
|
#DECL ((ITM) ANY)
|
||
|
<SET ITM <READ .C '<MAPSTOP>>>
|
||
|
<COND (<TYPE? .ITM LIST>
|
||
|
<ZEVAL .ITM>)>
|
||
|
.ITM>>>
|
||
|
<CLOSE .C>
|
||
|
"Done")
|
||
|
(<ILLEGAL "File not found.">)>)
|
||
|
(<ILLEGAL "Non-string file name?">)>>
|
||
|
|
||
|
"ZATOM -- ??"
|
||
|
|
||
|
<DEFINE ZATOM (STR)
|
||
|
#DECL ((STR) STRING)
|
||
|
<OR <LOOKUP .STR <GET INITIAL OBLIST>>
|
||
|
<INSERT .STR <GET INITIAL OBLIST>>>>
|
||
|
|
||
|
"ZDUMP -- one arg"
|
||
|
|
||
|
<DEFINE ZDUMP (ARG "AUX" STR ATM LST)
|
||
|
#DECL ((ARG) ANY (STR LST) ANY (ATM) ATOM)
|
||
|
<COND (<AND <TYPE? .ARG STRING> <SET STR .ARG>>
|
||
|
<COND (<SET C <OPEN "PRINT" .STR>>
|
||
|
<COND (<AND <ASSIGNED? <SET ATM <ZATOM <7 .C>>>>
|
||
|
<TYPE? <SET LST ..ATM> LIST>>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ITM)
|
||
|
#DECL ((ITM) ANY)
|
||
|
<COND (<AND <TYPE? .ITM LIST>
|
||
|
<==? <1 .ITM> define>>
|
||
|
<PPRINT (define
|
||
|
<2 .ITM>
|
||
|
<ZLOOKUP <SPNAME <2 .ITM>>
|
||
|
,ZVARS-POBL>)
|
||
|
.C>)
|
||
|
(<PPRINT .ITM .C>)>>
|
||
|
.LST>
|
||
|
<CLOSE .C>
|
||
|
<TELL "Done" 0>)
|
||
|
(<ILLEGAL "Not a group?">)>)
|
||
|
(<ILLEGAL "Can't open channel?">)>)
|
||
|
(<ILLEGAL "Non-string file name?">)>>
|
||
|
|
||
|
"ZPPRINT -- one arg"
|
||
|
|
||
|
<DEFINE ZPPRINT (DUMMY ARG)
|
||
|
#DECL ((ARG) ANY)
|
||
|
<ZEDIT <> .ARG T>>
|
||
|
|
||
|
"ZRUN -- fsubr"
|
||
|
|
||
|
<DEFINE ZRUN (DUMMY ARGL "AUX" STR ARG VAL (CEV <>))
|
||
|
#DECL ((ARGL) LIST (STR) STRING (VAL ARG) ANY (CEV) <OR FALSE CEVENT>)
|
||
|
<COND (<EMPTY? .ARGL> <TOOFEW>)
|
||
|
(<AND <TYPE? <SET ARG <1 .ARGL>> ATOM>
|
||
|
<TYPE? <SET VAL <ZLOOKUP <SET STR <SPNAME .ARG>> ,ZVARS-POBL>> LIST>>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ITEM)
|
||
|
<COND (<MEMQ .ITEM '[in moves]>)
|
||
|
(<TYPE? .ITEM FIX>
|
||
|
<SET CEV
|
||
|
<COND (<ZLOOKUP .STR ,ZINT-POBL>)
|
||
|
(<ZINSERT .STR
|
||
|
,ZINT-POBL
|
||
|
<CEVENT 0
|
||
|
<ZATOM .STR>
|
||
|
<>
|
||
|
"**::**">>)>>
|
||
|
<COND (<MEMQ .CEV ,ZINTS>)
|
||
|
(<SETG ZINTS (<LOOKUP .STR ,ZINT-POBL>
|
||
|
.CEV
|
||
|
!,ZINTS)>)>
|
||
|
<MAPLEAVE <CLOCK-ENABLE <CLOCK-INT .CEV .ITEM>>>)
|
||
|
(<ILLEGAL "Bad argument/RUN">)>>
|
||
|
<REST .ARGL>>
|
||
|
<OR .CEV <ZEVAL .VAL>>)
|
||
|
(<ILLEGAL "Not applicable?">)>>
|
||
|
|
||
|
"ZENABLE -- one arg"
|
||
|
|
||
|
<DEFINE ZENABLE (ARG "AUX")
|
||
|
#DECL ((ARG) ANY)
|
||
|
<CLOCK-ENABLE <ZINT-FIND .ARG>>>
|
||
|
|
||
|
"ZDISABLE -- one arg"
|
||
|
|
||
|
<DEFINE ZDISABLE (ARG "AUX")
|
||
|
#DECL ((ARG) ANY)
|
||
|
<CLOCK-DISABLE <ZINT-FIND .ARG>>>
|
||
|
|
||
|
<DEFINE ZINT-FIND (ITEM "AUX" (VARS ,ZVARS-POBL))
|
||
|
#DECL ((ITEM) ANY (VARS) OBLIST)
|
||
|
<COND (<AND <TYPE? .ITEM LIST>
|
||
|
<REPEAT ((L ,ZINTS))
|
||
|
#DECL ((L) <LIST [REST ATOM CEVENT]>)
|
||
|
<COND (<EMPTY? .L> <RETURN <>>)
|
||
|
(<==? <ZLOOKUP <SPNAME <1 .L>> .VARS> .ITEM>
|
||
|
<RETURN <2 .L>>)
|
||
|
(<SET L <REST .L 2>>)>>>)
|
||
|
(<ILLEGAL "Not an interrupt">)>>
|
||
|
|
||
|
"ZEDIT -- fsubr"
|
||
|
|
||
|
<DEFINE ZEDIT (DUMMY ARGL "OPTIONAL" (PRINT? <>) "AUX" L ARG STR)
|
||
|
#DECL ((ARGL) LIST (ARG) ANY (L) ANY (PRINT?) <OR FALSE ATOM> (STR) STRING)
|
||
|
<COND (<EMPTY? .ARGL> <TOOFEW>)
|
||
|
(<TYPE? <SET ARG <1 .ARGL>> ATOM>
|
||
|
<COND (<TYPE? <SET L <ZLOOKUP <SET STR <SPNAME .ARG>> ,ZVARS-POBL>> LIST>
|
||
|
<ZINSERT <SPNAME .ARG> ,ZVARS-POBL <ZEP .L .PRINT?>>
|
||
|
.ARG)
|
||
|
(<TYPE? .L ROOM OBJECT>
|
||
|
<SET VAL <ZEP <ZLOOKUP <SPNAME .ARG> ,ZDEFS-POBL> .PRINT?>>
|
||
|
<ZINSERT .STR ,ZDEFS-POBL .VAL>
|
||
|
<COND (<TYPE? .L ROOM>
|
||
|
<RM/OBJ-CREATE .VAL <>>)
|
||
|
(<RM/OBJ-CREATE .VAL>)>)
|
||
|
(<ILLEGAL "Value of atom not a list?">)>)
|
||
|
(<ILLEGAL "Must edit an atom.">)>>
|
||
|
|
||
|
<DEFINE ZEP (OBJ PRINT?)
|
||
|
#DECL ((OBJ) LIST (PRINT?) <OR ATOM FALSE>)
|
||
|
<COND (.PRINT?
|
||
|
<PPRINT .OBJ>
|
||
|
.OBJ)
|
||
|
(<TELL " Starting edit." 0>
|
||
|
<EDIT OBJ>
|
||
|
<TELL "
|
||
|
Return from edit.">
|
||
|
.OBJ)>>
|
||
|
|
||
|
"zero-arg goodies"
|
||
|
|
||
|
<DEFINE ZWINNER () ,WINNER>
|
||
|
|
||
|
<DEFINE ZTRUE () T>
|
||
|
|
||
|
<DEFINE ZFALSE () <>>
|
||
|
|
||
|
<DEFINE ZSCORE () <ASCORE ,WINNER>>
|
||
|
|
||
|
<DEFINE ZPRSO () <PRSO>>
|
||
|
|
||
|
<DEFINE ZROOM () ,HERE>
|
||
|
|
||
|
<DEFINE ZPRSI () <PRSI>>
|
||
|
|
||
|
<DEFINE ZVERB () <PRSA>>
|
||
|
|
||
|
<DEFINE ZIT () .ZITS>
|
||
|
|
||
|
<DEFINE ZZORK () <OFF "BLOCKED"> <DC>>
|
||
|
|
||
|
"ZTAKE -- one arg"
|
||
|
|
||
|
<DEFINE ZTAKE (ARG "AUX" OBJ)
|
||
|
#DECL ((ARG) ANY (OBJ) ANY)
|
||
|
<COND (<TYPE? .ARG OBJECT>
|
||
|
<REMOVE-OBJECT .OBJ>
|
||
|
<TAKE-OBJECT .OBJ>)>>
|
||
|
|
||
|
"ZREMOVE -- fsubr"
|
||
|
|
||
|
<DEFINE ZREMOVE (DUMMY LST "AUX" OBJ)
|
||
|
#DECL ((LST) LIST (OBJ) ANY)
|
||
|
<COND (<EMPTY? .LST>
|
||
|
<TOOFEW>)
|
||
|
(<MAPF <>
|
||
|
<FUNCTION (ITM)
|
||
|
#DECL ((ITM) ANY)
|
||
|
<COND (<==? .ITM and>)
|
||
|
(<TYPE? <SET OBJ <ZEVAL .ITM>> OBJECT>
|
||
|
<REMOVE-OBJECT .OBJ>)
|
||
|
(<ILLEGAL "Not an object/REMOVE">)>>
|
||
|
.LST>)
|
||
|
(<ILLEGAL "Not an object/REMOVE">)>>
|
||
|
|
||
|
"ZPUTIN -- fsubr"
|
||
|
|
||
|
<DEFINE ZPUTIN (DUMMY LST "AUX" OBJ)
|
||
|
#DECL ((LST) LIST (OBJ) ANY)
|
||
|
<COND (<LENGTH? .LST 1>
|
||
|
<TOOFEW>)
|
||
|
(ELSE
|
||
|
<SET OBJ2 <COND (<MEMQ <2 .LST> ![in into to]>
|
||
|
<COND (<LENGTH? .LST 2>
|
||
|
<TOOFEW>)
|
||
|
(<ZEVAL <3 .LST>>)>)
|
||
|
(<ZEVAL <2 .LST>>)>>
|
||
|
<COND (<TYPE? .OBJ2 LIST>
|
||
|
<CONS <ZEVAL <1 .LST>> .OBJ2>)
|
||
|
(<TYPE? <SET OBJ <ZEVAL <1 .LST>>> OBJECT>
|
||
|
<REMOVE-OBJECT .OBJ>
|
||
|
<COND (<TYPE? .OBJ2 ROOM>
|
||
|
<INSERT-OBJECT .OBJ .OBJ2>)
|
||
|
(<TYPE? .OBJ2 OBJECT>
|
||
|
<INSERT-INTO .OBJ2 .OBJ>)
|
||
|
(<TYPE? .OBJ2 ADV>
|
||
|
<TAKE-OBJECT .OBJ>)
|
||
|
(<ILLEGAL "Illegal operator/INSERT">)>)
|
||
|
(<ILLEGAL "Not an object/INSERT">)>)>>
|
||
|
|
||
|
"ZTELL -- fsubr"
|
||
|
|
||
|
<DEFINE ZTELL (DUMMY LST)
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ITEM)
|
||
|
<COND (<TYPE? .ITEM STRING>
|
||
|
<TELL .ITEM 0>)
|
||
|
(<==? .ITEM crlf>
|
||
|
<TELL "">)
|
||
|
(<TYPE? <SET VAL <ZEVAL .ITEM>> OBJECT>
|
||
|
<TELL <ODESC2 .VAL> 0>)
|
||
|
(<ILLEGAL "Unknown print operator.">)>>
|
||
|
.LST>>
|
||
|
|
||
|
"ZGOTO -- one arg"
|
||
|
|
||
|
<DEFINE ZGOTO (ARG)
|
||
|
#DECL ((ARG) ANY)
|
||
|
<COND (<TYPE? .ARG ROOM> <GOTO .ARG>)
|
||
|
(<ILLEGAL "Not a room/GOTO">)>>
|
||
|
|
||
|
"ZMAKE -- fsubr"
|
||
|
|
||
|
<DEFINE ZMAKE (DUMMY LST "AUX" OBJ (NOT? <MEMQ not .LST>))
|
||
|
#DECL ((LST) LIST (OBJ) ANY (NOT?) <OR FALSE LIST>)
|
||
|
<COND (<OR <AND .NOT? <LENGTH? .LST 2>>
|
||
|
<LENGTH? .LST 1>>
|
||
|
<TOOFEW>)
|
||
|
(<TYPE? <SET OBJ <ZEVAL <1 .LST>>> OBJECT>
|
||
|
<COND (<SET M <ZLOOKUP <SPNAME <COND (.NOT? <3 .LST>) (<2 .LST>)>>
|
||
|
,ZOBITS-POBL>>
|
||
|
<COND (.NOT?
|
||
|
<TRZ .OBJ .M>)
|
||
|
(<TRO .OBJ .M>)>)
|
||
|
(<ILLEGAL "Not an object flag/MAKE">)>)
|
||
|
(<TYPE? .OBJ ROOM>
|
||
|
<COND (<SET M <ZLOOKUP <SPNAME <COND (.NOT? <3 .LST>) (<2 .LST>)>>
|
||
|
,ZRBITS-POBL>>
|
||
|
<COND (.NOT?
|
||
|
<RTRZ .OBJ .M>)
|
||
|
(<RTRO .OBJ .M>)>)
|
||
|
(<ILLEGAL "Not a room flag/MAKE">)>)
|
||
|
(<ILLEGAL "Not a room or object/MAKE">)>>
|
||
|
|
||
|
<DEFINE ZTOPLEVEL () <ERRET>>
|
||
|
|
||
|
<DEFINE ZSTACK& () <ZSTACK T>>
|
||
|
|
||
|
<DEFINE ZSTACK ("OPTIONAL" (FLG <>) "AUX" (F <FRAME>) (LEVEL -1) ARG)
|
||
|
#DECL ((FLG) <OR ATOM FALSE> (F) FRAME (LEVEL) FIX (ARG) ANY)
|
||
|
<REPEAT ()
|
||
|
<COND (<==? <FUNCT .F> TOPLEVEL>
|
||
|
<PRINC "toplevel">
|
||
|
<RETURN>)
|
||
|
(<AND <==? <FUNCT .F> EVAL>
|
||
|
<TYPE? <SET ARG <1 <ARGS .F>>> FORM>
|
||
|
<OR <==? <1 .ARG> ZEVAL>
|
||
|
<==? <1 .ARG> ZPRED>
|
||
|
<==? <1 .ARG> ILLEGAL>>>
|
||
|
<PRIN1 <SET LEVEL <+ .LEVEL 1>>>
|
||
|
<PRINC !\ >
|
||
|
<PRIN1 <1 .ARG>>
|
||
|
<INDENT-TO 10>
|
||
|
<COND (.FLG
|
||
|
<&1 <EVAL <2 .ARG> .F>>
|
||
|
<AND <==? <1 .ARG> ZPRED>
|
||
|
<CRLF>
|
||
|
<INDENT-TO 10>
|
||
|
<&1 <EVAL <3 .ARG> .F>>>)
|
||
|
(<EPRIN1 <EVAL <2 .ARG> .F>>
|
||
|
<AND <==? <1 .ARG> ZPRED>
|
||
|
<CRLF>
|
||
|
<INDENT-TO 10>
|
||
|
<EPRIN1 <EVAL <3 .ARG> .F>>>)>
|
||
|
<CRLF>)>
|
||
|
<SET F <FRAME .F>>>
|
||
|
,NULL>
|
||
|
|
||
|
<DEFINE ZRETURN (DUMMY ARGL)
|
||
|
#DECL ((ARGL) LIST)
|
||
|
<ZRETRY <ZEVAL <2 .ARGL>> <ZEVAL <1 .ARGL>>>>
|
||
|
|
||
|
<DEFINE ZRETRY (TARGET "OPTIONAL" (VAL #LOSE 0) "AUX" (LEVEL -1) (F <FRAME>) ARG)
|
||
|
#DECL ((TARGET LEVEL) FIX (ARG VAL) ANY (F) FRAME)
|
||
|
<COND (<TYPE? .TARGET FIX>
|
||
|
<REPEAT ()
|
||
|
<COND (<==? <FUNCT .F> TOPLEVEL>
|
||
|
<PRINC "Beyond toplevel?">
|
||
|
<RETURN>)
|
||
|
(<AND <==? <FUNCT .F> EVAL>
|
||
|
<TYPE? <SET ARG <1 <ARGS .F>>> FORM>
|
||
|
<OR <==? <1 .ARG> ZEVAL>
|
||
|
<==? <1 .ARG> ZPRED>
|
||
|
<==? <1 .ARG> ILLEGAL>>
|
||
|
<==? <SET LEVEL <+ .LEVEL 1>> .TARGET>>
|
||
|
<COND (<TYPE? .VAL LOSE>
|
||
|
<RETRY .F>)
|
||
|
(<ERRET .VAL .F>)>)>
|
||
|
<SET F <FRAME .F>>>)
|
||
|
(<ILLEGAL "Bad argument to RETRY/RETURN">)>>
|
||
|
|
||
|
<DEFINE ZCREATE (DUMMY ARGL "AUX" TYP)
|
||
|
#DECL ((ARGL) LIST (TYP) ANY)
|
||
|
<COND (<==? <SET TYP <1 .ARGL>> room>
|
||
|
<RM/OBJ-CREATE <REST .ARGL> <>>)
|
||
|
(<==? .TYP object>
|
||
|
<RM/OBJ-CREATE <REST .ARGL>>)
|
||
|
(<==? .TYP syntax>
|
||
|
<SYNTAX-CREATE <REST .ARGL>>)
|
||
|
(<==? .TYP list>
|
||
|
<MAPF ,LIST ,ZEVAL <REST .ARGL>>)
|
||
|
(<ILLEGAL "Unknown type/CREATE">)>>
|
||
|
|
||
|
<SETG HI-RM/OBJ 0>
|
||
|
|
||
|
<DEFINE NEXT-RM/OBJ ()
|
||
|
<STRING "Z" <UNPARSE <SETG HI-RM/OBJ <+ ,HI-RM/OBJ 1>>>>>
|
||
|
|
||
|
<DEFINE RM/OBJ-CREATE (ARGL "OPTIONAL" (OBJ? T)
|
||
|
"AUX" NAME (OBJS ()) RM OBJ SYN ADJ)
|
||
|
#DECL ((ARGL) LIST (NAME) ATOM (OBJS) <LIST [REST OBJECT]>
|
||
|
(RM) ROOM (OBJECT) OBJECT (OBJ?) <OR ATOM FALSE>
|
||
|
(SYN) <UVECTOR [REST PSTRING]> (ADJ) <UVECTOR [REST ADJECTIVE]>)
|
||
|
<MAPF <>
|
||
|
<FUNCTION (ITEM "AUX" OPER VAL VAL2)
|
||
|
#DECL ((ITEM OPER VAL VAL2) ANY)
|
||
|
<COND (<TYPE? .ITEM ATOM>
|
||
|
<SET NAME .ITEM>
|
||
|
<SET VAL <ZLOOKUP <SPNAME .NAME> ,ZVARS-POBL>>
|
||
|
<COND (.OBJ?
|
||
|
<SET OBJ
|
||
|
<COND (<TYPE? .VAL OBJECT> .VAL)
|
||
|
(<GET-OBJ <NEXT-RM/OBJ>>)>>)
|
||
|
(<SET RM
|
||
|
<COND (<TYPE? .VAL ROOM> .VAL)
|
||
|
(<GET-ROOM <NEXT-RM/OBJ>>)>>)>)
|
||
|
(<TYPE? .ITEM LIST>
|
||
|
<COND (<LENGTH? .ITEM 1>
|
||
|
<ILLEGAL "Bad format/CREATE">)
|
||
|
(<==? <SET OPER <1 .ITEM>> property>
|
||
|
<COND (.OBJ?
|
||
|
<PUT .OBJ
|
||
|
,OFLAGS
|
||
|
<BITS-GET ,ZOBITS-POBL <REST .ITEM>>>)
|
||
|
(<PUT .RM
|
||
|
,RBITS
|
||
|
<BITS-GET ,ZRBITS-POBL <REST .ITEM>>>
|
||
|
<RTRO .RM ,RLANDBIT>)>)
|
||
|
(<AND <SET VAL <2 .ITEM>> <>>)
|
||
|
(<==? .OPER name>
|
||
|
<COND (.OBJ?
|
||
|
<PUT .OBJ ,ODESC2 .VAL>)
|
||
|
(<PUT .RM ,RDESC2 .VAL>)>)
|
||
|
(<==? .OPER description>
|
||
|
<COND (.OBJ?
|
||
|
<OPUT .OBJ ODESC1 .VAL T>)
|
||
|
(<PUT .RM ,RDESC1 .VAL>)>)
|
||
|
(<==? .OPER run>
|
||
|
<COND (<TYPE? .VAL ATOM>
|
||
|
<COND (<GASSIGNED? .VAL>)
|
||
|
(<SETG .VAL ,ZFALSE>)>
|
||
|
<COND (.OBJ?
|
||
|
<PUT .OBJ ,OACTION .VAL>)
|
||
|
(<PUT .RM ,RACTION .VAL>)>)
|
||
|
(<ILLEGAL "Bad routine/CREATE">)>)
|
||
|
(<==? .OPER contents>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (FOO)
|
||
|
#DECL ((FOO) ANY)
|
||
|
<COND (<TYPE? <SET VAL2 <ZEVAL .FOO T>>
|
||
|
OBJECT>
|
||
|
<REMOVE-OBJECT .VAL2>)
|
||
|
(<TYPE? .VAL2 LOSE>
|
||
|
<SET VAL2
|
||
|
<RM/OBJ-CREATE (.FOO)>>)
|
||
|
(<ILLEGAL "Bad object/CREATE">)>
|
||
|
<SET OBJS (.VAL2 !.OBJS)>>
|
||
|
<REST .ITEM>>)
|
||
|
(<AND <NOT .OBJ?> <==? .OPER exit>>
|
||
|
<ZEXIT .RM <REST .ITEM>>)
|
||
|
(<AND .OBJ? <==? .OPER synonym>>
|
||
|
<SET SYN
|
||
|
<MAPF ,UVECTOR
|
||
|
<FUNCTION (NAM)
|
||
|
#DECL ((NAM) ANY)
|
||
|
<COND (<TYPE? .NAM ATOM>
|
||
|
<ZSYN .NAM .OBJ>)
|
||
|
(<ILLEGAL "Bad synonym/CREATE">)>>
|
||
|
<REST .ITEM>>>)
|
||
|
(<AND .OBJ? <==? .OPER adjective>>
|
||
|
<SET ADJ
|
||
|
<MAPF ,UVECTOR
|
||
|
<FUNCTION (NAM)
|
||
|
#DECL ((NAM) ANY)
|
||
|
<COND (<TYPE? .NAM ATOM>
|
||
|
<ADD-ZORK ADJECTIVE <SPNAME .NAM>>)
|
||
|
(<ILLEGAL "Bad adjective/CREATE">)>>
|
||
|
<REST .ITEM>>>)
|
||
|
(<ILLEGAL "Bad identifier/CREATE">)>)>>
|
||
|
.ARGL>
|
||
|
<ZINSERT <SPNAME .NAME> ,ZDEFS-POBL .ARGL>
|
||
|
<COND (.OBJ?
|
||
|
<PUT .OBJ ,OCONTENTS ()>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (NOBJ) #DECL ((NOBJ) OBJECT)
|
||
|
<INSERT-INTO .OBJ .NOBJ>>
|
||
|
.OBJS>
|
||
|
<AND <ASSIGNED? SYN> <PUT .OBJ ,ONAMES .SYN>>
|
||
|
<AND <ASSIGNED? ADJ> <PUT .OBJ ,OADJS .ADJ>>
|
||
|
<ZINSERT <SPNAME .NAME> ,ZVARS-POBL .OBJ>
|
||
|
.OBJ)
|
||
|
(<PUT .RM ,ROBJS ()>
|
||
|
<MAPF <>
|
||
|
<FUNCTION (NOBJ) #DECL ((NOBJ) OBJECT)
|
||
|
<INSERT-OBJECT .NOBJ .RM>>
|
||
|
.OBJS>
|
||
|
<ZINSERT <SPNAME .NAME> ,ZVARS-POBL .RM>
|
||
|
.RM)>>
|
||
|
|
||
|
<DEFINE ZSYN (NAM OBJ "AUX" (S <SPNAME .NAM>) STR)
|
||
|
#DECL ((NAM) ATOM (S STR) STRING (OBJ) OBJECT)
|
||
|
<SET STR <UPPERCASE <SUBSTRUC .S 0 <MIN <LENGTH .S> 5>>>>
|
||
|
<PINSERT .STR ,OBJECT-POBL .OBJ>
|
||
|
<PSTRING .STR>>
|
||
|
|
||
|
<DEFINE ZEXIT (THIS LST "AUX" DIR RM RM? (NEXIT <>) (CEXIT <>) (CFCN <>) M EXIT)
|
||
|
#DECL ((LST) LIST (DIR) <OR DIRECTION FALSE> (RM?) ANY (RM THIS) ROOM
|
||
|
(NEXIT) <OR STRING FALSE> (CEXIT CFCN) <OR FALSE ATOM> (EXIT) ANY
|
||
|
(M) <OR FALSE <VECTOR [REST DIRECTION ANY]>>)
|
||
|
<COND (<LENGTH? .LST 2>
|
||
|
<TOOFEW>)
|
||
|
(<SET DIR <PLOOKUP <UPPERCASE <PNAME <1 .LST>>> ,DIRECTIONS-POBL>>
|
||
|
<COND (<==? <2 .LST> to>
|
||
|
<COND (<TYPE? <SET RM? <ZEVAL <3 .LST> T>> ROOM>)
|
||
|
(<TYPE? .RM? LOSE>
|
||
|
<SET RM? <RM/OBJ-CREATE (<3 .LST>) <>>>)
|
||
|
(<TYPE? .RM? STRING>
|
||
|
<SET NEXIT .RM?>)
|
||
|
(<ILLEGAL "Not-a-room/EXIT">)>
|
||
|
<SET RM .RM?>
|
||
|
<SET LST <REST .LST 3>>
|
||
|
<COND (<EMPTY? .LST>)
|
||
|
(<AND <==? <1 .LST> if>
|
||
|
<NOT <LENGTH? .LST 1>>>
|
||
|
<COND (<==? <2 .LST> run>
|
||
|
<COND (<LENGTH? .LST 2>
|
||
|
<SET CFCN <3 .LST>>)
|
||
|
(<ILLEGAL "Bad format/EXIT">)>)
|
||
|
(<SET CEXIT <2 .LST>>)>)
|
||
|
(<ILLEGAL "Bad format/EXIT">)>
|
||
|
<SET EXIT
|
||
|
<COND (.NEXIT <CHTYPE .NEXIT STRING>)
|
||
|
(.CEXIT <CEXIT <SPNAME .CEXIT> <RID .RM> "" <> <>>)
|
||
|
(.CFCN <CEXIT "FROBOZZ" <RID .RM> "" <> .CFCN>)
|
||
|
(.RM)>>
|
||
|
<COND (<SET M <MEMQ .DIR <REXITS .THIS>>>
|
||
|
<PUT .M 2 .EXIT>)
|
||
|
(<PUT .THIS ,REXITS <VECTOR .DIR .EXIT !<REXITS .THIS>>>)>)
|
||
|
(<ILLEGAL "Bad format/EXIT">)>)
|
||
|
(<ILLEGAL "Unknown-direction: " <1 .LST>>)>>
|
||
|
|
||
|
<DEFINE BITS-GET (POBL ARGL "AUX" FX)
|
||
|
#DECL ((ARGL) LIST (POBL) OBLIST (FX) <OR FIX FALSE>)
|
||
|
<MAPF ,+
|
||
|
<FUNCTION (ITEM)
|
||
|
<COND (<AND <TYPE? .ITEM ATOM>
|
||
|
<SET FX <ZLOOKUP <SPNAME .ITEM> .POBL>>>)
|
||
|
(<ILLEGAL "Illegal property.">)>>
|
||
|
.ARGL>>
|
||
|
|
||
|
<DEFINE ZOBLIST (ATM NUM)
|
||
|
<SETG .ATM <MOBLIST .ATM .NUM>>>
|
||
|
|
||
|
<DEFINE ZLOOKUP (STR OBL "AUX" ATM)
|
||
|
#DECL ((STR) STRING (OBL) OBLIST (ATM) <OR FALSE ATOM>)
|
||
|
<AND <SET ATM <LOOKUP .STR .OBL>> ,.ATM>>
|
||
|
|
||
|
<DEFINE ZINSERT (STR OBL VAL)
|
||
|
#DECL ((STR) STRING (OBL) OBLIST (VAL) ANY)
|
||
|
<SETG <OR <LOOKUP .STR .OBL> <INSERT .STR .OBL>> .VAL>>
|
||
|
|
||
|
<DEFINE PINS (POBL VEC)
|
||
|
#DECL ((POBL) OBLIST (VEC) <VECTOR [REST <OR STRING ATOM> ANY]>)
|
||
|
<REPEAT ((V .VEC) ELEM)
|
||
|
#DECL ((V) <VECTOR [REST <OR STRING ATOM> ANY]> (ELEM) <OR STRING ATOM>)
|
||
|
<ZINSERT <COND (<TYPE? <SET ELEM <1 .V>> ATOM>
|
||
|
<PNAME .ELEM>)
|
||
|
(.ELEM)>
|
||
|
.POBL
|
||
|
<2 .V>>
|
||
|
<COND (<EMPTY? <SET V <REST .V 2>>>
|
||
|
<RETURN>)>>>
|
||
|
|
||
|
<ZOBLIST ZOBITS-POBL 17>
|
||
|
<ZOBLIST ZRBITS-POBL 17>
|
||
|
<ZOBLIST ZVARS-POBL 17>
|
||
|
<ZOBLIST ZDEFS-POBL 17>
|
||
|
<ZOBLIST ZINT-POBL 17>
|
||
|
|
||
|
<ZOBLIST ZERO-POBL 17>
|
||
|
<ZOBLIST ONE-POBL 17>
|
||
|
<ZOBLIST TWO-POBL 17>
|
||
|
<ZOBLIST ANY-POBL 17>
|
||
|
|
||
|
<SETG ZINTS ()>
|
||
|
|
||
|
<GDECL (ZINTS) <LIST [REST ATOM CEVENT]>>
|
||
|
|
||
|
<PINS ,ANY-POBL
|
||
|
["edit" ,ZEDIT "pprint" ,ZPPRINT
|
||
|
"if" ,ZIF "case" ,ZCASE "for-each" ,ZFOR-EACH "contents" ,ZCONTENTS
|
||
|
"is" ,ZIS "isnt" ,ZISNT
|
||
|
"define" ,ZDEFINE "set" ,ZSET "run" ,ZRUN "lookup" ,ZLKUP
|
||
|
"remove" ,ZREMOVE "insert" ,ZPUTIN "return" ,ZRETURN "put" ,ZPUTIN
|
||
|
"print" ,ZTELL "make" ,ZMAKE "create" ,ZCREATE]>
|
||
|
|
||
|
<PINS ,TWO-POBL
|
||
|
["and" ,ZAND "or" ,ZOR "plus" ,ZPLUS "minus" ,ZMINUS
|
||
|
"times" ,ZTIMES "divided-by" ,ZDIVIDED "is-greater-than" ,ZGREATER
|
||
|
"is-less-than" ,ZLESS "gt" ,ZGREATER "lt" ,ZLESS "eq" ,ZEQUAL
|
||
|
"equals" ,ZEQUAL]>
|
||
|
|
||
|
<PINS ,ONE-POBL
|
||
|
["retry" ,ZRETRY "goto" ,ZGOTO "take" ,ZTAKE
|
||
|
"load" ,ZLOAD "dump" ,ZDUMP "enable" ,ZENABLE "disable" ,ZDISABLE
|
||
|
]>
|
||
|
|
||
|
<PINS ,ZERO-POBL
|
||
|
["stack" ,ZSTACK "stack&" ,ZSTACK& "toplevel" ,ZTOPLEVEL
|
||
|
"me" ,ZWINNER "hand" ,ZWINNER "player" ,ZWINNER
|
||
|
"handled" ,ZTRUE
|
||
|
"not-handled" ,ZFALSE
|
||
|
"room" ,ZROOM "here" ,ZROOM
|
||
|
"verb" ,ZVERB "zork" ,ZZORK
|
||
|
"objo" ,ZPRSO "direct-object" ,ZPRSO "object" ,ZPRSO
|
||
|
"indirect-object" ,ZPRSI "obji" ,ZPRSI "it" ,ZIT
|
||
|
"score" ,ZSCORE]>
|
||
|
|
||
|
<PINS ,ZOBITS-POBL
|
||
|
["visible" ,OVISON "readable" ,READBIT "burnable" ,BURNBIT
|
||
|
"weapon" ,WEAPONBIT "takeable" ,TAKEBIT "villain" ,VILLAIN
|
||
|
"container" ,CONTBIT "edible" ,FOODBIT "transparent" ,TRANSBIT
|
||
|
"indescribable" ,NDESCBIT "drinkable" ,DRINKBIT "potable" ,DRINKBIT
|
||
|
"light" ,LIGHTBIT "victim" ,VICBIT "flaming" ,FLAMEBIT "tool" ,TOOLBIT
|
||
|
"turnable" ,TURNBIT "vehicle" ,VEHBIT "sacred" ,SACREDBIT "tieable"
|
||
|
,TIEBIT "climbable" ,CLIMBBIT "open" ,OPENBIT "touched" ,TOUCHBIT
|
||
|
"on" ,ONBIT]>
|
||
|
|
||
|
<PINS ,ZRBITS-POBL
|
||
|
["land" ,RLANDBIT "seen" ,RSEENBIT "illuminated" ,RLIGHTBIT
|
||
|
"sacred" ,RSACREDBIT "reservoir" ,RFILLBIT
|
||
|
"inaccessible" ,RMUNGBIT "wallless" ,RNWALLBIT]>
|
||
|
|
||
|
<SETG BUZZ ![a the is]>
|
||
|
|
||
|
<SETG NOTS [not isnt]>
|
||
|
|
||
|
<SETG TEST-TYPES [in]>
|
||
|
|
||
|
<DEFINE ILLEGAL ("OPTIONAL" (STR "Illegal operation.") (STR2 ""))
|
||
|
#DECL ((STR) STRING)
|
||
|
<TELL .STR 0 .STR2>
|
||
|
<LISTEN>>
|
||
|
|
||
|
<DEFINE TOOFEW ("OPTIONAL" WHAT)
|
||
|
<TELL "Too few arguments" 0>
|
||
|
<AND <ASSIGNED? WHAT> <TELL " to " 0 .WHAT>>
|
||
|
<LISTEN>>
|
||
|
|
||
|
<DEFINE WNA ()
|
||
|
<TELL "Wrong number of arguments." 0>
|
||
|
<LISTEN>>
|
||
|
|
||
|
|