zorkzero/find.zil

556 lines
18 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

"FIND file for NEW PARSER
Copyright (C) 1988 Infocom, Inc. All rights reserved."
<ZZSECTION "FIND">
<INCLUDE "BASEDEFS" "PDEFS" "PBITDEFS">
<USE "NEWSTRUC" "PARSER" "PMEM">
<FILE-FLAGS MDL-ZIL? CLEAN-STACK? ;ZAP-TO-SOURCE-DIRECTORY?>
<BEGIN-SEGMENT 0>
<PUT-DECL BOOLEAN '<OR ATOM FALSE>>
<DEFMAC FD-FLAG (WHICH 'VAL "OPT" 'NEW)
<COND (<ASSIGNED? NEW>
<COND (<OR <TYPE? .NEW ATOM FALSE>
<AND <TYPE? .NEW FORM>
<EMPTY? .NEW>>>
<COND (<TYPE? .NEW ATOM>
;"Just turning flag on"
<FORM ORB ,.WHICH .VAL>)
(T
<FORM ANDB .VAL <XORB ,.WHICH -1>>)>)
(<TYPE? .VAL FIX LVAL GVAL>
<FORM COND
(.NEW
<FORM ORB .VAL ,.WHICH>)
(T
<FORM ANDB .VAL <XORB ,.WHICH -1>>)>)
(T
<FORM BIND ((FLAG .VAL))
<FORM COND
(.NEW
<FORM ORB ,.WHICH '.FLAG>)
(T
<FORM ANDB '.FLAG <XORB ,.WHICH -1>>)>>)>)
(T
<FORM NOT <FORM 0? <FORM ANDB .VAL ,.WHICH>>>)>>
<MSETG FIND-FLAGS-GWIM 1>
<DEFMAC FIND-GWIM? ('F)
<FORM NOT <FORM 0? <FORM ANDB <FORM FIND-FLAGS .F> ,FIND-FLAGS-GWIM>>>>
<CONSTANT FINDER <MAKE-FINDER>>
<GLOBAL P-NOT-HERE:NUMBER ;BYTE 0>
"FIND-DESCENDANTS, MATCH-OBJECT, and ADD-OBJECT all return false when the
search should be stopped prematurely because some object was an exact
match. If there's a big red book and a big ugly red book, BIG RED BOOK
will get the former, since it's the only way to do so."
<DEFINE FIND-DESCENDANTS FD
(PARENT:OBJECT FLAGS:FIX ;"INCLUDE, SEARCH, NEST, NOTOP"
"AUX" (F ,FINDER) FOBJ:<OR FALSE OBJECT>)
<COND (<EQUAL? .PARENT ,GLOBAL-HERE>
<SET PARENT ,HERE>)>
<COND (<SET FOBJ <FIRST? .PARENT>>
;"This guy contains something"
<REPEAT ()
;"See if the current object matches: if so, add it to the list"
<COND
(<VISIBLE? .FOBJ>
<COND (<AND <NOT <FD-FLAG FD-NOTOP? .FLAGS> ;<BTST .FLAGS 8>>
<NOT <MATCH-OBJECT .FOBJ .F
<FD-FLAG FD-INCLUDE? .FLAGS>
;<BTST .FLAGS 1>>>>
<RETURN <> .FD>)>
<COND (<AND <FD-FLAG FD-NEST? .FLAGS> ;<BTST .FLAGS 4>
<FIRST? .FOBJ>
<N==? .FOBJ ,WINNER>
<OR ;,P-MOBY-FLAG
<AND <FSET? .FOBJ ,SEARCHBIT>
<OR <FSET? .FOBJ ,OPENBIT>
<FSET? .FOBJ ,TRANSBIT>>>
<FSET? .FOBJ ,SURFACEBIT>>>
;"Check its contents"
<COND (<NOT <FIND-DESCENDANTS .FOBJ
<FD-FLAG FD-INCLUDE? ,FD-NEST?
<FD-FLAG FD-INCLUDE? .FLAGS>>
;<COND (<BTST .FLAGS 1> 5) (T 4)>>>
<RETURN <> .FD>)>)>)>
;"Check next sibling"
<COND (<NOT <SET FOBJ <NEXT? .FOBJ>>>
<RETURN T .FD>)>>)
(T)>>
<DEFINE EXCLUDED? EX (FOBJ:OBJECT F:FINDER
"AUX" (EXC:<OR FALSE PMEM> <FIND-EXCEPTIONS .F>))
<COND (.EXC
<REPEAT ((PHRASE:PMEM <NPP-NOUN-PHRASE .EXC>)
(CT:FIX <NOUN-PHRASE-COUNT .PHRASE>)
(VEC <REST-TO-SLOT .PHRASE NOUN-PHRASE-OBJ1>) VV)
<REPEAT ()
<COND (<L? <SET CT <- .CT 1>> 0>
<SET VV <>>
<RETURN>)>
<COND (<==? .FOBJ <ZGET .VEC 0>>
<SET VV T>
<RETURN>)>
<SET VEC <ZREST .VEC 4 ;2>>>
<COND (.VV
<RETURN T .EX>)
(<SET EXC <NPP-NEXT .EXC>>
<SET PHRASE <NPP-NOUN-PHRASE .EXC>>
<SET CT <NOUN-PHRASE-COUNT .PHRASE>>
<SET VEC <REST-TO-SLOT .PHRASE NOUN-PHRASE-OBJ1>>)
(T
<RETURN <> .EX>)>>)>>
<DEFINE MATCH-OBJECT (FOBJ:OBJECT F:FINDER INCLUDE?:BOOLEAN
"AUX" NOUN ADJS APP TB (RES <FIND-RES .F>))
<COND (<AND <NOT <FSET? .FOBJ ,INVISIBLE>>
<OR <EQUAL? <SET NOUN <FIND-NOUN .F>> <> ,W?ONE>
<AND <SET TB <GETPT .FOBJ ,P?SYNONYM>>
<ZMEMQ .NOUN .TB </ <PTSIZE .TB>:FIX 2>>>>
<OR <NOT <SET ADJS <FIND-OF .F>>>
<CHECK-ADJS .FOBJ .F .ADJS>>
<OR <NOT <SET ADJS <FIND-ADJS .F>>>
<CHECK-ADJS .FOBJ .F .ADJS>>
<NOT <EXCLUDED? .FOBJ .F>>
<OR <FIND-GWIM? .F>
<NOT <INVALID-OBJECT? .FOBJ>>>>
;"This object matches the words used..."
<COND (<NOT .INCLUDE?> ;"location didn't match the syntax bits"
T)
(<AND <T? <SET ADJS <FIND-ADJS .F>>>
<EQUAL? <ADJS-COUNT .ADJS>
<COND (T ;<CHECK-EXTENDED?>
</ <PTSIZE <GETPT .FOBJ ,P?ADJECTIVE>> 2>)
;(T <- <PTSIZE <GETPT .FOBJ ,P?ADJECTIVE>> 1>)>>>
;"the only way to do so."
<FIND-RES-COUNT .RES 1>
<FIND-RES-NEXT .RES <>>
<FIND-RES-OBJ1 .RES .FOBJ>
<COND (<EQUAL? .FOBJ ,HERE>
<FIND-RES-OBJ1 .RES ,GLOBAL-HERE>)>
<>)
(<AND <T? <SET APP <FIND-APPLIC .F>>>
<NOT <FIND-GWIM? .F>>>
;"We're not GWIMming, so apply the test only if there's an
ambiguity"
<COND (<OR <0? <FIND-RES-COUNT .RES>>
<FIND-QUANT .F>>
;"Don't have anything yet"
<ADD-OBJECT .FOBJ .F>)
(<TEST-OBJECT .FOBJ .APP .F>
;"We already have something, so first find out if
this one's OK"
<COND (<1? <FIND-RES-COUNT .RES>>
;"There's only one other object"
<COND (<NOT <TEST-OBJECT
<FIND-RES-OBJ1 .RES>
.APP .F>>
;"The other object doesn't match, so just
replace it"
<FIND-RES-OBJ1 .RES .FOBJ>
<COND (<EQUAL? .FOBJ ,HERE>
<FIND-RES-OBJ1 .RES ,GLOBAL-HERE>)>
T)
(T
;"The other object also matches, so
we're stuck"
<ADD-OBJECT .FOBJ .F>)>)
(T
;"We already have more than one object, so
we're losing"
<ADD-OBJECT .FOBJ .F>)>)>)
(<F? .APP>
<COND (<OR <NOT <FIND-GWIM? .F>>
<FIND-QUANT .F>> ;"DETERMINE-OBJ w/ PICK"
<ADD-OBJECT .FOBJ .F>)
(T)>)
(<TEST-OBJECT .FOBJ .APP .F>
<ADD-OBJECT .FOBJ .F>)
(T)>)
(T)>>
<MSETG SYN-FIND-PROP *400*> ;"If set, look for this property"
<DEFINE TEST-OBJECT TO (FOBJ:OBJECT APP:<OR FIX TABLE> F:FINDER)
<COND (<NOT <TABLE? .APP>>
<COND (<NOT <0? <ANDB .APP ,SYN-FIND-NEGATE>>>
<NOT <FSET? .FOBJ <ANDB .APP *77*>>>)
(T
<FSET? .FOBJ .APP>)>)
(T
<COND (<NOT <0? <ANDB <ZGET .APP 1> ,SYN-FIND-PROP>>>
<COND (<EQUAL? <GETP .FOBJ <ANDB <ZGET .APP 1> *77*>>
<ZGET .APP 2>>
<RETURN T .TO>)
(T <RETURN <> .TO>)>)>
<REPEAT ((N:FIX <ZGET .APP 0>) NN)
<SET NN <ZGET .APP .N>>
<COND (<NOT <0? <ANDB .NN ,SYN-FIND-NEGATE>>>
<COND (<NOT <FSET? .FOBJ <ANDB .NN *77*>>>
<RETURN T .TO>)>)
(<FSET? .FOBJ .NN>
<RETURN T .TO>)>
<COND (<L? <SET N <- .N 1>> 1>
<RETURN <> .TO>)>>)>>
"Object matches all other tests. Here do checks with quantities
(all, one, etc.), then add if OK."
<DEFINE ADD-OBJECT (OBJ:OBJECT F:FINDER "AUX" (VEC <FIND-RES .F>) NC
(DOIT? T) (SYN <FIND-SYNTAX .F>) (WHICH <FIND-WHICH .F>))
<COND (<EQUAL? .OBJ ,HERE>
<SET OBJ ,GLOBAL-HERE>)> ;"per PDL 29-Apr-88"
<COND (<AND <NOT <FIND-QUANT .F>>
.SYN
<==? 1 <FIND-RES-COUNT .VEC>:FIX>>
<COND (<MULTIPLE-EXCEPTION? .OBJ .SYN .WHICH .F>
<SET DOIT? <>>)
(<MULTIPLE-EXCEPTION? <FIND-RES-OBJ1 .VEC> .SYN .WHICH .F>
<FIND-RES-OBJ1 .VEC .OBJ>
<SET DOIT? <>>)>)>
<COND (<AND .DOIT?
<OR <NOT <FIND-QUANT .F>>
<NOT <FIND-SYNTAX .F>>
<NOT <MULTIPLE-EXCEPTION? .OBJ ;"wrong theory of ALL?"
<FIND-SYNTAX .F>
<FIND-WHICH .F>
.F>>>
;"In case an object gets found twice..."
<SET WHICH <NOT-IN-FIND-RES? .OBJ .VEC>>>
<FIND-RES-COUNT .VEC ;<SET NC > <+ 1 <FIND-RES-COUNT .VEC>>>
<COND ;(<AND <IN? <SET NC <META-LOC .OBJ>> ,ROOMS>
<NOT <EQUAL? .NC <META-LOC ,WINNER>>>>
<ZPUT .WHICH 0 <- 0 .OBJ>>) ;"adjacent room"
(T
<ZPUT .WHICH 0 .OBJ>)>
;<COND (<L=? .NC <FIND-RES-SIZE .VEC>>
<ZPUT <REST-TO-SLOT .VEC FIND-RES-OBJ1>
<- .NC 1>
.OBJ>)>
<N==? <FIND-QUANT .F> ,NP-QUANT-A>)
(T)>>
<DEFINE NOT-IN-FIND-RES? ACT (OBJ VEC "OPT" (NO-CHANGE? <>))
<REPEAT ((CT <FIND-RES-COUNT .VEC>)
(SZ <FIND-RES-SIZE .VEC>) ANS NVEC)
<SET ANS <REST-TO-SLOT .VEC FIND-RES-OBJ1>>
<COND (<L? .CT 1>
<RETURN .ANS .ACT>)
(<G? .CT .SZ>
<SET CT <- .CT .SZ>>)
(T <SET SZ .CT>)>
<COND (<INTBL? .OBJ .ANS .SZ>
<RETURN <> .ACT>)
(<T? <SET NVEC <FIND-RES-NEXT .VEC>>>
<SET VEC .NVEC>
<SET SZ ,FIND-RES-MAXOBJ ;<OBJLIST-SIZE .VEC>>)
(<L? .SZ ,FIND-RES-MAXOBJ ;<FIND-RES-SIZE .VEC>>
<RETURN <ZREST .ANS <* 2 .SZ>> .ACT>)
(<T? .NO-CHANGE?>
<RETURN T .ACT>)
(T
<SET SZ ,FIND-RES-MAXOBJ ;<FIND-RES-SIZE .VEC>>
<SET NVEC <PMEM-ALLOC OBJLIST
;"SIZE .SZ"
LENGTH <- ,FIND-RES-LENGTH 1>>>
<FIND-RES-NEXT .VEC .NVEC>
<RETURN <REST-TO-SLOT .NVEC FIND-RES-OBJ1> .ACT>)>>>
"EVERYWHERE-VERB? -- separately defined so game can call it"
<DEFINE EVERYWHERE-VERB? ("OPT" (WHICH <FIND-WHICH ,FINDER>)
(SYNTAX <PARSE-SYNTAX ,PARSE-RESULT>)
"AUX" SYN)
<COND (<==? .WHICH 1>
<SET SYN <SYNTAX-SEARCH .SYNTAX 1>>)
(T
<SET SYN <SYNTAX-SEARCH .SYNTAX 2>>)>
<COND (<AND <ANDB ,SEARCH-MOBY .SYN>
<NOT <ANDB ,SEARCH-MUST-HAVE .SYN>>>
T)>>
"MULTIPLE-EXCEPTION? -- return true if an object found by ALL should not
be include when the crunch comes."
<DEFINE MULTIPLE-EXCEPTION? (OBJ:OBJECT SYNTAX:VERB-SYNTAX WHICH:FIX F:FINDER
"AUX" (L <LOC .OBJ>) (VB <SYNTAX-ID .SYNTAX>))
<COND (<EQUAL? .OBJ <> ,ROOMS ;,NOT-HERE-OBJECT>
<SETG P-NOT-HERE <+ 1 ,P-NOT-HERE>>
T)
(<AND <0? <EVERYWHERE-VERB? .WHICH .SYNTAX>>
<NOT <ACCESSIBLE? .OBJ>>>
T)
(<AND <==? .VB ,V?TAKE>
<ZERO? <FIND-NOUN .F>>
<1? .WHICH>>
<COND (<AND <NOT <FSET? .OBJ ,TAKEBIT>>
<NOT <FSET? .OBJ ,TRYTAKEBIT>>>
T)
(<EQUAL? .L ,WINNER>
;<AND <NOT <EQUAL? .L ,WINNER <LOC ,WINNER> ,HERE>>
<NOT <FSET? .L ,SURFACEBIT>>
<NOT <FSET? .L ,SEARCHBIT>>>
T)>)
(<==? .VB ,V?DROP>
<COND (<NOT <IN? .OBJ ,WINNER>>
T)>)
;(<AND ,PRSI
<==? ,PRSO ,PRSI>>
;"VERB ALL and prso = prsi"
<RTRUE>)
;(<AND <==? .VB ,V?PUT>
<NOT <IN? .OBJ ,WINNER>>
<HELD? ,PRSO ,PRSI>>
;"PUT ALL IN X and object already in x"
<RTRUE>)>>
<ADD-WORD OPEN ADJ>
<ADD-WORD CLOSED ADJ>
<ADD-WORD SHUT ADJ>
<DEFINE CHECK-ADJS CA (OBJ:OBJECT F ADJS:PMEM
"AUX" CNT (TMP <>) OWNER (ID <>) VEC)
<SET OWNER <GETP .OBJ ,P?OWNER>>
<COND (<OR <PMEM-TYPE? .ADJS NP> ;"it's NP-OF"
<SET TMP <ADJS-POSS .ADJS>>>
<COND (<OBJECT? <SET ID .OWNER>>
<COND (<EQUAL? .OWNER .TMP .OBJ>
T)
(<EQUAL? .OWNER ,ROOMS ;"any">
<SET ID <FIND-RES-OBJ1 ,OWNER-SR-HERE>> ;"real owner")
(<ZERO? <SET TMP <FIND-RES-COUNT ,OWNER-SR-THERE>>>
<RETURN <> .CA>)
(<NOT <INTBL? .OWNER
<REST-TO-SLOT ,OWNER-SR-THERE FIND-RES-OBJ1>
.TMP>>
<RETURN <> .CA>)>)
(<T? .OWNER> ;"table for multiple owners (body parts)"
;<SET ID <>>
<COND (<AND ;<ZERO? .ID>
<ZERO? <SET CNT <FIND-RES-COUNT ,OWNER-SR-HERE>>>
;<SET ID <INTBL? ,PLAYER .TMP <ZGET .OWNER 0>>>>
<SET ID ,PLAYER> ;"default owner of body part"
;<SET ID <ZGET .ID 0>>)
(T
<SET TMP <ZREST .OWNER 2>>
<SET VEC <REST-TO-SLOT ,OWNER-SR-HERE FIND-RES-OBJ1>>
<REPEAT ()
<COND (<DLESS? CNT 0>
<RETURN <> .CA>)
(<SET ID
<INTBL? <ZGET .VEC 0> .TMP <ZGET .OWNER 0>>>
<SET ID <ZGET .ID 0>>
<RETURN>)
(T <SET VEC <ZREST .VEC 2>>)>>)>)
(<OBJECT? .TMP> ;"possession"
<COND (<NOT <HELD? .OBJ .TMP>>
<RETURN <> .CA>)>)
(T ;"possession"
<COND (<ZERO? <SET TMP <FIND-RES-COUNT ,OWNER-SR-HERE>>>
<RETURN <> .CA>)
(<NOT <SET ID <INTBL? <LOC .OBJ>
<REST-TO-SLOT ,OWNER-SR-HERE FIND-RES-OBJ1>
.TMP>>>
<RETURN <> .CA>)
;(T <SET ID <ZGET .ID 0>>)>)>)>
<COND (<NOT <EQUAL? .ID 0 .OBJ>> ;<T? .ID>
<FIND-RES-OWNER <FIND-RES .F> .ID>)>
<COND (<NOT <PMEM-TYPE? .ADJS NP>>
<SET VEC <REST-TO-SLOT .ADJS ADJS-COUNT 1>>
<REPEAT ((CT <ADJS-COUNT .ADJS>) ADJ FL
(OADJS <GETPT .OBJ ,P?ADJECTIVE>)
(NUM </ <PTSIZE .OADJS>:FIX 2>))
<COND (<L? <SET CT <- .CT 1>> 0>
<RETURN>)>
<COND
(T ;<CHECK-EXTENDED?>
<SET ADJ <ZGET .VEC .CT>>
<SET ID .ADJ>)
;(T
<COND (<0? <SET ID <WORD-ADJ-ID <SET ADJ <ZGET .VEC .CT>>>>>
<COND (<NOT <IF-MUDDLE <COND (<GASSIGNED? SPECIAL-ADJ-CHECK>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>)>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>>
<RETURN <> .CA>)>)>)>
<COND (<EQUAL? .ADJ ,W?NO.WORD>
<AGAIN>)
(<ZMEMQ .ID .OADJS .NUM>
;<COND (T ;<CHECK-EXTENDED?>
)
;(T <ZMEMQB .ID .OADJS <- <PTSIZE .OADJS>:FIX 1>>)>)
(<AND <EQUAL? .ID ,W?CLOSED ,W?SHUT>
<NOT <FSET? .OBJ ,OPENBIT>>>)
(<AND <EQUAL? .ID ,W?OPEN>
<FSET? .OBJ ,OPENBIT>>)
;(<VERSION? (ZIP <>)
(T
<IF-MUDDLE <AND <GASSIGNED? SPECIAL-ADJ-CHECK>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>
<SPECIAL-ADJ-CHECK .ADJ .OBJ>>)>)
(T
<RETURN <> .CA>)>>)>
T>
<OBJECT GENERIC-OBJECTS
(ADJACENT 0) ;"to establish property">
<DEFINE FIND-OBJECTS ("OPT" (SEARCH:FIX
<COND (<==? 1 <FIND-WHICH ,FINDER>>
<SYNTAX-SEARCH <PARSE-SYNTAX ,PARSE-RESULT>
1>)
(T
<SYNTAX-SEARCH <PARSE-SYNTAX ,PARSE-RESULT>
2>)>)
(PARENT:<OR OBJECT FALSE> <>)
"AUX" GLBS (CONT? T) N:FIX (RES <FIND-RES ,FINDER>))
;<MAKE-FIND-RES 'FIND-RES .RES 'FIND-RES-COUNT 0>
<FIND-RES-COUNT .RES 0>
<FIND-RES-NEXT .RES <>>
;"Initialize world"
<COND (<AND .PARENT
;<NOT <IN? .PARENT ,GLOBAL-OBJECTS>>
<OR <NOT <FIND-DESCENDANTS .PARENT
<ORB ,FD-INCLUDE? ,FD-SEARCH? ,FD-NEST?>;7>>
<NOT <0? <FIND-RES-COUNT .RES>:FIX>>>>
;"In case we have `the foo in the bar' or `a picture on the wall'"
;<SET CONT? <>>
T)
(T
<COND (.PARENT
<COND (<NOT <SET GLBS <FIND-ADJS ,FINDER>>>
<FIND-ADJS ,FINDER
<SET GLBS <PMEM-ALLOC ADJS>>>)>
<COND (<NOT <ADJS-POSS .GLBS>>
<ADJS-POSS .GLBS .PARENT>)>)>
<COND (<AND <T? <ANDB .SEARCH ,SEARCH-MOBY ;128>>
<F? <ANDB .SEARCH ,SEARCH-MUST-HAVE>>
<FIRST? ,GENERIC-OBJECTS>
;<NOT <FIND-DESCENDANTS ,GENERIC-OBJECTS .SEARCH>>>
<REPEAT ((OBJ <FIRST? ,GENERIC-OBJECTS>))
<COND (<NOT <MATCH-OBJECT .OBJ ,FINDER T>>
<RETURN>)
(<NOT <SET OBJ <NEXT? .OBJ>>>
<RETURN>)>>
<COND (<NOT <0? <SET CONT? <FIND-RES-COUNT .RES>>:FIX>>
<RETURN <1? .CONT?:FIX>>)>)>
<PROG ((LOSING? <>))
<COND
(<OR <AND <NOT .LOSING?> ;"redundant?"
<NOT <0? <ANDB .SEARCH ,SEARCH-CARRIED ;12>>>>
.LOSING?>
<SET CONT?
<FIND-DESCENDANTS ,WINNER
<FD-FLAG FD-NOTOP?
<FD-FLAG FD-INCLUDE?
<FD-FLAG FD-NEST? ,FD-SEARCH?
<OR .LOSING? ;"search pockets?"
<NOT <0? <ANDB .SEARCH ,SEARCH-POCKETS ;8>>>>>
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-CARRIED ;12>>>>>
<AND <NOT .LOSING?>
<0? <ANDB .SEARCH ,SEARCH-HELD ;4>>>>>>)>
<COND
(<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-IN-ROOM ;3>>>>
<SET CONT?
<FIND-DESCENDANTS ,HERE
<FD-FLAG FD-NOTOP?
<FD-FLAG FD-NEST?
<FD-FLAG FD-INCLUDE? ,FD-SEARCH?
<AND ;,LIT
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-IN-ROOM ;3>>>>>>
<OR .LOSING?
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND ;2>>>>>
<AND <NOT .LOSING?>
<0? <ANDB .SEARCH ,SEARCH-ON-GROUND ;1>>>>>>)>
<COND (<NOT <0? <FIND-RES-COUNT .RES>>>
<RETURN>)
(<AND <NOT <BTST .SEARCH ,SEARCH-ALL>>
<NOT .LOSING?>>
<COND (<AND <SET GLBS <LEXV-WORD ,TLEXV>>
<OR <T? <WORD-CLASSIFICATION-NUMBER .GLBS>>
<T? <WORD-SEMANTIC-STUFF .GLBS>>>>
<SET LOSING? T> ;"not a sample command"
<AGAIN>)
(<AND <BAND ,SEARCH-MUST-HAVE .SEARCH>
<NOT <BAND ,SEARCH-MOBY .SEARCH>>>
<RFALSE>)>)>
<COND (<SET GLBS <GETPT ,HERE ,P?GLOBAL>>
<COND (T ;<CHECK-EXTENDED?>
<SET N </ <PTSIZE .GLBS>:FIX 2>>)
;(T <SET N <- <PTSIZE .GLBS>:FIX 1>>)>
<REPEAT (O:OBJECT)
<COND (<L? <SET N <- .N 1>> 0>
<RETURN>)
(<NOT <SET CONT?
<MATCH-OBJECT
<COND (T ;<CHECK-EXTENDED?>
<SET O <ZGET .GLBS .N>>)
;(T <SET O <GETB .GLBS .N>>)>
,FINDER T>>>
<RETURN>)
(<AND <FIRST? .O>
<ZAPPLY ,SEARCH-IN-LG? .O>
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND>>>>
<COND
(<NOT
<SET CONT?
<FIND-DESCENDANTS .O ,FD-INCLUDE? ;1>>>
<RETURN>)>)>>)>
<COND (<AND .CONT?
<NOT <EXCLUDE-HERE-OBJECT?>>>
<SET CONT? <MATCH-OBJECT ,HERE ,FINDER T>>)>
<COND (<AND .CONT? <GETP ,HERE ,P?THINGS>>
<SET CONT? <ZAPPLY ,TEST-THINGS ,HERE ,FINDER>>)>
<COND (<NOT <0? <FIND-RES-COUNT .RES>>>
<SET CONT? <>>)>
<COND (.CONT?
<SET CONT?
<FIND-DESCENDANTS ,GLOBAL-OBJECTS
<FD-FLAG FD-NEST? ,FD-INCLUDE?
<NOT <0? <ANDB .SEARCH ,SEARCH-OFF-GROUND ;2>>>>
;<COND (<BTST .SEARCH 2> 5) (T 1)>>>)>
<COND (<AND .CONT?
<0? <FIND-RES-COUNT .RES>:FIX>
;<BTST .SEARCH ,SEARCH-ADJACENT>
<SET GLBS <GETP ,HERE ,P?ADJACENT>>>
<SET N <GETB .GLBS 0>>
;<SET LOSING? ,HERE>
<REPEAT ((SCH <ANDB .SEARCH <XORB -1 ,SEARCH-ADJACENT>>))
<COND (<T? <GETB .GLBS .N>> ;"room visible now?"
;<SETG HERE <GETB .GLBS <SET N <- .N 1>>>>
<FIND-OBJECTS .SCH <GETB .GLBS <SET N <- .N 1>>>>)
(T
<SET N <- .N 1>>)>
<COND (<L? <SET N <- .N 1>> 1>
<RETURN>)>>
;<SETG HERE .LOSING?>
<COND (<NOT <0? <FIND-RES-COUNT .RES>:FIX>>
<SET CONT? <>>)>)>
<COND
(<AND .CONT?
<0? <FIND-RES-COUNT .RES>:FIX>
<ZAPPLY ,MOBY-FIND? .SEARCH>>
<REPEAT ((OBJ 1))
<COND (<AND <NOT <FSET? .OBJ ,INVISIBLE>>
;<NOT <IN? .OBJ ,ROOMS>>>
<COND (<NOT <MATCH-OBJECT .OBJ ,FINDER T>>
<RETURN>)>)>
<COND (<G? <SET OBJ <+ .OBJ 1>> ,LAST-OBJECT>
<RETURN>)>>)>>)>
;<COND (<AND <L? 1 <FIND-RES-COUNT .RES>:FIX>
<FIND-OF ,FINDER>>
<MATCH-OF-OBJECTS .RES>)>
<1? <FIND-RES-COUNT .RES>:FIX>>
<END-SEGMENT>
<END-DEFINITIONS>