! This code was written by Andrew Plotkin (erkyrath@eblong.com).
! However, I place it in the public domain. You can use it any way
! you like.
! 
! For more information, updated versions, and details about my
! February 2003 Logic Puzzle Mini-Competition, see:
! <http://www.eblong.com/zarf/comp/logicpuz/index.html>

Constant Story "LOGIC PUZZLE SAMPLER";
Constant Headline "^An Interactive Proof of Concept^
    Written by Andrew Plotkin. This code is in the public domain.^
    (First-time players should type ~about~.)^";
Release 2;

Constant MANUAL_PRONOUNS;
Constant DIALECT_US;

#ifndef WORDSIZE;
Constant WORDSIZE 2
#endif; ! WORDSIZE

Replace OffersLight;
Replace LookUnderSub;

! Two more truth values (following false and true) which are used in the
! logic engine.
Constant indeterminate = 2;
Constant paradoxical   = 3;

Attribute nameable; ! Objects with this attribute can be written about.

Include "Parser";

Include "VerbLib";

[ Initialise;
    location = Anteroom;
    player.parse_name = PlayerParseName;

    lookmode = 2; ! verbose
    inventory_style = FULLINV_BIT + ENGLISH_BIT + RECURSE_BIT; ! wide

    ! We use "this paper" as the name of an object -- it's actually
    ! quite important to be able to refer to this. But the library's
    ! standard pronoun handler tends to override it. So we go in and
    ! rudely overwrite the 'this' entry with an impossible word.
    ! (It contains a comma, so it can't be typed.) Hopefully players
    ! don't rely on the standard library handling of 'this', and won't
    ! miss it.
    LanguageDescriptors-->5 = ',this';

    move shortpaper to player;
    move wand to player;
    StartDaemon(paperbox);
];

! The grammar accepts sentences like "write "I am blue"", even though
! the genie won't accept them. So it's nice to accept "I" as a synonym
! for "me" / "self". We do this by assigning a parse_name routine to
! the player object (which normally has none).
[ PlayerParseName wd num;
    wd = NextWord();
    while (wd == 'i//') {
        num++;
        wd = NextWord();
    }
    return num;
];

! Simple light function which says everything is lit.
[ OffersLight i;
    if (i == 0)
        rfalse;
    rtrue;
];

Object Anteroom "A Familiar Place"
  with
    description "Everything here is just like it always is, including
        that door to the north.",
    n_to [;
        if (AnteDoor hasnt open) {
            give AnteDoor open;
            print "You push the door open. It doesn't creak at all.^";
        }
        return AnteDoor;
    ],
    in_to [; << Go n_obj>>; ],
    cant_go "You've been that way before.";

Object wand "wand"
  with
    name 'magic' 'wand' 'black' 'rod',
    description "It's a magic wand... well, it would be if there were
        any magic in this game. Since there's not, it's just a three-foot
        black rod with nothing on the end.",
    before [;
        Wave: "Sorry.";
    ],
  has nameable;

Object AnteDoor "door"
  with
    name 'wood' 'wooden' 'brown' 'door',
    description [;
        print "The door is newly carpentered wood, tidily finished
            in rich brown";
        if (self has open)
            print ". The door is standing open";
        else
            print ". The door is closed";
        ".";
    ],
    found_in Anteroom Playroom,
    door_dir [;
        if (self in Anteroom) 
            return n_to;
        else 
            return s_to;
    ],
    door_to [;
        if (self in Anteroom)
            return Playroom;
        else
            return Anteroom;
    ],
    before [;
        Open:
            if (self has open)
                "The door is already ajar.";
        Close:
            if (self hasnt open)
                "It's already closed.";
    ],
  has scenery door ~open openable nameable;

Object Playroom "Playroom"
  with
    description [;
        print "This room is uncomfortably bare and stark";
        if (~~genie.asleep)
            print ". A huge genie lounges against the wall, watching you";
        ".";
    ],
    s_to [;
        if (AnteDoor hasnt open) {
            give AnteDoor open;
            print "You push the door open. It doesn't creak at all.^";
        }
        return AnteDoor;
    ],
    out_to [; << Go s_obj>>; ];

Object table "table" Playroom
  with
    name 'plain' 'white' 'plastic' 'table',
    description [ ix;
        print "The table is ugly and cheap-looking -- it's molded of heavy
            white plastic";
        ix = child(self);
        if (ix) {
            print ". On ", (the) self;
            WriteListFrom(ix,
                RECURSE_BIT + TERSE_BIT + ENGLISH_BIT 
                + ISARE_BIT + CONCEAL_BIT);
        }
        else {
            print ". The table is empty";
        }
        ".";
    ],
    describe [ ix;
        print "^A plain white table stands to one side";
        ix = child(self);
        if (ix) {
            print ". On it";
            WriteListFrom(ix,
                RECURSE_BIT + TERSE_BIT + ENGLISH_BIT 
                + ISARE_BIT + CONCEAL_BIT);
        }
        ".";
    ],
    before [;
        Search:
            <<Examine self>>;
        Take, Pull, Push, Turn:
            print "The table is too heavy to move";
            if (self hasnt general) 
                give self general;
            else
                print ". Or maybe it's screwed to the floor. Or something";
            ".";
        Enter:
            "No climbing on the furniture, please.";
        LookUnder:
            if (genie.asleep)
                "There is a blue genie under the table.";
    ],
  has static supporter ~general nameable;

! Classes for the (physical) geometric objects in the playroom.

Class SphereClass
  with
    name 'sphere' 'ball',
    description [;
        "It's ", (a) self, ".";
    ],
    before [;
        Receive: "You can't balance anything on ", (the) self, ".";
    ],
  has nameable;

Class PyramidClass
  with
    name 'pyramid',
    description [;
        "It's ", (a) self, ".";
    ],
    before [;
        Receive: "You can't balance anything on ", (the) self, ".";
    ],
  has nameable;

Class CubeClass
  with
    name 'cube' 'block',
    description [;
        print "It's ", (a) self, ".";
        if (child(self)) {
            print " ";
            self.show_contents();
        }
        new_line;
        rtrue;
    ],
    show_contents [ ix;
        ix = child(self);
        if (ix) {
            print "Resting on ", (the) self;
            WriteListFrom(ix,
                RECURSE_BIT + TERSE_BIT + ENGLISH_BIT 
                + ISARE_BIT + CONCEAL_BIT);
            print ".";
        }
        else {
            print "There is nothing on ", (the) self, ".";
        }
    ],
    before [;
        Search:
            if (child(self)) {
                self.show_contents();
                new_line;
                rtrue;
            }
            "You find nothing of interest.";
        Receive: 
            ! A cube can only support one object at a time.
            if (child(self))
                print_ret (The) self, " is already occupied by ",
                    (the) child(self), ".";
            ! A cube can't support anything while it's held.
            if (IndirectlyContains(player, self))
                "You can't balance anything on ", (the) self,
                    " while you're holding it.";
    ],
    after [ ix;
        Take:
            ! A cube can't support anything while it's held.
            ix = child(self);
            if (ix) {
                if (ix ofclass CubeClass && child(ix)) {
                    while (ix ~= nothing) {
                        move ix to location;
                        if (ix ofclass CubeClass)
                            ix = child(ix);
                        else
                            ix = nothing;
                    }
                    "Everything on ", (the) self, " tumbles to the floor
                        as you take it.";
                }
                else {
                    move ix to location;
                    print_ret (The) ix, " tumbles to the floor as you take ",
                        (the) self, ".";
                }
            }
    ],
  has supporter nameable;

! Some instances of geometric objects.

SphereClass bluesphere "blue sphere" Playroom
  with
    name 'blue';

SphereClass greensphere "green sphere" Playroom
  with
    name 'green';

CubeClass greencube "green cube" Playroom
  with
    name 'green';

CubeClass blackcube "black cube" table
  with
    name 'black';

PyramidClass redpyramid "red pyramid" greencube
  with
    name 'red';

PyramidClass greypyramid "grey pyramid" table
  with
    name 'grey' 'gray';

! The statement class. A statement is a simple sentence, of the form which
! can be parsed in this game: for example, "The red pyramid is on the green 
! cube" or "The genie is blue".
!
! It's convenient to store each statement as a separate Inform object,
! rather than trying to set a bunch of separate properties on each piece
! of paper.

Class StatementClass
  with
    obj1,  ! The first object in the statement
    pred,  ! A binary relation (member of PredicateClass)
    obj2,  ! The second object (or abstract property) in the statement
    description [;
        ! This prints the sentence out.
#ifdef TARGET_GLULX;
        glk($0086, 1); ! set_style(Emphasized)
#ifnot; ! TARGET_GLULX
        style bold;
#endif; ! TARGET_
        print "~";
        ! We want to print the shorter_name of paper objects in these
        ! sentences. This is because the short_name includes the color,
        ! which can change! We don't want the written sentence to appear
        ! to mutate.
        if (self.obj1 ofclass PaperClass) {
            print "The "; 
            self.obj1.shorter_name();
        }
        else {
            print (The) self.obj1;
        }
        print " ";
        print (string) self.pred.description;
        print " ";
        if (self.obj2 ofclass PaperClass) {
            print "the "; 
            self.obj2.shorter_name();
        }
        else {
            print (the) self.obj2;
        }
        print ".~";
#ifdef TARGET_GLULX;
        glk($0086, 0); ! set_style(Normal)
#ifnot; ! TARGET_GLULX
        style roman;
#endif; ! TARGET_
    ];

! A predicate represents an abstract relation -- the linking verb
! in the statement.

Class PredicateClass
  with
    eval [;
        "[BUG] Predicate ", (name) self, " lacks an eval function.";
    ];

PredicateClass PredIsOn,
  with
    description "is on",
    eval [ obj1 obj2;
        ! We allow indirect "on" here. But not equality!
        if (obj1 == obj2)
            rfalse;
        if (IndirectlyContains(obj2, obj1))
            rtrue;
        else
            rfalse;
    ];

PredicateClass PredIsTouching,
  with
    description "is touching",
    eval [ obj1 obj2;
        ! Is an object touching itself? I guess so.
        if (obj1 == obj2)
            rtrue;
        if ((obj1 in obj2) || (obj2 in obj1))
            rtrue;
        rfalse;
    ];

! This is a special case -- statements of the form "<object> is <property>",
! rather than (say) "<object> is touching <object>". If a statement has
! pred == PredIsProperty, then obj2 will be of class PropertyClass.
PredicateClass PredIsProperty,
  with
    description "is",
    eval [ obj prop;
        ! Pass the determination on to the Property object.
        return prop.eval(obj);
    ];

! A property (no relation to Inform object properties) represents a
! quality that an object may or may not have.

Class PropertyClass
  with
    eval [;
        "[BUG] Property ", (name) self, " lacks an eval function.";
    ],
  has proper;  ! the name is "blue", not "the blue".

PropertyClass PropOpen "open"
  with
    name 'open' 'opened',
    eval [ obj;
        ! Only the door can be open or closed in this game.
        if (obj == AnteDoor) 
            return (obj has open);
        rfalse;
    ];

PropertyClass PropClosed "closed"
  with
    name 'closed' 'shut',
    eval [ obj;
        ! Only the door can be open or closed in this game.
        if (obj == AnteDoor) 
            return (obj hasnt open);
        rfalse;
    ];

PropertyClass PropPaper "paper"
  with
    name 'paper',
    eval [ obj;
        if (obj ofclass PaperClass) 
            rtrue;
        rfalse;
    ];

! A *simple* property just checks the object's name list for an adjective,
! or set of adjectives.
Class SimplePropertyClass
  class PropertyClass,
  with
    adjec "[BUG]",
    short_name [;
        print (string) self.adjec;
        rtrue;
    ],
    eval [ obj  nameaddr namelen ix;
        nameaddr = self.&name;
        namelen = self.#name / WORDSIZE;
        for (ix=0 : ix<namelen : ix++) {
            if (WordInProperty(nameaddr-->ix, obj, name))
                rtrue;
        }
        rfalse;
    ];

SimplePropertyClass PropBlue
  with
    name 'blue',
    adjec "blue";

SimplePropertyClass PropOrange
  with
    name 'orange',
    adjec "orange";

SimplePropertyClass PropYellow
  with
    name 'yellow',
    adjec "yellow";

SimplePropertyClass PropPurple
  with
    name 'purple' 'violet',
    adjec "purple";

SimplePropertyClass PropBlack
  with
    name 'black',
    adjec "black";

! Red, green, grey, and brown need special handling. See the 
! LogicPropertyClass below.

SimplePropertyClass PropWood
  with
    name 'wood' 'wooden',
    adjec "wood";

SimplePropertyClass PropPlastic
  with
    name 'plastic',
    adjec "plastic";

! This exists only to let the genie give a meaningful error message.
! He won't write it down.
SimplePropertyClass PropTruth
  with
    name 'false' 'true',
    adjec "true or false";

SimplePropertyClass PropWhite
  with
    name 'white',
    adjec "white",
    eval [ obj;
        ! This is a bit tricky: paper can be white, but 'white' isn't
        ! in paper's name property. We have to check to see if it's
        ! blank.
        if (obj ofclass PaperClass) {
            return obj.blank;
        }
        ! anything else, use the usual rule.
        return self.SimplePropertyClass::eval(obj);
    ];

! This class is for the four dangerous properties: red, green, brown, grey.
! Paper objects have (or lack) these properties based on the truth of the
! statements written upon them. We have to search recursively -- or until
! we hit a static truth value.
Class LogicPropertyClass
  class SimplePropertyClass,
  with
    eval [ obj objval;
        if (obj ofclass PaperClass) {
            ! blank paper is never one of these four colors. (It's white.)
            if (obj.blank)
                rfalse;
            ! Work out the color of the paper we're talking about.
            if (obj.inloop) {
                ! static value, computed in RecomputeLoops
                objval = obj.loopvalue;
            }
            else {
                ! bring out the logic probe!
                objval = EvaluateStatement(obj.statement);
            }
            if (obj.inloop || obj.preloop) {
                ! we're preloop, and special circumstances apply:
                ! if we're testing whether the paper is brown (indeterminate), 
                ! we just say yes. The logician thinks he can't determine 
                ! anything.
                if (self.loopvalue == indeterminate)
                    rtrue;
                ! if we're testing for grey (paradoxical), we just say no.
                ! The logician only recognizes very specific paradoxes.
                if (self.loopvalue == paradoxical)
                    rfalse;
                ! so we're testing for truth or falsity. If we're looking
                ! at a grey or brown paper, we ourselves are logically
                ! equivalent to that paper, so return the same value.
                if (objval == indeterminate || objval == paradoxical)
                    return objval;
                ! otherwise, we can't prove it true or false, so return
                ! false regardless of what we're testing.
                rfalse;
            }
            ! we're in a chain that leads to an ordinary physical fact.
            if (objval == self.loopvalue)
                rtrue;
            else
                rfalse;
        }
        ! anything not paper, use the usual adjective-checking rule.
        return self.SimplePropertyClass::eval(obj);
    ];

LogicPropertyClass PropGreen
  with
    name 'green',
    adjec "green",
    loopvalue true;

LogicPropertyClass PropRed
  with
    name 'red',
    adjec "red",
    loopvalue false;

LogicPropertyClass PropGrey
  with
    name 'grey' 'gray',
    adjec "grey",
    loopvalue paradoxical;

LogicPropertyClass PropBrown
  with
    name 'brown',
    adjec "brown",
    loopvalue indeterminate;

! Returns false, true, indeterminate, or paradoxical.
[ EvaluateStatement stat  res;

    ! check the values, just in case.
    if (stat == nothing || ~~(stat ofclass StatementClass))
        "[BUG] Statement is not a statement.";
    if (stat.obj1 == nothing || stat.obj2 == nothing)
        "[BUG] Statement has missing objects.";
    if (stat.pred == nothing || ~~(stat.pred ofclass PredicateClass))
        "[BUG] Statement does not have a proper predicate.";

    res = stat.pred.eval(stat.obj1, stat.obj2);

    return res;
];

! The all-important "piece of paper" class.
! Each paper has a statement object attached. This stores the statement
! which is written on the paper (if any). 

Class PaperClass
  with
    name 'piece' 'of' 'paper',
    adjec "[BUG]",    ! a descriptive string (double-quoted)
    blank true, ! is the paper blank? (If true, ignore statement.)
    statement,  ! the StatementClass object which is written here
    inloop,     ! flag used by RecomputeLoops
    preloop,    ! flag used by RecomputeLoops
    loopvalue,  ! static truth value (if inloop is true)
    color    'white', ! the color dictword (single-quoted) of the paper
    color2   'blank', ! a secondary color dictword
    colorstr "white", ! the color string (double-quoted)
    shorter_name [;
        ! sometimes we just want to print "short paper", instead of
        ! "short piece of white paper".
        print (string) self.adjec, " paper";
        rtrue;
    ],
    short_name [;
        print (string) self.adjec, " piece of ", (string) self.colorstr,
            " paper";
        rtrue;
    ],
    parse_name [ wd num;
        ! We accept either of the color dictwords, in addition to
        ! the list in self.name.
        wd = NextWord();
        while (WordInProperty(wd, self, name)
                || (wd == self.color)
                || (wd == self.color2)) {
            num++;
            wd = NextWord();
        }
        return num;
    ],
    description [;
        print "The ";
        self.shorter_name();
        if (self.blank)
            " is blank and white.";
        print " (which is ", (string) self.colorstr, ") reads, ";
        self.statement.description();
        new_line;
        rtrue;
    ],
  has nameable;

! Blank the paper out. You should print a message indicating that the
! paper has turned white.
[ ErasePaper obj;
    obj.blank = true;
    obj.color = 'white';
    obj.color2 = 'blank';
    obj.colorstr = "white";
];

! Fill the paper in. You must call RecomputeLoops after this.
! This does not update the object's color. You can either call
! UpdatePaper, or wait for the update daemon to figure things out.
! The update daemon will print its own message about the paper's color.
! If you call UpdatePaper, you must pay attention to the return value, 
! and print a message if it is true.
[ FillInPaper obj obj1a preda obj2a;
    obj.blank = false;
    obj.statement.obj1 = obj1a;
    obj.statement.pred = preda;
    obj.statement.obj2 = obj2a;
];

! This re-checks the truth value of the paper's statement, and changes
! the paper's color to match. It returns true if the color actually
! changes.
[ UpdatePaper obj  origcolor val;
    origcolor = obj.color; ! save the dictword (so we can compare later)

    if (obj.blank) {
        ErasePaper(obj);
    }
    else {
        if (obj.inloop) {
            ! static value, computed in RecomputeLoops
            val = obj.loopvalue;
        }
        else {
            ! bring out the logic probe!
            val = EvaluateStatement(obj.statement);
        }
        switch (val) {
            false: 
                obj.color = 'red';
                obj.color2 = 'red';
                obj.colorstr = "red";
            true: 
                obj.color = 'green';
                obj.color2 = 'green';
                obj.colorstr = "green";
            indeterminate: 
                obj.color = 'brown';
                obj.color2 = 'brown';
                obj.colorstr = "brown";
            paradoxical: 
                obj.color = 'grey';
                obj.color2 = 'gray';
                obj.colorstr = "grey";
        }
    }

    if (origcolor ~= obj.color)
        rtrue;
    rfalse;
];

! RecomputeLoops()
!
! This checks the set of paper objects for logical loops -- that is, 
! sequences in which each object says "the next one is (red, green, 
! grey, brown)". An object which refers to itself in this way counts
! as a length-one loop.
! 
! Note that "...is white" is not considered a logical
! loop connective, because the property of being white cannot change
! as a result of other logical state changes. Also note that a chain
! of connectives is not considered a loop unless it returns to its 
! starting point. You can have a chain leading into a loop (like a
! figure "9"), but only the elements in the loop itself get the inloop
! property set. The chain leading in gets the preloop property, instead.
!
! There can be more than one loop at a time. (In fact, if all five papers
! refer to themselves, there are five loops of length one). This makes
! loop-finding tedious, but it's still straightforward: Start at every
! object, trace forward along logical connectives, and see if you intercept
! your trail. If you do, mark the loop, starting at the interception
! point and working forward to itself.
! 
! This routine must be called after any paper is erased or rewritten.
! This is because loops cannot be analyzed by the usual recursive
! logic analyzer (EvaluateState). It would -- obviously -- loop forever.
! Conveniently, the logic values in a loop do not depend on any
! contingent facts about the universe. ("This sentence is false" is
! paradoxical regardless of where the red pyramid or the blue sphere 
! are.) So we can just assign all the logic values statically, when
! the paper is written, and let EvaluateState pick up these static
! values.

Constant MAXLOOPSIZE 5;
Array loophistory --> MAXLOOPSIZE;
Array truthcount --> 4; ! false, true, indeterminate, paradoxical
[ RecomputeLoops  obj ix jx kx ox ox2 isloop;
    ! First, clear all the inloop flags and static truth values.
    ix = 0;
    objectloop (obj ofclass PaperClass) {
        obj.inloop = false;
        obj.preloop = false;
        obj.loopvalue = NULL; ! (NULL is -1)
        ix++;
        if (ix > MAXLOOPSIZE)
            "[BUG] There are more paper objects than MAXLOOPSIZE (",
                MAXLOOPSIZE, "). Please increase MAXLOOPSIZE.";
    }

    ! Detect loops
    objectloop (obj ofclass PaperClass) {
        if (obj.inloop || obj.preloop) {
            ! it's already been detected and the whole loop marked.
            continue; 
        }
        isloop = false;
        ix = 0;
        ox = obj;
        while (1) {
            for (jx=0 : jx<ix : jx++) {
                if (loophistory-->jx == ox) {
                    isloop = true;
                    break;
                }
            }

            if (isloop) {
                for (kx=0 : kx<jx : kx++) {
                    ox2 = loophistory-->kx;
                    ox2.preloop = true;
                }
                for ( : kx<ix : kx++) {
                    ox2 = loophistory-->kx;
                    ox2.inloop = true;
                }
                break;
            }

            if ((~~ox.blank)
                && ox.statement.pred == PredIsProperty
                && ox.statement.obj1 ofclass PaperClass
                && ox.statement.obj2 ofclass LogicPropertyClass)
                ox2 = ox.statement.obj1;
            else
                break;

            if (ix >= MAXLOOPSIZE)
                "[BUG] MAXLOOPSIZE array overflow.";
            loophistory-->ix = ox;
            ix++;
            ox = ox2;
        }
    }

    ! print "^###^";

    ! For each loop, figure out the static truth values. (Don't worry about
    ! preloop objects at this time.)
    objectloop (obj ofclass PaperClass && obj.inloop) {
        if (obj.loopvalue ~= NULL) {
            ! it's already been computed and the whole loop marked.
            continue; 
        }
        ! We need to count the number of each claim in the loop.
        truthcount-->false = 0;
        truthcount-->true = 0;
        truthcount-->paradoxical = 0;
        truthcount-->indeterminate = 0;
        ox = obj;
        while (1) {
            ix = ox.statement.obj2.loopvalue;
            if (ix < 0 || ix > 3) 
                "[BUG] Strange loopvalue in LogicProperty.";
            truthcount-->ix = truthcount-->ix + 1;
            ox = ox.statement.obj1;
            if (ox == obj)
                break;
        }

        ! print "### ", truthcount-->true, " true; ", truthcount-->false, " false; ", truthcount-->paradoxical, " paradox; ", truthcount-->indeterminate, " indeterminate.^";
        if (truthcount-->paradoxical == 0 && truthcount-->indeterminate == 0) {
            ! This loop shall be judged by the number of "false" claims in
            ! it. An even number gives indeterminacy; an odd number is a
            ! paradox.
            if ((truthcount-->false % 2) == 0)
                ix = indeterminate;
            else
                ix = paradoxical;
            ox = obj;
            while (1) {
                ox.loopvalue = ix;
                ox = ox.statement.obj1;
                if (ox == obj)
                    break;
            }
        }
        else {
            ! In this loop, everything is false, except for "brown" claims,
            ! which are true.
            ox = obj;
            while (1) {
                ix = ox.statement.obj2.loopvalue;
                if (ix == indeterminate)
                    ox.loopvalue = true;
                else
                    ox.loopvalue = false;
                ox = ox.statement.obj1;
                if (ox == obj)
                    break;
            }
        }
    }

    !objectloop (obj ofclass PaperClass) {
    !    if (obj.inloop)
    !        print "### ", (name) obj, ": inloop, ", obj.loopvalue, "^";
    !    if (obj.preloop)
    !        print "### ", (name) obj, ": preloop^";
    !    if (obj.preloop && obj.inloop)
    !        print "### ### both alert!^";
    !}
];

! All paper objects start in the paperbox, which is just a cheap way
! to track them as they're brought into the game, one at a time. 
! I could get fancy and use dynamic object creation -- but I'm not
! bothering. I could get even fancier and use dynamic object creation 
! to autoattach a statement to each paper object. I'm not bothering
! with that either.
!
! For lack of a better idea, the color-update daemon is attached to the
! paperbox.
Object paperbox
  with
    daemon [ obj ix count;
        count = 0;
        objectloop (obj ofclass PaperClass) {
            ix = UpdatePaper(obj);
            if (ix && TestScope(obj)) {
                loophistory-->count = obj;
                count++;
            }
        }
        for (ix=0 : ix<count : ix++) {
            obj = loophistory-->ix;
            if (ix == 0)
                print "^The ";
            else if (ix == count-1)
                print ", and the ";
            else
                print ", the ";
            obj.shorter_name();
            print " turns ", (string) obj.colorstr;
        }
        if (ix > 0)
            print ".^";
    ];

PaperClass shortpaper "short paper" paperbox
  with
    name 'short',
    adjec "short",
    statement paperstatement1;

PaperClass longpaper "long paper" paperbox
  with
    name 'long',
    adjec "long",
    statement paperstatement2;

PaperClass widepaper "wide paper" paperbox
  with
    name 'wide',
    adjec "wide",
    statement paperstatement3;

PaperClass wrinkledpaper "wrinkled paper" paperbox
  with
    name 'wrinkled',
    adjec "wrinkled",
    statement paperstatement4;

PaperClass tornpaper "torn paper" paperbox
  with
    name 'torn',
    adjec "torn",
    statement paperstatement5;

StatementClass paperstatement1;
StatementClass paperstatement2;
StatementClass paperstatement3;
StatementClass paperstatement4;
StatementClass paperstatement5;

! This is a placeholder. It allows the player to refer to "this paper"
! in the "write" grammar. It gets transformed into whatever piece of
! paper is actually being written on.
Object thispaper "this paper"
  with
    name 'this' 'piece' 'of' 'paper' 'sentence' 'statement',
  has nameable proper;

! The genie.

Object genie "genie" Playroom
  with
    name 'huge' 'blue' 'genie',
    asleep true,
    bluecounter 0,
    describe [;
        if (self.asleep)
            "^Lying under the table, hands folded across his gut,
                vastly self-possessed and utterly
                unconscious, snores a genie.";
        ! If the genie is awake, he's described in the room description.
        ! So don't print anything.
        rtrue;
    ],
    description [ ix;
        print "Indeed, it's a genie, just like the genies you see every
            day. He's eight feet tall, bright shimmering blue, and his
            nose looks just slightly too big for his face";
        if (self.asleep) {
            print ". He's also snoring like a herd of tornadoes,
                despite the fact that he's lying on the floor under
                the table";
        }
        print ".^";
        self.bluecounter++;
        if (self.bluecounter == 3) 
            print "^(Yes, blue. The lawsuit is pending.)^";
        ix = child(self);
        if (ix) {
            print "^The genie is holding ";
            WriteListFrom(ix,
                TERSE_BIT + ENGLISH_BIT + CONCEAL_BIT);
            print ".^";
        }
        rtrue;
    ],
    before [ obj ix;
        WakeOther:
            if (~~self.asleep)
                "~I am. I am.~";
            self.asleep = false;
            move pen to self;
            print "The genie drags one eye open. 
                ~Oh. You.~ He rolls out from
                under the table and shakes himself to his feet.^^
                ~Well, I presume you're here to play with the toys.
                I'm afraid they don't do much yet. That,~ he pauses
                and eyes you significantly, ~is your job.~^^
                The genie";
            if (shortpaper in player) {
                obj = shortpaper;
                print " snatches the paper from your hands. He then";
            }
            else {
                obj = longpaper;
                move obj to player;
                print " stares at you in some confusion. Then he shrugs and";
            }
            print " feels around in his -- well, there must be
                a pocket involved somehow -- and pulls out a pen";
            if (obj ~= shortpaper)
                print " and ", (a) obj;
            print ". ~Here's a sample. Feel free to 
                ask me for more.~^^
                The genie frowns fiercely, scowls, and (with all due 
                concentration) writes upon the paper: ";
            FillInPaper(obj, redpyramid, PredIsOn, greencube);
            RecomputeLoops(); ! we must do this whenever a paper changes
            obj.statement.description();
            ix = UpdatePaper(obj);
            if (ix)
                print " The paper turns ", (string) obj.colorstr, 
                    " as he hands it to you";
            else
                print " He hands the paper to you";
            ".";
        Push, Attack, Touch:
            if (self.asleep)
                <<WakeOther self>>;
    ],
    orders [;
        Give:
            if (self.asleep)
                "The genie is asleep.";
            if (noun in self)
                <<Take noun>>;
        Wake:
            <<WakeOther self>>;
        WriteIsOn:
            if (self.asleep)
                "The genie is asleep.";
            RequestWriting(noun, PredIsOn, second);
            rtrue;
        WriteIsTouching:
            if (self.asleep)
                "The genie is asleep.";
            RequestWriting(noun, PredIsTouching, second);
            rtrue;
        WriteIsProp:
            if (self.asleep)
                "The genie is asleep.";
            RequestWriting(noun, PredIsProperty, second);
            rtrue;
        Erase:
            if (~~(noun ofclass PaperClass))
                "~You rave.~";
            if (noun.blank)
                "~It's blank already.~";
            RequestErasure(noun);
            rtrue;
    ],
    life [;
        Give:
            if (self.asleep)
                "The genie is asleep.";
            if (noun ofclass PaperClass) {
                move noun to genie;
                "The genie accepts ", (the) noun, ".";
            }
            "~Paper recycling only.~";
    ],
    react_before [;
        ! The player can take paper directly from the genie.
        Take, Remove:
            if (noun in genie && noun ofclass PaperClass) {
                move noun to player;
                "The genie blandly hands over ", (the) noun, ".";
            }
            if (noun in genie && noun == pen) {
                "The genie won't let go of the pen.";
            }
    ],
  has animate static nameable transparent;

Object pen "pen"
  with
    name 'pen',
    description "It's a pen.";

! This is called when the player requests that the genie erase a piece
! of paper. 
! (We have already checked to make sure the genie is present and awake.)
[ RequestErasure paper;
    if (paper in player) {
        print "The genie takes ", (the) noun, " from you and smudges the
            writing away with his thumb";
        move paper to genie;
    }
    else if (paper in genie) {
        print "With his thumb, the genie smudges the writing from the ";
        paper.shorter_name();
    }
    else {
        "~Certainly -- where is it?~";  ! and return
    }

    ErasePaper(paper);
    RecomputeLoops(); ! we must do this whenever a paper changes
    ". The paper turns white.";
];

! This is called when the player makes a writing request of the genie.
! (We have already checked to make sure the genie is present and awake.)
[ RequestWriting obj1a preda obj2a  paper ix;

    ! First, find a piece of paper.
    paper = nothing;
    objectloop (ix in genie) {
        ! look for blank paper the genie is holding
        if (ix ofclass PaperClass && ix.blank) {
            paper = ix;
            print "The genie pulls out ", (the) paper;
            break;
        }
    }
    if (paper == nothing) {
        ! look for paper in the paperbox
        ix = child(paperbox);
        if (ix) {
            paper = ix;
            move paper to genie;
            print "The genie pulls out ", (a) paper;
        }
    }
    if (paper == nothing) {
        ! okay, look for nonblank paper the genie can erase.
        objectloop (ix in genie) {
            if (ix ofclass PaperClass) {
                paper = ix;
                print (The) paper; ! print its name before it's blanked!
                ErasePaper(paper);
                RecomputeLoops(); ! we must do this whenever a paper changes
                print " turns white as the genie scrubs the
                    words from it";
                break;
            }
        }
    }
    if (paper == nothing) {
        "The genie fumbles around for a moment, then shrugs. ~I don't
            have any more paper. You'll have to give me some back.~";
    }

    ! We have paper. Now check the suitability of the three arguments.

    ! Turn the "this" placeholder into the current paper object.
    if (obj1a == thispaper)
        obj1a = paper;
    if (obj2a == thispaper)
        obj2a = paper;

    if (obj1a == player || obj2a == player) {
        ". Then he pauses. ~In genie custom, it is held
            impolite to write someone's name until you've known them
            for fifty or sixty years. ...Besides, I don't know how to
            spell yours.~";
    }

    if (obj1a hasnt nameable) {
        ". Then he hesitates. With some embarrassment, he
            says, ~I'm afraid I don't know how to spell '",
            (name) obj1a, "'. Could you ask for something else?~";
    }
    
    if (preda == PredIsProperty) {
        if (~~(obj2a ofclass PropertyClass)) {
            ! I don't think this error can actually happen, but
            ! best check anyhow.
            ". Then the genie frowns. ~'", (name) obj2a, "' isn't
                a property. Try '", (the) obj1a, " is blue' or
                'closed' or something.~";
        }
        if (obj2a == PropTruth) {
            ". Then he sighs. ~Truth and falsity are too
                complicated for me, okay? Stick with simple properties,
                like 'open', or 'wooden', or 'green'.~";
        }
    }
    else {
        if (obj2a hasnt nameable) {
            ". Then he hesitates. With some embarrassment, he
                says, ~I'm afraid I don't know how to spell '",
                (name) obj2a, "'. How about something else?~";
        }
    }

    print ". With complex mutters and scowls, the genie inscribes: ";
    FillInPaper(paper, obj1a, preda, obj2a);
    RecomputeLoops(); ! we must do this whenever a paper changes
    paper.statement.description();
    move paper to player;
    ix = UpdatePaper(paper);
    if (ix) {
        print " The ";
        paper.shorter_name();
        print " turns ", (string) paper.colorstr, 
            " as he hands it to you";
    }
    else {
        print " He hands the ";
        paper.shorter_name();
        print " to you";
    }
    ".";
];

! We want to be able to parse "write" commands with or without quotation
! marks. The stupidly easy way to do this is to go through the buffer
! and turn all quotation marks to spaces, before parsing begins.
[ BeforeParsing len buf cx;

#ifdef TARGET_GLULX;
    len = buffer-->0;
    buf = buffer+WORDSIZE;
#ifnot; ! TARGET_GLULX
    len = buffer->1;
    buf = buffer+2;
#endif; ! TARGET_

    for (cx=0 : cx<len : cx++) {
        if (buf->cx == '"')
            buf->cx = ' ';
    }

    Tokenise__(buffer,parse);
];

Include "Grammar";

[ AboutSub;
    print "Welcome to ", (string) Story, ". And let me start by saying:
        this is not a game. It is a toy. There is no
        goal beyond playing with the things in the Playroom.^";
    print "^You may enjoy figuring out the toys for yourself. If so,
        just go on inside and do what comes naturally. The only
        unusual commands you'll need are WRITE and ERASE:^^";
    font off;
    print "  > WRITE ~THE BLUE SPHERE IS ON THE TABLE~^";
    print "  > WRITE ~THE GREY PYRAMID IS TOUCHING THE TABLE~^";
    print "  > WRITE ~THE TABLE IS WHITE~^";
    print "  > WRITE ~THE DOOR IS OPEN~^";
    print "  > ERASE THE PAPER^";
    font on;
    print "^(The quotation marks are optional.)^^
        For a complete description of what's going on, type ~more about~.^";
    print "^This toy is provided as Inform sample code for building
        logic puzzles. (Which is why, yes, debug mode is on.) 
        It was created for my IF Logic Puzzle Mini-Competition in 2003,
        but you can use it for anything you want. The Inform source code
        is in the public domain (i.e., not copyrighted). 
        For source code, current versions, and information about the
        mini-comp:^^"; !### mention IF Archive
    font off;
    print "  <http://www.eblong.com/zarf/comp/logicpuz/index.html>^";
    font on;
    print "^If you have any questions, feel free to contact me:^";
    print "  Andrew Plotkin (erkyrath@@64eblong.com)^";
];

[ AboutMoreSub;
    print (string) Story, " implements a simple block world -- inspired by
        Terry Winograd's Eta Oin / SHRDLU dialogue (which you probably 
        recognize from a Hofstadter book). The world uses Inform's standard
        actions to allow you to stack blocks, move them around, and so
        forth.^";
    print "^To bring self-referentiality into this world, you can write
        simple sentences on pieces of paper. (Actually, the genie does
        all the writing. This makes the parsing a bit easier, since
        I don't have to deal with ~...on the short piece of paper~ in
        the ~write~ command. This is lazy of me. On the other hand, you
        didn't want to type that part either.)^";
    print "^The writing grammar is very simple, but I make full use of
        Inform's parsing library, so the code is pretty simple and it's
        very easy to extend. There are three basic sentence patterns
        in the current code:^^";
    font off;
    print "  ~The OBJECT is on the OBJECT~^";
    print "  ~The OBJECT is touching the OBJECT~^";
    print "  ~The OBJECT is PROPERTY~^";
    print "    (PROPERTY: red, green, blue, orange, yellow, purple, 
        white, grey, black, brown, paper, plastic, open, closed)^";
    font on;
    print "^Each piece of paper is blank when it's white. Once it
        bears a statement, the paper turns a color which depends on the
        truth value of the statement. If the statement is true, the paper
        turns green; if false, red. If the statement is paradoxical
        (~This sentence is false~), the paper turns grey -- neither red
        nor green. And if the value of the statement could be either true
        or false, the paper turns brown.^";
    print "^The pieces of paper also keep themselves up to date. If
        a fact of the world changes, the paper changes color to match.^";
    print "^Actually, you can't write ~This sentence is false~, because
        ~false~ is not in the property list. (The game recognizes it, but
        only in order to produce an informative error message.) 
        What you CAN write is ~This paper is red.~ (It comes out as
        ~The short piece of paper is red,~ assuming you're writing on
        the short piece of paper, but that's just to reduce confusion.)^";
    print "^Why not talk directly about truth and falsity?
        Well, logic is hard! Goedel's Theorem says that no algorithmic
        system can correctly distinguish all true statements from false
        ones. We're using a very limited class of statements -- too simple
        for Goedel's Theorem to apply, actually. But it's still nice to
        distinguish ~real~ truth and falsity from the somewhat limited
        logic engine behind our color-changing pieces of paper.^";
    print "^(Besides, I like the way that self-referentiality sneaks
        in with apparently simple statements like ~Such-and-such is red.~
        Did you realize that this toy supports paradoxes on your own?
        The initial ABOUT text doesn't mention paradoxes or 
        self-referentiality at all.)^";
    print "^Really, the paper models a logician who is very limited in
        some ways. He can see the spheres and cubes and whatnot in the
        world, and see where they are, what color they are, and so on. But
        he CAN'T see the colors of the pieces of paper themselves! He reads
        the sentence on the paper, and tries to judge whether it's true or
        false. His decision affects the color of the paper, but he doesn't
        see that.^";
    print "^The logician is also curiously ignorant about his own processes
        of logical proof. For example, he recognizes that ~This sentence is
        false~ (or the paper equivalent, ~This paper is red~) is paradoxical.
        (Which is why such a paper will turn grey.)
        But this isn't because he rigorously analyzes the situation! If
        he tried, his poor brain would explode. He just RECOGNIZES the
        statement as being a paradox. He can recognize a few more classes
        of paradox -- for example: ~The following statement is true;~
        ~The preceding statement is false.~ But he doesn't have a general
        algorithmic accounting of ALL paradoxes. Just these few.^";
    print "^As a further example, consider a paper that says ~This paper
        is grey~ -- meaning, ~This statement is paradoxical.~ Our 
        Slightly Clever Logician DOESN'T recognize this as a paradox --
        even though WE find it very confusing! Since the logician doesn't
        recognize it as a paradox, he simply says it's false. The paper
        thus turns red.^";
    print "^For a more detailed explanation of this Slightly Clever Logician,
        see the essay accompanying this game. (Or on the web site listed
        below.) I think my notion is consistent
        and rigorous, but comment is welcome.^^";
    print "  Andrew Plotkin (erkyrath@@64eblong.com)^";
    font off;
    print "  <http://www.eblong.com/zarf/comp/logicpuz/index.html>^";
    font on;
    print "^By the way, I stole the whole notion of limited logicians
        from Raymond Smullyan. I think it was his book FOREVER UNDECIDED,
        but I'm not sure -- I read it long ago and I don't have a copy
        myself.^";
    print "^For another interesting treatment of the Liar paradox, see
        THE LIAR, by Barwise and Etchemendy. I didn't use their account
        in working out my ideas for this toy, but it's still great stuff.
        If you don't mind set theory.^";
];

! Add some smarts to the "look under" action. It will print an appropriate
! message for objects resting on or inside something else.
[ LookUnderSub ix;
    ix = parent(noun);
    if (ix ~= nothing) {
        if (ix == player)
            "You are holding ", (the) noun, ".";
        if (ix has supporter)
            print_ret (The) noun, " is resting on ", (the) ix, ".";
        if (ix has container)
            print_ret (The) noun, " is in ", (the) ix, ".";
    }
    ! default message
    L__M(##LookUnder,2);
];

! These verb routines just set the global writepred, and then invoke
! the (fake) Write action. The writepred variable is used exactly the
! same way noun and second are -- as fodder for before/after clauses, etc.

Global writepred;

[ WriteIsOnSub;
    writepred = PredIsOn;
    <<Write noun second>>;
];

[ WriteIsTouchingSub;
    writepred = PredIsTouching;
    <<Write noun second>>;
];

[ WriteIsPropSub;
    writepred = PredIsProperty;
    <<Write noun second>>;
];

[ WriteSub;
    ! When we get here, the writepred global has been correctly set.
    !print "### WriteSub ", (the) noun, " ", (string) writepred.description, 
    !    " ", (the) second, ".###^^";

    if (player in Playroom && ~~genie.asleep) {
        print "(requested of the genie)^";
        RequestWriting(noun, writepred, second);
        rtrue;
    }

    "You have no writing implement.";
];

[ EraseSub;
    if (~~(noun ofclass PaperClass))
        "That can't be erased (or written on, for that matter).";
    if (noun.blank) {
        print "There's nothing written on ";
        noun.shorter_name();
        ".";
    }

    if (player in Playroom && ~~genie.asleep) {
        print "(requested of the genie)^";
        RequestErasure(noun);
        rtrue;
    }

    "You have no way to erase writing.";
];


! A grammar "scope=" routine which accepts any object which is legal to
! write about. (This includes objects which are out of sight, which is
! why I'm not using a simpler "noun=" routine. We have to loop over the
! entire game. Note that in a very large game, this objectloop might 
! be objectionably slow.)
[ NameableScope obj;
    switch (scope_stage) {
        1: rfalse;  ! no multiple objects
        2: ! put everything with the "nameable" attribute into scope.
            objectloop (obj has nameable) {
                PlaceInScope(obj);
            }
            rtrue;  ! only objects named in this routine are legal
        3: "I didn't understand that sentence.";
    }
];

! Another "scope=" routine, which accepts only PropertyClass objects.
! (These are never in normal scope; they're abstract objects, held outside
! the game world.)
[ PropertyScope obj;
    switch (scope_stage) {
        1: rfalse;  ! no multiple objects
        2: ! put everything of the PropertyClass into scope.
            objectloop (obj ofclass PropertyClass) {
                PlaceInScope(obj);
            }
            rtrue;  ! only objects named in this routine are legal
        3: "I didn't understand that sentence.";
    }
];

Verb meta 'about' 'help'
    * -> About
    * 'more' -> AboutMore;

Verb meta 'more'
    * 'about'/'help' -> AboutMore;

! Extend the "look" verb to accept "look on". Also trim out the pesky
! "look up" (consult) grammar, which is useless in this game.
Extend 'look' replace      ! synonym 'l//'
    * -> Look
    * 'at' noun -> Examine
    * 'inside'/'in'/'into'/'through'/'on' noun -> Search
    * 'under' noun -> LookUnder;

Verb 'erase' 'unwrite'
    * noun -> Erase;

! The rather baroque "write" grammar. Each line appears twice -- once
! with the standard noun scope, and once with the scope=NameableScope
! routine. Why? Because the grammar should *prefer* objects in scope,
! in order to get standard disambiguation. But it should *permit* any
! nameable object in the game -- after all, you can write about an
! object which is out of sight. 
! 
! This allows the player to do some oracular investigation of the
! universe! For an example, try "write paper" when no paper is in
! scope. In a serious game, you might want to limit this to objects in
! scope, or objects ever seen by the player.
Verb 'write' 'inscribe'
    * noun 'is'/'am'/'are' 'on' noun -> WriteIsOn
    * scope=NameableScope 'is'/'am'/'are' 'on' scope=NameableScope -> WriteIsOn
    * noun 'is'/'am'/'are' 'touching' noun -> WriteIsTouching
    * scope=NameableScope 'is'/'am'/'are' 'touching' scope=NameableScope 
        -> WriteIsTouching
    * noun 'touches' noun -> WriteIsTouching
    * scope=NameableScope 'touches' scope=NameableScope 
        -> WriteIsTouching
    * noun 'is'/'am'/'are' scope=PropertyScope -> WriteIsProp
    * scope=NameableScope 'is'/'am'/'are' scope=PropertyScope -> WriteIsProp;

! This is a fake fake action -- it exists only for the WriteIsOn,
! WriteIsTouching, and WriteIsProp actions to call. The player can't
! invoke it directly (because of the comma in the dict word).
Verb ',write'
    * -> Write;