89 lines
2.8 KiB
Plaintext
89 lines
2.8 KiB
Plaintext
|
|
|||
|
|
<DEFINE SYNTAX-CREATE (ARGL "AUX" (PREP <>) (PRSO ,EVARG) (PRSI ,EVARG))
|
|||
|
|
#DECL ((ARGL) LIST (PREP) <OR FALSE PREP> (PRSO PRSI) VARG)
|
|||
|
|
<MAPF <>
|
|||
|
|
<FUNCTION (ITEM "AUX" OPER)
|
|||
|
|
#DECL ((ITEM OPER) ANY)
|
|||
|
|
<COND (<AND <TYPE? .ITEM ATOM>
|
|||
|
|
<TYPE? <SET VAL
|
|||
|
|
<PLOOKUP <ZSTR .ITEM>
|
|||
|
|
,WORDS-POBL>>
|
|||
|
|
PREP>
|
|||
|
|
<SET PREP .VAL>>)
|
|||
|
|
(<AND <TYPE? .ITEM LIST> <NOT <LENGTH? .ITEM 1>>>
|
|||
|
|
<COND (<==? <SET OPER <1 .ITEM>> verb>
|
|||
|
|
<SET VERB <2 .ITEM>>)
|
|||
|
|
(<==? .OPER objo>
|
|||
|
|
<SET PRSO <FWIM-ANA <REST .ITEM> .PREP>>)
|
|||
|
|
(<==? .OPER obji>
|
|||
|
|
<SET PRSI <FWIM-ANA <REST .ITEM> .PREP>>)
|
|||
|
|
(<==? .OPER name> <SET NAME <2 .ITEM>>)
|
|||
|
|
(<==? .OPER run>
|
|||
|
|
<SET ACTION <2 .ITEM>>
|
|||
|
|
<COND (<TYPE? .ACTION ATOM>
|
|||
|
|
<OR <GASSIGNED? .ACTION>
|
|||
|
|
<SETG .ACTION ,ZFALSE>>)
|
|||
|
|
(<ILLEGAL "Bad run/CREATE">)>)
|
|||
|
|
(<ILLEGAL "Unknown foo/CREATE">)>
|
|||
|
|
<SET PREP <>>)
|
|||
|
|
(<ILLEGAL "Bad syntax/CREATE">)>>
|
|||
|
|
.ARGL>
|
|||
|
|
<COND (<NOT .ACTION> <ILLEGAL "No routine specified/CREATE">)
|
|||
|
|
(<TYPE? <SET VAL <PLOOKUP <SET STR <ZSTR .NAME>> ,WORDS-POBL>>
|
|||
|
|
VERB>
|
|||
|
|
<PUT .VAL 2 .ACTION>)
|
|||
|
|
(<PINSERT .STR
|
|||
|
|
,WORDS-POBL
|
|||
|
|
<SET VAL <CHTYPE [<PSTRING .STR> .ACTION] VERB>>>)>
|
|||
|
|
<SET SYN <CHTYPE [.PRSO .PRSI .VAL 0] SYNTAX>>
|
|||
|
|
<COND
|
|||
|
|
(<TYPE? <SET VAL <PLOOKUP <SET STR <ZSTR .VERB>> ,ACTIONS-POBL>>
|
|||
|
|
ACTION>
|
|||
|
|
<COND (<MAPR <>
|
|||
|
|
<FUNCTION (SL "AUX" (X <1 .SL>))
|
|||
|
|
#DECL ((SL) <UVECTOR [REST SYNTAX]> (X) SYNTAX)
|
|||
|
|
<COND (<AND <==? <VPREP <1 .X>> <VPREP .PRSO>>
|
|||
|
|
<==? <VPREP <2 .X>> <VPREP .PRSI>>>
|
|||
|
|
<MAPLEAVE <PUT .SL 1 .SYN>>)>>
|
|||
|
|
<2 .VAL>>)
|
|||
|
|
(<PUT .VAL 2 <UVECTOR .SYN !<2 .VAL>>>)>)
|
|||
|
|
(<PINSERT .STR
|
|||
|
|
,ACTIONS-POBL
|
|||
|
|
<SET VAL
|
|||
|
|
<CHTYPE [<PSTRING .STR>
|
|||
|
|
<UVECTOR .SYN>
|
|||
|
|
<PNAME .VERB>] ACTION>>>)>
|
|||
|
|
.VAL>
|
|||
|
|
|
|||
|
|
<DEFINE ZSTR (ATM "AUX" (STR <SPNAME .ATM>))
|
|||
|
|
#DECL ((ATM) ATOM (STR) STRING)
|
|||
|
|
<UPPERCASE <SUBSTRUC .STR 0 <MIN <LENGTH .STR> 5>>>>
|
|||
|
|
|
|||
|
|
<DEFINE FWIM-ANA (ARGL PREP "AUX" (V <IVECTOR 4>) (FWIM 0) (SUM 0) BIT)
|
|||
|
|
#DECL ((ARGL) LIST (PREP) <OR FALSE PREP> (FWIM) FIX (BIT) <OR FALSE FIX>)
|
|||
|
|
<PUT .V ,VPREP .PREP>
|
|||
|
|
<PUT .V ,VBIT -1>
|
|||
|
|
<COND (<EMPTY? .ARGL>
|
|||
|
|
<SET ARGL (-1 hand room)>)>
|
|||
|
|
<MAPF <>
|
|||
|
|
<FUNCTION (ITEM)
|
|||
|
|
#DECL ((ITEM) ANY)
|
|||
|
|
<COND (<TYPE? .ITEM ATOM>
|
|||
|
|
<COND (<SET BIT <ZLOOKUP <SPNAME .ITEM> ,ZOBITS-POBL>>
|
|||
|
|
<SET FWIM <+ .FWIM .BIT>>)
|
|||
|
|
(<==? .ITEM take>
|
|||
|
|
<SET SUM <+ .SUM ,VTBIT ,VCBIT>>)
|
|||
|
|
(<==? .ITEM try>
|
|||
|
|
<SET SUM <+ .SUM ,VTBIT>>)
|
|||
|
|
(<==? .ITEM have>
|
|||
|
|
<SET SUM <+ .SUM ,VCBIT>>)
|
|||
|
|
(<==? .ITEM room>
|
|||
|
|
<SET SUM <+ .SUM ,VRBIT>>)
|
|||
|
|
(<==? .ITEM hand>
|
|||
|
|
<SET SUM <+ .SUM ,VABIT>>)>)
|
|||
|
|
(<ILLEGAL "Bad syntax/CREATE">)>>
|
|||
|
|
.ARGL>
|
|||
|
|
<PUT .V ,VWORD .SUM>
|
|||
|
|
<CHTYPE <PUT .V ,VFWIM .FWIM> VARG>>
|
|||
|
|
|
|||
|
|
|