Commit 2f2f9dc0 authored by jmcgrew@d9ba3f8c-9c8e-47e3-a892-eed549321d50's avatar jmcgrew@d9ba3f8c-9c8e-47e3-a892-eed549321d50
Browse files

Added Library, Examples, and Testing.

Updated ignore lists.
parent 66eae912393e
"Cloak of Darkness main file"
<VERSION ZIP>
<CONSTANT RELEASEID 1>
"Main loop"
<CONSTANT GAME-BANNER
"Cloak of Darkness|
A basic IF demonstration.|
Original game by Roger Firth|
ZIL conversion by Jesse McGrew, Jayson Smith, and Josh Lawrence">
<ROUTINE GO ()
<CRLF> <CRLF>
<TELL "Hurrying through the rainswept November night, you're glad to see the
bright lights of the Opera House. It's surprising that there aren't more
people about but, hey, what do you expect in a cheap demo game...?" CR CR>
<V-VERSION> <CRLF>
<SETG HERE ,FOYER>
<MOVE ,PLAYER ,HERE>
<V-LOOK>
<REPEAT ()
<COND (<PARSER>
<PERFORM ,PRSA ,PRSO ,PRSI>
<APPLY <GETP ,HERE ,P?ACTION> ,M-END>
<OR <META-VERB?> <CLOCKER>>)>
<SETG HERE <LOC ,WINNER>>>>
<INSERT-FILE "parser">
"Objects"
<OBJECT CLOAK
(DESC "cloak")
(SYNONYM CLOAK)
(IN PLAYER)
(FLAGS TAKEBIT WEARBIT WORNBIT)
(ACTION CLOAK-R)>
<ROUTINE CLOAK-R ()
<COND (<VERB? EXAMINE> <TELL "The cloak is unnaturally dark." CR>)>>
<ROOM FOYER
(DESC "Foyer of the Opera House")
(IN ROOMS)
(LDESC "You are standing in a spacious hall, splendidly decorated in red
and gold, with glittering chandeliers overhead. The entrance from
the street is to the north, and there are doorways south and west.")
(SOUTH TO BAR)
(WEST TO CLOAKROOM)
(NORTH SORRY "You've only just arrived, and besides, the weather outside
seems to be getting worse.")
(FLAGS LIGHTBIT)>
<ROOM BAR
(DESC "Foyer Bar")
(IN ROOMS)
(LDESC "The bar, much rougher than you'd have guessed after the opulence
of the foyer to the north, is completely empty.")
(NORTH TO FOYER)
(ACTION BAR-R)>
<GLOBAL DISTURBED 0>
<ROUTINE BAR-R (RARG)
<COND
(<==? .RARG ,M-ENTER>
<COND (<FSET? ,CLOAK ,WORNBIT> <FCLEAR ,BAR ,LIGHTBIT>)
(ELSE <FSET ,BAR ,LIGHTBIT>)>)
(<==? .RARG ,M-BEG>
<COND (<AND <NOT <FSET? ,BAR ,LIGHTBIT>>
<NOT <META-VERB?>>
<NOT <VERB? LOOK>>
<NOT <AND <VERB? WALK> <==? ,PRSO ,P?NORTH>>>>
<TELL "You grope around clumsily in the dark. Better be careful." CR>
<SETG DISTURBED <+ ,DISTURBED 1>>)>)>>
<OBJECT MESSAGE
(DESC "message")
(SYNONYM MESSAGE FLOOR SAWDUST DUST)
(ADJECTIVE SCRAWLED)
(IN BAR)
(FDESC "There seems to be some sort of message scrawled in the sawdust on the floor.")
(ACTION MESSAGE-R)>
<ROUTINE MESSAGE-R ()
<COND (<VERB? EXAMINE>
<TELL "The message simply reads: \"You ">
<COND (<G? ,DISTURBED 1> <TELL "lose.">)
(ELSE <TELL "win.">)>
<TELL "\"" CR>)>
<V-QUIT>>
<ROOM CLOAKROOM
(DESC "Cloakroom")
(IN ROOMS)
(LDESC "The walls of this small room were clearly once lined with hooks,
though now only one remains. The exit is a door to the east.")
(EAST TO FOYER)
(FLAGS LIGHTBIT)>
<OBJECT HOOK
(DESC "small brass hook")
(IN CLOAKROOM)
(SYNONYM HOOK PEG)
(ADJECTIVE SMALL BRASS)
(FDESC "A small brass hook is on the wall.")
(FLAGS CONTBIT SURFACEBIT)>
"EMPTY GAME main file"
<VERSION ZIP>
<CONSTANT RELEASEID 1>
"Main loop"
<CONSTANT GAME-BANNER
"EMPTY GAME|
An interactive fiction by AUTHOR NAME">
<ROUTINE GO ()
<CRLF> <CRLF>
<TELL "INTRODUCTORY TEXT!" CR CR>
<V-VERSION> <CRLF>
<SETG HERE ,STARTROOM>
<MOVE ,PLAYER ,HERE>
<V-LOOK>
<REPEAT ()
<COND (<PARSER>
<PERFORM ,PRSA ,PRSO ,PRSI>
<APPLY <GETP ,HERE ,P?ACTION> ,M-END>
<OR <META-VERB?> <CLOCKER>>)>
<SETG HERE <LOC ,WINNER>>>>
<INSERT-FILE "parser">
"Objects"
<OBJECT STARTROOM
(IN ROOMS)
(DESC "START ROOM")
(FLAGS LIGHTBIT)>
ZILF Library Copyright (C) 2010 Jesse McGrew and Josh Lawrence
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution. In the case of a
binary z-code file compiled by the ZILF compiler, the appearance of the
library version number within the text of the introductory title credits of
your game (text that is displayed to a person who plays your z-code file
via a z-code interpreter) is sufficient to satisfy the requirements for
redistribution of said binary z-code file. (By default, using <V-VERSION>
in your game's source code will display the library version number to a
person playing your game on a z-code interpreter.)
* The names of the authors may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
The main documentation for ZIL programming is Infocom's "Learning ZIL" manual,
which you can find at
http://www.xlisper.com/zil.pdf
This doc describes the differences between ZILF's library and the description of
ZIL found in "Learning ZIL", including, at the bottom, what is not implemented
yet in ZILF.
-- ZILF has an OPENABLE bit. If an object with CONTBIT also has OPENABLE, then it
can be opened and closed by the player. An object with CONTBIT and OPENBIT but no
OPENABLE flag will be considered always open. An object with just CONTBIT
assigned to it is considered a sealed-off container -- the author can make certain
game events add OPENBIT and/or OPENABLE to it to make it an accessible container.
-- If an object has a TEXT property, that TEXT will show, along with any LDESC,
when the object is EXAMINED. If the object is READ, only the TEXT will be shown.
-- New TEXT-HELD property. If an object has a TEXT-HELD property, the string
associated with it will only be shown if the player is holding the object and
performs a READ on the object (for books, etc).
-- New DEVICEBIT to indicate a device can be turned on and off. ZIL used
LIGHTBIT for this. In ZILF, LIGHTBIT is used solely to indicate something
providing light.
-- "Learning ZIL" describes objects as having a default SIZE and CAPACITY of 5,
if the author does not specify them. If such default containers tested their
CAPACITY against a default object (being inserted)'s SIZE, then all default
containers could only hold 1 default object max (object of SIZE 5 filling the
container's CAPACITY of 5), which seems less than useful. Therefore, in ZILF,
if an container is not assigned a CAPACITY, it will accept an unlimited number
of objects of SIZE 5 or under. Thus an author who does not want to worry about
SIZE and CAPACITY can simply leave them off all objects, and any containers will
always accept any objects. Then for special cases, SIZE and CAPACITY can be
specified (for the very special case of a container that is infinite in capacity,
but only allows objects of a certain size or below, the author can either specify
a very large CAPACITY along with the desired SIZE limit, or custom handle PUT-IN
in the object's ACTION routine).
-- ZILF has the WEIGHT routine, as described in "Learning ZIL", but also a
CONTENTS-WEIGHT, which only adds up the SIZEs of the objects in the chosen container
- not adding the size of the container itself and also not recursing down through
any containers within the primary container.
-- PICK-ONE in early versions of ZIL randomly picked any element from a given table,
and was later replaced by aversion that would randomly cycle through all elements of
the given table before repeating any of them. ZILF offers both. PICK-ONE does the
cyclic 'shuffling' (no repeats til all elements have been displayed once). PICK-ONE-R
is the totally random version (repeats likely). Tables used with PICK-ONE must have
the numeral 2 as their first element. Both PICK-ONE and PICK-ONE-R tables must be LTABLES.
-- The ZIL Manual is a little inconsistent about how a multiple-turn WAIT can/can't be
interrupted. In ZILF, any routine that returns TRUE (whether an I-EVENT, the room's
M-END RARG, whatever) will interrupt a WAIT which is running though a sequence of passed
turns. However, if a routine ends with a RFALSE, WAIT will continue to cycle on to
additional passed turns after the routine. The default number of turns that pass with
WAIT is set by the global STANDARD-WAIT variable.
-- New WAIT-TURNS routine. Pass a number to it, it will pass that number of game turns
in the same fashion as a player-called WAIT.
-- New EDIBLEBIT (not in ZIL manual) for verb EAT
-- COPYT routine is called COPY-TABLE, but functions exactly the same
WHAT'S NOT IMPLEMENTED IN ZILF
---------------------------------
The following are not implemented yet as of v 0.3:
General
- Prompted disambiguation of similarly named objects
- TAKE ALL/DROP ALL
- Player commands with multiple direct objects
- Player commands ending with a preposition (eg TURN OFF LIGHT works -
TURN LIGHT OFF doesn't)
- All mouse and graphic routines
Properties
PLURAL (note this is different from PLURALBIT, which is implemented)
DESCFCN
CONTFCN
GENERIC
SDESC
OWNER
THINGS
ADJACENT
Bits
TRYTAKEBIT
DOORBIT
LOCKEDBIT
FLAMEBIT
BURNBIT
INVISIBLE
SEARCHBIT (ZILF does not use the abitrary level-of-containment limit when searching
through visible & accessible objects)
VEHBIT
RLANDBIT
RWATERBIT
RAIRBIT
KLUDGEBIT
OUTSIDEBIT
INTEGRALBIT
PARTBIT
NALLBIT
DROPBIT
INBIT
Routines
THIS-IS-IT
INIT-STATUS
UPDATE-STATUS
ITALICIZE
UNTOUCHABLE?
WITHIN?
OTHER-SIDE
TOUCHING?
CANT-SEE
SEE-INSIDE?
CAPITAL-NOUN?
FIND-IN
No OOPS
"Library header"
<CONSTANT ZILLIB-VERSION "J1">
"Debugging"
<SETG DEBUG <>>
<DEFMAC IF-DEBUG ("ARGS" A)
<FORM PROG '()
!<COND (,DEBUG .A) (ELSE '(<>))>>>
"In V3, we need these globals for the status line. In V5, we could
call them something else, but we'll continue the tradition anyway."
<GLOBAL HERE <>>
<GLOBAL SCORE 0>
<GLOBAL TURNS 0>
"next two for the Interrupt Queue"
<CONSTANT IQUEUE <ITABLE 20>>
<GLOBAL TEMPTABLE <ITABLE 50 <> >>
<GLOBAL IQ-LENGTH 0>
<GLOBAL STANDARD-WAIT 4>
<GLOBAL AGAINCALL 0>
<GLOBAL USAVE 0>
<GLOBAL ONCAGAIN 0>
<GLOBAL NLITSET <>>
<GLOBAL DBCONT <>>
<GLOBAL DTURNS <>>
<DEFMAC TELL ("ARGS" A "AUX" O P)
<SET O <MAPF ,LIST
<FUNCTION ("AUX" I)
<COND (<EMPTY? .A> <MAPSTOP>)>
<SET I <NTH .A 1>>
<SET A <REST .A>>
<COND
(<TYPE? .I STRING>
<COND
(<LENGTH? .I 0>
<MAPRET>)
(<LENGTH? .I 1>
<FORM PRINTC <NTH .I 1>>)
(ELSE
<FORM PRINTI .I>)>)
(<==? .I CR>
<FORM CRLF>)
(<TYPE? .I ATOM>
<SET P <1 .A>>
<SET A <REST .A>>
<COND
(<==? .I N> <FORM PRINTN .P>)
(<==? .I D> <FORM PRINTD .P>)
(<==? .I B> <FORM PRINTB .P>)>)
(ELSE
<FORM PRINT .I>)>>>>
<COND
(<LENGTH? .O 0> <>)
(<LENGTH? .O 1> <1 .O>)
(ELSE <FORM PROG '() !.O>)>>
"Version considerations: certain values are bytes on V3 but words on all
other versions. These macros let us write the same code for all versions."
<VERSION?
(ZIP
<DEFMAC GET/B ('T 'O) <FORM GETB .T .O>>
<DEFMAC IN-PB/WTBL? ('O 'P 'V) <FORM IN-PBTBL? .O .P .V>>)
(ELSE
<DEFMAC GET/B ('T 'O) <FORM GET .T .O>>
<DEFMAC IN-PB/WTBL? ('O 'P 'V) <FORM IN-PWTBL? .O .P .V>>)>
"Parser"
<CONSTANT READBUF-SIZE 100>
<CONSTANT READBUF <ITABLE NONE 100>>
<CONSTANT BACKREADBUF <ITABLE NONE 100>>
<CONSTANT LEXBUF <ITABLE 59 (LEXV) 0 #BYTE 0 #BYTE 0>>
<CONSTANT BACKLEXBUF <ITABLE 59 (LEXV) 0 #BYTE 0 #BYTE 0>>
<CONSTANT P1MASK 3>
<GLOBAL WINNER PLAYER>
<GLOBAL PRSA <>>
<GLOBAL PRSO <>>
<GLOBAL PRSI <>>
<GLOBAL PRSO-DIR <>>
<DEFMAC VERB? ("ARGS" A)
<SET O <MAPF ,LIST
<FUNCTION (I)
<FORM GVAL <PARSE <STRING "V?" <SPNAME .I>>>>>
.A>>
<FORM EQUAL? ',PRSA !.O>>
<DEFMAC WORD? ('W 'T)
<FORM CHKWORD? .W
<FORM GVAL <PARSE <STRING "PS?" <SPNAME .T>>>>
<FORM GVAL <PARSE <STRING "P1?" <SPNAME .T>>>>>>
<VERSION?
(ZIP
<CONSTANT VOCAB-FL 4> ;"part of speech flags"
<CONSTANT VOCAB-V1 5> ;"value for 1st part of speech"
<CONSTANT VOCAB-V2 6> ;"value for 2nd part of speech")
(T
<CONSTANT VOCAB-FL 6>
<CONSTANT VOCAB-V1 7>
<CONSTANT VOCAB-V2 8>)>
<ROUTINE CHKWORD? (W PS "OPT" (P1 -1) "AUX" F)
<COND (<0? .W> <RFALSE>)>
<IF-DEBUG <TELL "[CHKWORD: " B .W " PS=" N .PS " P1=" N .P1>>
<SET F <GETB .W ,VOCAB-FL>>
<IF-DEBUG <TELL " F=" N .F>>
<SET F <COND (<BTST .F .PS>
<COND (<L? .P1 0>
<RTRUE>)
(<==? <BAND .F ,P1MASK> .P1>
<GETB .W ,VOCAB-V1>)
(ELSE <GETB .W ,VOCAB-V2>)>)>>
<IF-DEBUG <TELL " = " N .F "]" CR>>
.F>
<ROUTINE GETWORD? (N "AUX" R)
<SET R <GET ,LEXBUF <- <* .N 2> 1>>>
<IF-DEBUG
<TELL "[GETWORD " N .N " = ">
<COND (.R <TELL B .R>) (ELSE <TELL "?">)>
<TELL "]" CR>>
.R>
<ROUTINE PRINT-WORD (N "AUX" I MAX)
<SET I <GETB ,LEXBUF <+ <* .N 4> 1>>>
<SET MAX <- <+ .I <GETB ,LEXBUF <* .N 4>>> 1>>
<REPEAT ()
<PRINTC <GETB ,READBUF .I>>
<AND <IGRTR? I .MAX> <RETURN>>>>
<GLOBAL P-LEN 0>
<GLOBAL P-V <>>
<GLOBAL P-NOBJ 0>
<GLOBAL P-P1 <>>
<GLOBAL P-P2 <>>
<CONSTANT P-MAXOBJS 10>
"These each have one length byte, one mode byte, then P-MAXOBJS pairs of words."
<CONSTANT P-DOBJS <ITABLE 21 <>>>
<CONSTANT P-DOBJEX <ITABLE 21 <>>>
<CONSTANT P-IOBJS <ITABLE 21 <>>>
<CONSTANT P-IOBJEX <ITABLE 21 <>>>
"for recalling last PRSO with IT"
<CONSTANT P-DOBJS-BACK <ITABLE 21 <>>>
<CONSTANT P-DOBJEX-BACK <ITABLE 21 <>>>
<GLOBAL IT-USE 0>
<GLOBAL IT-ONCE 0>
"for recalling last PRSO with THEM"
<CONSTANT P-TOBJS-BACK <ITABLE 21<>>>
<CONSTANT P-TOBJEX-BACK <ITABLE 21 <>>>
<GLOBAL THEM-USE 0>
<GLOBAL THEM-ONCE 0>
"for recalling last male PRSO with HIM"
<CONSTANT P-MOBJS-BACK <ITABLE 21 <>>>
<CONSTANT P-MOBJEX-BACK <ITABLE 21 <>>>
<GLOBAL HIM-USE 0>
<GLOBAL HIM-ONCE 0>
"for recalling last PRSO with HER"
<CONSTANT P-FOBJS-BACK <ITABLE 21 <>>>
<CONSTANT P-FOBJEX-BACK <ITABLE 21 <>>>
<GLOBAL HER-USE 0>
<GLOBAL HER-ONCE 0>
<BUZZ A AN AND ANY ALL BUT EXCEPT OF ONE THE \. \, \">
<ROUTINE PARSER ("AUX" NOBJ VAL DIR)
<SET NOBJ <>>
<SET VAL <>>
<SET DIR <>>
<SETG HERE <LOC ,PLAYER>>
<READLINE>
<IF-DEBUG <DUMPLINE>>
<SETG P-LEN <GETB ,LEXBUF 1>>
<SETG P-V <>>
<SETG P-NOBJ 0>
<PUT ,P-DOBJS 0 0>
<PUT ,P-IOBJS 0 0>
<SETG P-P1 <>>
<SETG P-P2 <>>
<SETG HERE <LOC ,WINNER>>
<REPEAT ((I 1) W)
;<TELL "W is currently " N .W CR>
;"setting of W separated out so verb recogniton could also be separated"
<COND
(<G? .I ,P-LEN>
<RETURN>)
(<NOT <SET W <GETWORD? .I>>>
<TELL "I don't know the word \"">
<PRINT-WORD .I>
<TELL "\"." CR>
<RFALSE>)>
;"verb recognition separated from rest so a verb and object can have the same name"
<COND
(<AND <CHKWORD? .W ,PS?VERB>
<NOT ,P-V>>
<SETG P-V <WORD? .W VERB>>)
(ELSE
<COND
(<AND <EQUAL? ,P-V <> ,ACT?WALK>
<SET VAL <WORD? .W DIRECTION>>>
<SET DIR .VAL>)
(<SET VAL <CHKWORD? .W ,PS?PREPOSITION 0>>
<COND (<AND <==? .NOBJ 0> <NOT ,P-P1>>
<SETG P-P1 .VAL>)
(<AND <==? .NOBJ 1> <NOT ,P-P2>>
<SETG P-P2 .VAL>)>)
(<STARTS-CLAUSE? .W>
<SET NOBJ <+ .NOBJ 1>>
<COND (<==? .NOBJ 1>
<SET VAL <MATCH-CLAUSE .I ,P-DOBJS ,P-DOBJEX>>)
(<==? .NOBJ 2>
<SET VAL <MATCH-CLAUSE .I ,P-IOBJS ,P-IOBJEX>>)
(ELSE
<TELL "That sentence has too many objects." CR>
<RFALSE>)>
<COND (.VAL
<SET I .VAL>
<AGAIN>)
(ELSE
<TELL "That noun clause didn't make sense." CR>
<RFALSE>)>)
(ELSE
<TELL "I didn't expect the word \"">
<PRINT-WORD .I>
<TELL "\" there." CR>
<RFALSE>)>
)>
<SET I <+ .I 1>>>
<SETG P-NOBJ .NOBJ>
<IF-DEBUG <TELL "[PARSER: V=" N ,P-V " NOBJ=" N ,P-NOBJ
" P1=" N ,P-P1 " DOBJS=" N <GETB ,P-DOBJS 0>
" P2=" N ,P-P2 " IOBJS=" N <GETB ,P-IOBJS 0> "]" CR>>
<COND
(.DIR
<SETG PRSO-DIR T>
<SETG PRSA ,V?WALK>
<SETG PRSO .DIR>
<SETG PRSI <>>
<VERSION?
(ZIP <>)
(EZIP <>)
(ELSE
;"save state for undo after moving from room to room"
<COND (<AND <NOT <VERB? UNDO >>
<NOT <EQUAL? ,AGAINCALL 1>>>
<SETG USAVE <ISAVE>>
;<TELL "ISAVE returned " N ,USAVE CR>
<COND (<EQUAL? ,USAVE 2>
<TELL "Previous turn undone." CR>
;<SETG USAVE 0> ;"prevent undoing twice in a row"
<AGAIN>)>)>
)>
<RTRUE>)
(<NOT ,P-V>
<TELL "That sentence has no verb." CR>
<RFALSE>)
(ELSE
<SETG PRSO-DIR <>>
<COND
(<AND
<MATCH-SYNTAX>
<FIND-OBJECTS>>
<VERSION?
(ZIP <>)
(EZIP <>)
(ELSE
;"save state for UNDO, unless we're about to UNDO the previous command"
<COND (<AND <NOT <VERB? UNDO >>
<NOT <EQUAL? ,AGAINCALL 1>>>
<SETG USAVE <ISAVE>>
; <TELL "ISAVE returned " N ,USAVE CR>
<COND (<EQUAL? ,USAVE 2>
<TELL "Previous turn undone." CR>
;<SETG USAVE 0> ;"prevent undoing twice in a row"
<AGAIN>
;<SETG NOUAGAIN 0>
)>)>
)>
;"if successful PRSO and not after an IT use, back up PRSO for IT"
<COND (<AND <EQUAL? ,IT-USE 0>
<AND ,PRSO>
<NOT <FSET? ,PRSO ,PERSONBIT>>
<NOT <FSET? ,PRSO ,PLURALBIT>>>
;<TELL "Copying P-DOBJS into P-DOBJS-BACK" CR>
<COPY-TABLE ,P-DOBJS ,P-DOBJS-BACK 21>
<COPY-TABLE ,P-DOBJEX ,P-DOBJEX-BACK 21>
<COND (<EQUAL? ,IT-ONCE 0> <SET ,IT-ONCE 1>)>)
;"if PRSO has PLURALBIT, back up to THEM instead"
(<AND <EQUAL? ,THEM-USE 0>
<AND ,PRSO>
<NOT <FSET? ,PRSO ,PERSONBIT>>
<FSET? ,PRSO ,PLURALBIT>>
;<TELL "Copying P-DOBJS into P-TOBJS-BACK" CR>
<COPY-TABLE ,P-DOBJS ,P-TOBJS-BACK 21>
<COPY-TABLE ,P-DOBJEX ,P-TOBJEX-BACK 21>
<COND (<EQUAL? ,THEM-ONCE 0> <SET ,THEM-ONCE 1>)>)
;"if successful PRSO who is male, back up PRSO for HIM"
(<AND <EQUAL? ,HIM-USE 0>
<AND ,PRSO>
<FSET? ,PRSO ,PERSONBIT>
<NOT <FSET? ,PRSO ,FEMALEBIT>>>
;<TELL "Copying P-DOBJS into P-MOBJS-BACK" CR>
<COPY-TABLE ,P-DOBJS ,P-MOBJS-BACK 21>
<COPY-TABLE ,P-DOBJEX ,P-MOBJEX-BACK 21>
<COND (<0? ,HIM-ONCE> <SET ,HIM-ONCE 1>)>)
;"if successful PRSO who is female, back up PRSO for HER"
(<AND <EQUAL? ,HER-USE 0>
<AND ,PRSO>
<FSET? ,PRSO ,PERSONBIT>
<FSET? ,PRSO ,FEMALEBIT>>
;<TELL "Copying P-DOBJS into P-FOBJS-BACK" CR>
<COPY-TABLE ,P-DOBJS ,P-FOBJS-BACK 21>
<COPY-TABLE ,P-DOBJEX ,P-FOBJEX-BACK 21>
<COND (<0? ,HER-ONCE> <SET ,HER-ONCE 1>)>
)>
<RTRUE>
)>
)>
>
<ROUTINE COPY-TABLE (T C S "AUX" N W)
<SET N 1>
<REPEAT ()
<SET W <GETB .T .N>>
<PUTB .C .N .W>
<SET N <+ .N 1>>
<COND (<G? .N .S> <RETURN>)>
>
>
<ROUTINE STARTS-CLAUSE? (W)
<OR <EQUAL? .W ,W?A ,W?AN ,W?THE>
<CHKWORD? .W ,PS?ADJECTIVE>
<WORD? .W OBJECT>>>