! _Shade_
! Special source-code edition
! Copyright 2000-2002 Andrew Plotkin <erkyrath@eblong.com>
! http://www.eblong.com/zarf/if.html
!   This source code is provided for personal, educational use only. 
!   See README file for details.

Constant Story "SHADE";
Constant Headline "^A brief story by ~Ampe R. Sand~ (Andrew Plotkin)^
    First-time players should type ~about~.^";
Release 3;

!Constant ZDEBUG;

Constant WORDSIZE 2;
Constant MANUAL_PRONOUNS;
Constant NO_PLACES;
Constant SKIP_MAGIC_ARTICLES;
Constant DIALECT_US;
!Constant AMERICAN_COMMAS;
Constant USE_PARTINVENT;

Attribute goal_complete;
Attribute rescuable;
Property prereqs;

Replace Banner;
Replace Keyboard;
Replace DrawStatusLine;
Replace ObjectIsUntouchable;
Replace OffersLight;
Replace SayWhatsOn;
Replace ScoreSub; 
Replace FullScoreSub; 
Replace SorrySub; 
Replace StrongSub; 
Replace MildSub; 
Replace PraySub;
Replace LMode3Sub;
Replace LookSub;
Replace SingSub;

Include "Parser";

#ifndef DEBUG;
Global debug_flag;
#endif;

Object LibraryMessages "lib_messages"
  with
    seenonce, startup, shutdown, opentime,
    subdescribe, nosubdescribe, nosupportlist, locseealso, nolocifin,
    self_word, self_name, self_obj, sand_obj,
    leave_barrier, leave_fragment, enter_fragment,
    receive_water, receive_sand, background_flag, ticket_search, 
    weakness, saw_blank,
    before [ ix;
        Miscellany:
            switch (lm_n) {
                4: print " SHADE "; rtrue;
            }
        Examine:
            switch (lm_n) {
                3: rtrue; ! squash "switchable is on/off" message
            }
        Take:
            switch (lm_n) {
                7:    if (lm_o ofclass Zone) {
                        if (noun has pluralname) print "Those are";
                        else print "That is";
                        if (lm_o has supporter) print " on";
                        else print " in";
                        print (the) lm_o;
                        ".";
                    }
            }
        Insert:
            switch (lm_n) {
                2:    if (lm_o == toilet) {
                        "Flushing your life down the toilet is just a figure
                            of speech, okay?";
                    }
            }
        Drop:
            switch (lm_n) {
                4:    print "Dropped";
                    ix = parent(player);
                    if (ix ofclass Zone) {
                        if (ix has supporter)
                            print " (onto ", (the) ix, ")";
                        else
                            print " (in ", (the) ix, ")";
                    }
                    ".";
            }
        Look:
            switch (lm_n) {
                1:
                    if (lm_o == desk)
                        print ", at ";
                    else
                        print ", on ";
                    print (the) lm_o; 
                    rtrue;
                2: print ", in ", (the) lm_o; rtrue;
                 5, 6: 
                     if (lm_o provides nolocifin && lm_o.nolocifin()
                         && IndirectlyContains(lm_o, player))
                         rtrue;
                     ! print "[ Locale ", (name) lm_o, " ]";
                     if (lm_o~=location) {
                         if (lm_o has supporter) print "^On "; 
                         else print "^In ";
                        print (the) lm_o, " you";
                    }
                    else {
                        print "^You";
                    }
                    print " can ";
                    if (lm_n==5) print "also "; 
                    print "see ";
                    WriteListFrom(child(lm_o),
                        ENGLISH_BIT + WORKFLAG_BIT + RECURSE_BIT
                        + PARTINV_BIT + TERSE_BIT + CONCEAL_BIT);
                    if (lm_o ~= location) 
                        ".";
                    if (lm_o ~= parent(player) && lm_o == Apartment) {
                        if (parent(player) has supporter)
                            " lying on the floor.";
                        else
                            " lying in the living room.";
                    }
                    " here.";
            }
        Fill:
            "That makes no sense.";
        Sleep:
            if (player.orders)
                "If only.";
            print "You've been trying all night. It's not going to happen";
            if (player in futon)
                print ", no matter how long you lie here";
            ".";
        Wake:
            "If only.";
        Drink:
            "Unlikely.";
        Dig:
            "You can't dig in that.";
        LMode1: " is now in its ~brief~ printing mode, which gives
                    long descriptions of places never before visited and short
                    descriptions otherwise.";
        LMode2: " is now in its normal ~verbose~ mode, which always gives long
                    descriptions of locations
                    (even if you've been there before).";
    ];

Include "VerbLib";

! --- Classes and other initial things

#include "shade-zone.inf";
#include "shade-sand.inf";
#include "shade-goal.inf";
#include "shade-room.inf";
#include "shade-nook.inf";
#include "shade-fake.inf";
#include "shade-dese.inf";

! --- Game startup

[ Initialise ix;
    ix = debug_flag;
    goalhandler.initial();
    
    move futon to Apartment;
    move desk to Apartment;
    move kitchen to Apartment;
    move bathroom to Apartment;
    move glass to counter;
    
    player = myselfobj;
    location = futon;
    
    lookmode = 2; ! verbose
    inventory_style = FULLINV_BIT + ENGLISH_BIT + RECURSE_BIT; ! wide
    
    #ifdef DEBUG;
        print "[BUG] DEBUG on!^^";
    #endif;
    #ifdef ZDEBUG;
        move wand to player;
        print "[BUG] ZDEBUG on!^^";
    #endif;
];

Object myselfobj "(self object)"
  with 
    short_name "yourself",
    description "You're you.",
    capacity 100,
    number 0,
    orders 0,
    before [;
        Empty:
            "You know you are already empty.";
    ],
    receive_water [;
        print "You want to dump the water on your head?
            Potentially enjoyable; actually messy.^";
        return 2;
    ],
    receive_sand [;
        print "You're not a chinchilla.^";
        return 2;
    ],
    weakness 0,
  has concealed animate proper transparent rescuable;

#ifdef ZDEBUG;
Object wand "magic wand"
  with
    name 'magic' 'wand',
    before [;
    ];
#endif;

! --- Grammar and suchlike helpers

[ Keyboard  a_buffer a_table  nw i w w2 x1 x2;

    DisplayStatus();
    .FreshInput;

!  Save the start of the buffer, in case "oops" needs to restore it
!  to the previous time's buffer

    for (i=0:i<64:i++) oops_workspace->i = a_buffer->i;

!  In case of an array entry corruption that shouldn't happen, but would be
!  disastrous if it did:

   a_buffer->0 = 120;
   a_table->0 = 15;  ! Allow to split input into this many words

!  Print the prompt, and read in the words and dictionary addresses

    L__M(##Prompt);
    AfterPrompt();
    #IFV5; DrawStatusLine(); #ENDIF;
    KeyboardPrimitive(a_buffer, a_table);
    nw=a_table->1;

!  If the line was blank, get a fresh line
    if (nw == 0)
    { L__M(##Miscellany,10); jump FreshInput; }

!  Unless the opening word was "oops", return

    w=a_table-->1;
    if (w == OOPS1__WD or OOPS2__WD or OOPS3__WD) jump DoOops;

#IFV5;
!  Undo handling

    if ((w == UNDO1__WD or UNDO2__WD or UNDO3__WD) && (parse->1==1))
    {   if (turns==1)
        {   L__M(##Miscellany,11); jump FreshInput;
        }
        if (undo_flag==0)
        {   L__M(##Miscellany,6); jump FreshInput;
        }
        if (undo_flag==1) jump UndoFailed;
        if (just_undone==1)
        {   L__M(##Miscellany,12); jump FreshInput;
        }
        @restore_undo i;
        if (i==0)
        {   .UndoFailed;
            L__M(##Miscellany,7);
        }
        jump FreshInput;
    }
    @save_undo i;
    just_undone=0;
    undo_flag=2;
    if (i==-1) undo_flag=0;
    if (i==0) undo_flag=1;
    if (i==2)
    {   !style bold;
        !print (name) location, "^";
        !style roman;
        L__M(##Miscellany,13);
        just_undone=1;
        jump FreshInput;
    }
#ENDIF;

    return nw;

    .DoOops;
    if (oops_from == 0)
    {   L__M(##Miscellany,14); jump FreshInput; }
    if (nw == 1)
    {   L__M(##Miscellany,15); jump FreshInput; }
    if (nw > 2)
    {   L__M(##Miscellany,16); jump FreshInput; }

!  So now we know: there was a previous mistake, and the player has
!  attempted to correct a single word of it.

    for (i=0:i<=120:i++) buffer2->i = a_buffer->i;
    x1 = a_table->9; ! Start of word following "oops"
    x2 = a_table->8; ! Length of word following "oops"

!  Repair the buffer to the text that was in it before the "oops"
!  was typed:

    for (i=0:i<64:i++) a_buffer->i = oops_workspace->i;
    Tokenise__(a_buffer,a_table);

!  Work out the position in the buffer of the word to be corrected:

    w = a_table->(4*oops_from + 1); ! Start of word to go
    w2 = a_table->(4*oops_from);    ! Length of word to go

!  Write spaces over the word to be corrected:

    for (i=0:i<w2:i++) a_buffer->(i+w) = ' ';

    if (w2 < x2)
    {   ! If the replacement is longer than the original, move up...

        for (i=120:i>=w+x2:i--)
            a_buffer->i = a_buffer->(i-x2+w2);

        ! ...increasing buffer size accordingly.

        a_buffer->1 = (a_buffer->1) + (x2-w2);
    }

!  Write the correction in:

    for (i=0:i<x2:i++) a_buffer->(i+w) = buffer2->(i+x1);

    Tokenise__(a_buffer,a_table);
    nw=a_table->1;

    return nw;
];

Global parse_err_count = 0;

[ ParserError etype;
    switch (etype) {
        UPTO_PE:
            if (action_to_be == ##Vacuum) {
                print "Just ~", (address) verb_word, "~.";
                parse_err_count++;
                if (parse_err_count == 3) 
                    print " And the parser apologizes for not being smarter
                        about this.";
                else
                    print " When you clean, it's pretty much cleaning the
                        whole area.";
                new_line;
                rtrue;
            }
            rfalse;
    }
    rfalse;
];

Array roomnamebuffer -> 128;
[ DrawStatusLine width len pos ix;
    @output_stream 3 roomnamebuffer;
    if (deadflag)
        print "...";
    else if (location == thedark) 
        print (name) location;
    else {
        FindVisibilityLevels();
        if (visibility_ceiling == location)
            print (The) location;
        else print (The) visibility_ceiling;
        ix = parent(player);
        if (visibility_ceiling ~= ix) {
            if (ix has supporter) L__M(##Look, 1, ix);
            else L__M(##Look, 2, ix);
        }
        else {
            if (~~GoalClosed(window))
                print ", in the living room";
        }
    }
    @output_stream -3;
    len = (roomnamebuffer-->0);

    @split_window 1; @set_window 1; @set_cursor 1 1; style reverse;
    width = 0->33;
    spaces width;

    pos = (width - len) / 2 + 1;
    @set_cursor 1 pos;
    for (ix=0 : ix<len : ix++)
        print (char) roomnamebuffer->(2+ix);
    @set_cursor 1 1; style roman; @set_window 0;
];

[ emph str;
    style underline;
    print (string) str;
    style roman;
];

[ KeyPause jx;
    print "[Hit any key...] ";
    @read_char 1 jx;
    new_line;
];

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

[ SayWhatsOn descon j f;
  if (descon==parent(player)) 
      rfalse;
  if (descon provides nosupportlist && descon.nosupportlist())
      rfalse;
  objectloop (j in descon)
      if (j hasnt concealed && j hasnt scenery) f=1;
  if (f==0) rfalse;
  L__M(##Look, 4, descon); rtrue;
];

[ DescribeParagraph loc started skipfinal ix;
    objectloop (ix in loc) {
        if (ix provides subdescribe && ix.subdescribe ~= NULL) {
            if (ix provides nosubdescribe && ix.nosubdescribe()) {
                ! nothing
            }
            else {
                if (~~started) {
                    print "^";
                    started = true;
                }
                else {
                    print " ";
                }
                PrintOrRun(ix, subdescribe, 1);
            }
        }
    }
    if (~~started)
        rfalse;
    if (~~skipfinal)
        print "^";
    rtrue;
];

[ ChooseObjects obj fl;
    if (fl == 0 or 1) {
        ! Scenery objects never count in "all".
        if (obj has scenery)
            return 2; 
        rfalse;
    }
    ! In general scoring, deprecate scenery, and particularly the walls.
    ! Tamed water gets a boost. Wild water in a different zone gets a
    ! penalty.
    if (obj in compass) {
        return 1;
    }
    if (obj ofclass SinkWater || obj ofclass Sink) {
        if (action_to_be == ##Find) {
            if (obj.self_word == 'bathroom') return 2;
            else return 1;
        }
        if (FindZone(player) ~= FindZone(obj))
            return 1;
    }
    if (obj == showerhead or showerheadwater) {
        if (action_to_be == ##Find) 
            return 1;
        if (FindZone(player) ~= FindZone(obj))
            return 1;
    }
    if (obj ofclass FloorSand || obj ofclass SinkSand) {
        if (FindZone(player) ~= FindZone(obj))
            return 1;
        else
            return 2;
    }
    
    if (action_to_be == ##Enter && verb_word == 'sit') {
        if (obj == futon or fakefuton or desfuton) {
            return 4;
        }
    }
    
    if (obj ofclass Fake) {
        return 2;
    }
    
    if (obj == water || obj ofclass SandQuantity) {
        return 3;
    }
    if (obj has scenery || obj == player) {
        return 2;
    }
    return 3;
];

Include "Grammar";

[ Banner i;
   new_line;
   print "    ";
#IFV5; style bold; #ENDIF;
   print "*** SHADE ***";
#IFV5; style roman; #ENDIF;
   if (Headline ~= 0)
       print (string) Headline;
   print "Release ", (0-->1) & $03ff, " / Serial number ";
   for (i=18:i<24:i++) print (char) 0->i;
   print " / Inform v"; inversion;
   print " Library ", (string) LibRelease, " ";
#ifdef STRICT_MODE;
   print "S";
#endif;
#ifdef INFIX;
   print "X";
#ifnot;
#ifdef DEBUG;
   print "D";
#endif;
#endif;
   new_line;
];

[ AboutSub;
    print "This is a one-room game set in your apartment.
        ...But perhaps you've already gathered that.^^";
    print "SHADE mostly uses the standard vocabulary of interactive
        fiction. You may find the command ~find...~ (or ~where is...~)
        convenient, though not critically important.^^";
    print "SHADE is copyright 2000 by Andrew Plotkin
        (erkyrath@@64eblong.com).
        He began coding it on the morning of September 2, 2000,
        and raced like
        the wind to finish it in time for the Sixth Annual IF Competition. 
        (SHADE placed tenth, which is pretty darn good, considering the
        overall excellence of the entries that year.)
        For more IF by the same author, 
        see^^    <http://www.eblong.com/zarf/if.html>^^
        SHADE may be distributed for free,
        but not sold or included in any for-profit collection without
        written permission from the author.^^";
    print "All hail the beta-tester: Michael Kinyon (still inevitable
        after all these years).
        And the people who sent bug reports after the competition,
        who include (but are not limited to):
        Ross Presser, Gunther Schmidl, Matthew Murray, Joe Mason,
        Nick Wolfe, Caleb Wilson, Neil Cerutti, Jason McIntosh,
        Daryl McCullough, Lelah Conrad, Jeff Hall.
        And -- this game is dedicated to Meatball Fulton.^";
    rtrue;
];

[ ScoreSub;
    if (deadflag)
        return;
    L__M(##Miscellany, 38);
];

[ FullScoreSub;
    ScoreSub();
];

[ LookSub allow_abbrev  visibility_levels i j k;
  if (parent(player)==0) return RunTimeError(10);

  .MovedByInitial;
  if (location == thedark) { visibility_ceiling = thedark; NoteArrival(); }
  else
  {   visibility_levels = FindVisibilityLevels();
      if (visibility_ceiling == location)
      {   NoteArrival();
          if (visibility_ceiling ~= location) jump MovedByInitial;
      }
  }

  ! The boldface intro line is kaput...
  !   The room description (if visible)

  if (lookmode<3 && visibility_ceiling==location)
  {   if ((allow_abbrev~=1) || (lookmode==2) || (location hasnt visited))
      {   if (location.describe~=NULL) RunRoutines(location,describe);
          else
          {   if (location.description==0) RunTimeError(11,location);
              else PrintOrRun(location,description);
          }
      }
  }

  if (visibility_levels == 0) Locale(thedark);
  else
  {   for (i=player, j=visibility_levels: j>0: j--, i=parent(i))
          give i workflag;
      
      for (j=visibility_levels: j>0: j--)
      {   for (i=player, k=0: k<j: k++) i=parent(i);
          if (i.inside_description~=0)
          {   new_line; PrintOrRun(i,inside_description); }
          Locale(i);
      }
      
      i = parent(player);
      if (i provides locseealso) {
          k = (i.#locseealso) / WORDSIZE;
          i = (i.&locseealso);
          for (j=0 : j<k : j++) {
              if (parent(i-->j))
                  Locale(i-->j);
          }
      }
  }

  LookRoutine();
  ScoreArrival();

  action=##Look;
  if (AfterRoutines()==1) rtrue;
];

[ FindSub zo ix jx;
    if (player == noun)
        "You know where you are.";
    if (IndirectlyContains(player, noun))
        "You've got ", (the) noun, ".";
    zo = FindZone(noun);
    if (~~zo)
        "Strange question.";
    print (The) noun, " ", (isorare) noun;
    if (zo has supporter) 
        print " on ";
    else
        print " in ";
    if (zo == Apartment)
        print "the living room";
    else
        print (the) zo;
    if (parent(noun) ~= zo) {
        jx = 0;
        for (ix = parent(noun) : ix && ix ~= zo : ix = parent(ix)) {
            if (ix has container || ix has supporter)
                jx = ix;
        }
        if (jx) {
            if (jx has supporter)
                print ", on ";
            else
                print ", in ";
            print (the) jx;
        }
    }
    ".";
];

[ FindMeSub; <<Find player>>; ];

[ RaiseSub;
    if (OIU(noun)) rtrue;
    if (noun has static || noun has scenery)
        "You are unable to.";
    "This is uninteresting.";
];

[ LowerSub;
    if (OIU(noun)) rtrue;
    if (noun has static || noun has scenery)
        "You are unable to.";
    "This is uninteresting.";
];

[ VacuumSub;
    if (~~TestScope(vacuum))
        "No cleaning implement is in sight.";
    <<SwitchOn vacuum>>;
];

[ WaterActionSub;
    if (~~IndirectlyContains(player, water))
        "You're not carrying any water.";
    <<PutOn water noun>>;
];

[ PlaySub;
    print_ret (cthatorthose) noun, " ", (isorare) noun, " no game.";
];

[ BlowOnSub;
    if (OIU(noun)) rtrue;
    print_ret "Blowing on ", (thatorthose) noun, " has no effect.";
];

[ TypeVagueSub obj;
    obj = 0;
    if (TestScope(computer))
        obj = computer;
    if (obj==0 && TestScope(fakecomputer))
        obj = fakecomputer;
    if (obj==0 && TestScope(descomputer))
        obj = descomputer;
    if (obj==0)
        "I'm not sure what you want to type on.";
    print "(on ", (the) obj, ")^";
    <<TypeOn obj>>;
];

[ TypeOnSub;
    print_ret "You cannot type on ", (thatorthose) noun, ".";
];

[ SingSub;
    if (GoalClosed(mirror))
        "There is no place for that here.";
    "This is no place for that.";
];

[ LMode3Sub;
    print_ret "~Superbrief~ mode is not available in ", (string) Story, ".";
];

[ SorrySub;
    L__M(##Miscellany, 38);
];

[ StrongSub;
    L__M(##Miscellany, 38);
];

[ MildSub;
    L__M(##Miscellany, 38);
];

[ PraySub;
    L__M(##Miscellany, 38);
];

#ifdef ZDEBUG;
[ ZapSub;
    if (player in FakeApartment) {
        Desert.startup();
        PlayerTo(Desert);
    }
    else if (player in Desert) {
        player.weakness = 0;
        player.orders = EndSuffering;
        StopDaemon(figure);
        StopDaemon(desstereo);
        "[Endgame]";
    }
    else
        PlayerTo(FakeApartment);
];
[ ZapRescueSub;
    print "Rescuing (and killing) ", (name) noun, ".^";
    RescueContents(noun);
    remove noun;
];
[ ZapSandSub obj;
    objectloop (obj ofclass FloorSand) {
        BumpSand(obj);
        print "Bumped ", (name) obj, ".^";
    }
];
#endif;

Verb meta 'about' 'info' 'help' 'hint'
    * -> About;

#ifdef ZDEBUG;
Verb 'zap'
    * -> Zap
    * 'sand' -> ZapSand
    * 'rescue' noun -> ZapRescue;
Verb 'goals'
    * -> GoalList
    * number -> GoalList;
Verb 'opengoal'
    * scope=GoalsScope -> ZapOpenGoal;
Verb 'closegoal'
    * scope=GoalsScope -> ZapCloseGoal;
#endif;

Verb 'shake'
    * noun -> Wave;

Verb 'flush'
    * noun -> Empty;

Verb 'find'
    * noun -> Find;

Verb 'locate'
    * noun -> Find;

Verb 'where'
    * 'am' 'i//' -> FindMe
    * 'is'/'are' noun -> Find;

Extend 'look'
    * 'out' noun -> Search;

Extend 'look'
    * 'for' noun -> Find;

Extend 'search'
    * 'for' noun -> Find;

Extend 'fill'
    * noun 'with' noun -> Insert reverse
    * noun 'from' noun -> EmptyT reverse;

Extend only 'sit'
    * 'at' noun -> Enter;

Verb 'vacuum'
    * -> Vacuum;

Extend only 'clean' replace
    * -> Vacuum;

Extend only 'dust' replace
    * -> Vacuum;

Extend only 'sweep' replace
    * -> Vacuum;

Extend 'dig' replace
    * 'in' noun -> Dig
    * noun -> Dig;

Verb 'raise' 'lift'
    * noun -> Raise;

Verb 'lower'
    * noun -> Lower;

Verb 'water'
    * noun -> WaterAction;

Verb 'play'
    * noun -> Play;

Extend 'blow' replace
    * 'on'/'at' noun -> BlowOn;

Verb 'breathe'
    * 'on'/'at' noun -> BlowOn;

Verb 'chant' 'om'
    * -> Sing
    * 'om' -> Sing;

Extend 'sing' replace
    * -> Sing
    * 'om' -> Sing;

Extend 'read' replace
    * noun -> Examine;

[ OptionalString wd count;
    wd = NextWordStopped();
    while (wd ~= 'at' or 'on' or -1) {
        count++;
        wd = NextWordStopped();
    }
    if (count == 0)
        return GPR_FAIL;
    wn--;
    return 0;
];

Verb 'type'
    * -> TypeVague
    * 'on'/'at' noun -> TypeOn
    * OptionalString -> TypeVague
    * OptionalString 'on'/'at' noun -> TypeOn;

Verb 'pour' 'dump'
    * noun 'on'/'onto'/'in'/'into' noun -> EmptyT;