! This code was written by Eric Schmidt (eschmidt@safeaccess.com)
! using code by Andrew Plotkin (erkyrath@eblong.com). This
! code is in the public domain.

Constant Story "The Traffic Light";
Constant Headline "^An Interactive Demonstration^
                    (First time players should type ~about~.)^
                    This game is in the public domain.^";
Release 1;
Serial "041303";

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;

Include "Parser";

Property defcol1; Property defcol2; ! Original colors of objects

Include "VerbLib";

Global tparadox = false;
Global dynobj = nothing;
Global old_dynobj = nothing;
Global dcolor = nothing;
Global odcolor = nothing;

[ Initialise obj;
    location = Side_of_road;
    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';

    ! Set defcol properties to initial values.
    objectloop (obj ofclass Tobject) {
      obj.defcol1 = obj.&name-->0;
      obj.defcol2 = obj.&name-->1;
    }

    StartDaemon(paperbox);

    "You're grateful to your friend for letting you borrow that printer,
    but it's time to return it. Now if only this traffic light would
    turn green, you could continue...^";
];

! The grammar accepts sentences like "write "I am blue"", even though
! the printer 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;
];

Class Tobject with defcol1, defcol2;

Object Side_of_road "Side of road"
  with
    name 'cars' 'road' 'street' 'logic' 'avenue',
    description [;
      print "You are standing at the side of a busy road, Logic Avenue,
             to the west.";
      if (trafficlight.&name-->0 == 'red')
        " An endless procession of cars prevents you from crossing.";
      new_line; rtrue;
    ],
    w_to [;
      if (trafficlight.&name-->0 == 'red')
        "Not with the cars passing by.";
      deadflag = 2;
      print "You gather up everything and cross the street. Your friend is
             glad to have the printer back.^^When you get home, you watch the
             news, and hear about a strange traffic light malfunction holding
             up traffic on Logic Avenue.";
      if (trafficlight.&name-->0 ~= 'green' or 'yellow')
        print " The reporter says, ~Engineers are baffled as to how the
               light is ",
               (address) trafficlight.&name-->0, ".~";
      new_line; rtrue;
    ];

Tobject -> trafficlight "traffic light" has static
  with
    name 'red' 'red' 'traffic' 'light' 'stoplight',
    description [;
      print "Though there's no intersection here, this light is intended
        to allow pedestrians to cross the street. However, the light always
        stays red for the pedestrians unless a little button on a telephone
        pole is pushed. Neither the button nor the telephone pole seems
        to be present, typical of the lousy planning of your city.^";
      if (self.&name-->0 == 'green')
        "^Well, thanks to your cleverness, you can cross now.";
      rtrue;
    ];
  
! The statement class. A statement is a simple sentence, of the form which
! can be parsed in this game: for example, "The printer 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 (an 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 (char) '"';
        ! 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 (char) ' ';
        print (string) self.pred.description;
        print (char) ' ';
        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.";
    ];

! 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".

! 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;
        if (tparadox && obj == tsheet or child(tsheet))
          ! The "transparent sheet paradox" is rampant.
          ! So tsheet and child(tsheet) must be grey.
          return paradoxical;

        nameaddr = self.&name;
        namelen = self.#name / WORDSIZE;
        for (ix=0 : ix<namelen : ix++) {
            if (WordInProperty(nameaddr-->ix, obj, name))
                rtrue;
        }
        if (obj ofclass PaperClass) {
          for (ix=0: ix < namelen: ix++) {
            if (nameaddr-->ix == obj.color or obj.color2) 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 PropWhite
  with
    name 'white',
    adjec "white";

! 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 need not be white in this game.
            if (obj.blank) return self.SimplePropertyClass::eval(obj);

            if (tparadox && obj == tsheet or child(tsheet))
               return paradoxical;

            ! 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.";

    if (tparadox && (stat == tsheet.statement || child(tsheet).statement))
      return paradoxical;

    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 ", (string) self.colorstr, ".";
        print " (which is ", (string) self.colorstr, ") reads, ";
        self.statement.description();
        new_line;
        rtrue;
    ];

! 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) rfalse; ! Can't erase in this game.

    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 what the colors of the printer or traffic light 
! 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 4;
Array loophistory --> MAXLOOPSIZE;
Array truthcount --> 4; ! false, true, indeterminate, paradoxical
[ RecomputeLoops  obj ix jx kx t ox ox2 tobj tcobj isloop col val val2;
    ! 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.";
    }

    ! Compute 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;
        }
    }

    ! 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;
        }

        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;
            }
        }
    }

    ! Check for the "transparent sheet paradox"

    tparadox = false;
    
    t = child(tsheet);
    if (~~tsheet.blank) {
      if (t && t provides blank
          && (~~t.blank)) {
        tobj = RefersTo(tsheet);
        tcobj = RefersTo(t);
        if (tobj && tobj == tcobj)
          ! Both the transparency and its paper refer to the same thing,
          ! and are not in loops. The Limited Logician considers
          ! this a paradox.
          { tparadox = true; jump dodynobj; }
      } else jump dodynobj;
    } else {            ! tsheet is blank
      if (t && tsheet == RefersTo(t)) tparadox = true;
      jump dodynobj;
    }

    ! If t is in a loop, but tsheet refers to a normal object,
    ! the tsheet is "stubborn": paradox.
    if (tobj && (~~tcobj)) {
      tparadox = true;
      if (t.inloop) CorrectLoop(t);
      jump dodynobj;
    }

    dynobj = tcobj;

    if (tobj && tcobj) jump dodynobj;

    if (tsheet.preloop) tsheet.loopvalue = EvaluateStatement(tsheet.statement);
    if (t.preloop) t.loopvalue = EvaluateStatement(tsheet.statement);
    if (tsheet.loopvalue ~= t.loopvalue) {
      ! They have to be the same, but aren't: a paradox.
      tparadox = true;
      if (tsheet.inloop) CorrectLoop(tsheet);
      if (t.inloop) CorrectLoop(t);
    }

  .dodynobj;

  if (dynobj) {
    if (dynobj ofclass PaperClass) dcolor = dynobj.color;
      else dcolor = dynobj.&name-->0;
  }

  if (old_dynobj) {
    if (old_dynobj ofclass PaperClass) {
      old_dynobj.color = 'white';
      old_dynobj.color2 = 'blank';
      old_dynobj.colorstr = "white";
    } else {
      old_dynobj.&name-->0 = old_dynobj.defcol1;
      old_dynobj.&name-->1 = old_dynobj.defcol2;
    }
  }
  
  if (dynobj) {
    if (tsheet.inloop) val = tsheet.loopvalue;
      else val = EvaluateStatement(tsheet.statement);
    val2 = EvaluateStatement(t.statement);
    if (val == true or false && val ~= val2) {
      ! if tsheet isn't T/F, let dynobj be!
      if (ReachesnTF(t)) {
        tparadox = true;
        return;           ! Changes to t won't affect dynobj 
      }

      col = LowestPaper(t).statement.obj2;

      ! So we want to make tsheet and t say the same thing.
      ! So if dynobj's default color agrees with the paper that refers to it,
      ! change it to something else. (I chose green, so that the traffic
      ! light handling makes the most sense.) If not, change it to that
      ! color. No object is green by default, so we don't have to check
      ! for that.

      if (col.&name-->0 == dynobj.&name-->0) {
        if (dynobj ofclass PaperClass) {
          dynobj.color = 'green';
          dynobj.color2 = 'green';
          dynobj.colorstr = "green";
        } else {
          dynobj.&name-->0 = 'green';
          dynobj.&name-->1 = 'green';
        }
      } else {
        ix = col.#name / WORDSIZE - 1;
        if (dynobj ofclass Paperclass) {
          dynobj.color = col.&name-->0;
          dynobj.color2 = col.&name-->ix;
          dynobj.colorstr = col.adjec;
        } else {
          dynobj.&name-->0 = col.&name-->0;
          dynobj.&name-->1 = col.&name-->ix;
        }
      }
    }
  }
];

! Returns the object that a paper with a statement ultimately refers to,
! possibly indirectly. If the object is inloop or preloop, return 0.
[ RefersTo o1 i;
  for (: i <= MAXLOOPSIZE: i++) {
    if ((~~o1 ofclass PaperClass) || o1.blank) return o1;
    o1 = o1.statement.obj1;
  }

  rfalse;
];

! When the "transparent sheet paradox" occurs in a loop, we'll have to
! correct it. This uses some code stolen frem RecomputeLoops, suitably
! modified.
[ CorrectLoop obj ox ix;
  obj.loopvalue = paradoxical;
  ox = obj.statement.obj1;
  while (1) {
    ! tsheet and its child stay paradoxical
    if (ox ~= tsheet or child(tsheet)) {
      ix = ox.statement.obj2.loopvalue;
      if (ix == indeterminate) ox.loopvalue = true;
        else ox.loopvalue = false;
    }
      ox = ox.statement.obj1;
      if (ox == obj) break;
  }
];

[ LowestPaper o1 o2;
  while (o1 ofclass PaperClass && (~~o1.blank)) {
    o2 = o1;
    o1 = o1.statement.obj1;
  }

  return o2;
];

! Does the paper object (indirectly) refer to a "brown" or "grey" claim?
[ ReachesnTF obj o;
  while (obj ofclass PaperClass && (~~obj.blank)) {
    o = obj.statement.obj1;
    if (o ofclass PaperClass && (~~o.blank)
        && obj.statement.obj2 == PropGrey or PropBrown) rtrue;
    obj = o;
  }
  rfalse;
];

! 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) print ".^";

        count = 0;
        if (old_dynobj && (~~old_dynobj ofclass PaperClass)
            && old_dynobj ~= dynobj
            && odcolor ~= old_dynobj.&name-->0)
              loophistory-->(count++) = old_dynobj;
        if (dynobj && (~~dynobj ofclass PaperClass)
            && dcolor ~= dynobj.&name-->0)
              loophistory-->(count++) = dynobj;
        if (old_dynobj && old_dynobj ofclass PaperClass
            && old_dynobj ~= dynobj
            && odcolor ~= old_dynobj.color)
              loophistory-->(count++) = old_dynobj;
        if (dynobj && dynobj ofclass PaperClass
            && dcolor ~= dynobj.color)
              loophistory-->(count++) = dynobj;

        if (count) {
          print "^", (The) loophistory-->0, " turns ",
            (address) (loophistory-->0).&name-->0;
          if (count == 2) {
            print ", and", (the) loophistory-->1, " turns ",
              (address) (loophistory->1).&name-->0;
          }
          print (char) '.';
          if (dynobj == trafficlight && dcolor ~= trafficlight.&name-->0) {
              print "^^The cars slow down and stop. Now you can finally
                     continue and return that printer.";
          }
          else if (old_dynobj == trafficlight
              && odcolor ~= trafficlight.&name-->0) {
            print "^^The cars resume their deadly course.";
          }
        }
        if (count) new_line;
        if (dynobj) { old_dynobj = dynobj; dynobj = 0; }
        if (old_dynobj) odcolor = old_dynobj.&name-->0;
        dcolor = 0;
    ];

PaperClass shinypaper "shiny paper" selfobj
  with
    name 'shiny',
    adjec "shiny",
    statement paperstatement1;

PaperClass dullpaper "dull paper" selfobj
  with
    name 'dull',
    adjec "dull",
    statement paperstatement2;

PaperClass thinpaper "thin paper" selfobj
  with
    name 'thin',
    adjec "thin",
    statement paperstatement3;

PaperClass tsheet "sheet protector" Side_of_road has open container
  with
    name 'sheet' 'protector' 'transparency',
    description [;
      if (self.blank)
        "A sheet protector, made of two transparent sheets, can
         protect a single sheet of paper from damage.";
      self.Paperclass::description();
      rtrue;
    ],
    shorter_name [;
        print "transparent sheet protector";
        rtrue;
    ],
    short_name [;
        print (string) self.colorstr, " sheet protector";
        rtrue;
    ],
    after [;
      Receive, LetGo:
        ! This can change the logic of things, so...
        RecomputeLoops();
    ],
    color 'transparent',
    color2 'clear',
    colorstr "transparent",
    capacity 1,
    statement paperstatement4;

! The directions orignally had the pluralname attribute
! and the short name "mysterious directions", but "is" is somewhat hardwired
! into the logic system, so we get, "The mysterious directions is white."
! So I changed it to a singular form.
Tobject directions "paper of mysterious directions" tsheet
  with
    name 'white' 'blank' 'mysterious' 'directions' 'clue' 'clues' 'riddle'
         'paper' 'of',
    description
      "A set of mysterious, nearly indecipherable directions for using the
       printer. Fortunately, you seem to have been able to operate it without
       them.",
    before [;
      Examine: if (verb_word == 'read') "You don't want to. Believe me.";
      Feed: "You're friend wouldn't be happy if you printed all over
             his directions.";
    ];

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

! 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 proper;

! The printer

Tobject printer "printer" Side_of_road
  with
    name 'grey' 'gray' 'friend^s' 'printer',
    initial [ ix;
        print "The printer rests here,
               an ugly shade of ", (address) self.&name-->0,
               ". The printer is ";
        ix = child(self);
        if (ix) {
            print "holding the ";
            ix.shorter_name();
        } else print "waiting to be fed some paper";
        ".";
    ],
    description [ ix;
        print "A difficult-to-use printer, shaded an ugly ",
               (address) self.&name-->0, ".^";
        ix = child(self);
        if (ix) {
            print " The printer is holding the ";
            ix.shorter_name(); ".";
        }         
        rtrue;
    ],
    orders [;
        Write:
            RequestWriting(noun, PredIsProperty, second);
            rtrue;
    ],
    before [;
      Insert: if (second == tsheet) "I don't think so.";
    ],
    react_before [;
      Take, Remove: 
         if (noun in self) "Wow. That printer really has a firm grip."; 
    ],
  has transparent;

! This is called when the player makes a writing request of the printer.
[ RequestWriting obj1a preda obj2a  paper ix;

    ! First, find a piece of paper.
    paper = child(printer);

    if (paper == nothing) {
        "The printer bleeps, indicating there is no paper to write on.";
    }

    ! 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)
        "Writing about yourself would be dangerous.";
    
    if (preda == PredIsProperty) {
        if (~~(obj2a ofclass PropertyClass)) {
            ! I don't think this error can actually happen, but
            ! best check anyhow.
            "You frown. '", (name) obj2a, "' isn't
                a color. Try '", (the) obj1a, " is blue' or
                or something.";
        }
    }

    print "The printer whizzes and hums, printing, ";
    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_ret " turns ", (string) paper.colorstr, 
                  " as you retrieve it.";
    }
    else {
        print " You retrieve the ";
        paper.shorter_name();
        ".";
    }
];

! 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, ". The object of this game is to
           get across the street. This game contains a printer that
           actually prints text onto paper, rather than scanning.
           First, you'll have to FEED the paper, (no ~put X in printer~)
           and then WRITE on it. The only things you can write are of the
           form ~X is Y~, where Y is a color: blue, orange, yellow,
           purple, black, white, red, green, brown, grey.^If you have any
           questions, feel free to contact me.
           ^  Eric Schmidt (eschmidt@@64safeaccess.com)^";
];

! 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);
];

[ FeedSub i;
  i = child(printer);
  if (i) "The printer already contains ", (the) i, ".";

  if (~~(noun ofclass PaperClass))
    "You can't feed ", (ThatOrThose) noun, " into the printer.";

  move noun to printer;
  "You feed ", (the) noun, " into the printer. The printer
   gives a soft beep.";
  ];

[ WriteSub;
  RequestWriting(noun, PredIsProperty, second);
];

! A grammar "scope=" routine which accepts any object which is legal to
! write about.
[ NameableScope;
    switch (scope_stage) {
        1: rfalse;  ! no multiple objects
        2: PlaceInScope(thispaper); ! Put "this paper" into scope
           rfalse;  ! all normal objects are allowed
        3: "I didn't understand that sentence.";
    }
];

! A "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;

! Trim out the pesky "look up" (consult) grammar, which is useless in this
! game.
! 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;

Extend only 'feed' replace
  * held -> Feed;

! The "write" grammar. Since there's only one predicate, we can eliminate
! the fake fake action. Since there's only one location, and everything
! is nameable, the NameableScope is simplified a bit.

Verb 'write' 'inscribe' 'print'
    * scope=NameableScope 'is'/'am'/'are' scope=PropertyScope -> Write;