Switches v5;

Release  1;

Constant Story "A better mousetrap";

Constant Headline "^^A demo of WriteListFrom()^^
                    Shamelessly stolen from Robert M. Dickau's ~Listless~ and
                    Graham Nelson's ~List-Property~ (both on ~ftp.gmd.de~)^
                    Enter 'help' if you need information.^^";

Include "Parser";

Object  LibraryMessages "(LibraryMessages)"
   with before [;
#ifdef DEBUG;
            if ((self.number & 1)~=0) {
                if (sw__var==##Prompt) {
                    print "@/o^===>";
                    rtrue;
                }
                print "@>>@>>", sw__var;
                if (sw__var<4096) print " (", (DebugAction) sw__var, ")";
                print ", ", lm_n, "@<<@<< ";
            }
#endif;
            if (sw__var==##ListMiscellany && lm_n > 1000)
                return List__EnglishMessage( lm_n, lm_o );
            rfalse;
        ],
        number 0;

Replace WriteListFrom;
Replace WillRecurs;
Replace Locale;
Replace SearchSub;
Include "Verblib";
Include "Lister";
Include "Lister2";

! --- Grammatik -------------------------------------------
Include "Grammar";

[ StyleType i;
    if (scope_stage==1) rfalse;
    if (scope_stage==2) { objectloop(i in style_holder) PlaceInScope(i); rtrue; }
    "This is not a bit known to me.";
];

Verb    'help' 'hint' 'info'
        *                                               -> Help;

Extend  'set' first
        * scope=StyleType                               -> Set;

Verb   'unset'
        * scope=StyleType                               -> UnSet;

Extend 'clear' first
        * scope=StyleType                               -> UnSet;

Verb   'style' 'list'
        *                                               -> List;

Extend 'search' first
        *                                               -> SearchLoc;
Verb   'xx' = 'search';

ifdef DEBUG;
Verb 'msgtrace'
        *                                               -> MsgTraceOn
        * 'on'                                          -> MsgTraceOn
        * 'off'                                         -> MsgTraceOff;
Verb 'newlist'
        *                                               -> NewListOn
        * 'on'                                          -> NewListOn
        * 'off'                                         -> NewListOff;
Verb 'oldlist'
        *                                               -> NewListOff
        * 'on'                                          -> NewListOff
        * 'off'                                         -> NewListOn;
endif;


ifdef DEBUG;
[ MsgTraceOnSub;
        LibraryMessages.number = LibraryMessages.number | 1;
        "Now tracing library messages.";
];

[ MsgTraceOffSub;
        LibraryMessages.number = LibraryMessages.number & $FE;
        "Library message trace off.";
];

endif;

[ NewListOnSub;
        use_new_writelist = true;
        "Using new, experimental 'WriteListFrom()'.";
];

[ NewListOffSub;
        use_new_writelist = false;
        "Using old, dependable 'WriteListFrom()'.";
];

[ HelpSub;
        "You can use the verbs ~newList~ und ~oldList~ to switch
        between the new and the 'classic' WriteListFrom() routine.^
        The Verb ~search~ alias ~xx~ will show the content of any
        object (default: current location) in an user-defined style.
        Using ~set newline~, or ~unset newline~, you can set the
        individual style bits. ~Style~ will print the current
        settings.^";
];

Global list_style = 0;

[ SearchSub  o i x;
        if (location==thedark) return L__M(##Search,1,noun);
        o = child(noun);
        if (o==0)
            "There's nothing here for you to find.";
        print "You search ", (the) noun, " and find ";
        if (list_style & WORKFLAG_BIT ~= 0) {
            x = 0;
            objectloop(i in noun) {
                if (x & 1 ~= 0) give i workflag; else give i ~workflag;
                ++x;
            }
        }
        WriteListFrom(o, list_style, 0);
        if (list_style && ENGLISH_BIT ~= 0) print ".";
        print "^";
        rtrue;
];

[ SearchLocSub  o i x;
        if (location==thedark) return L__M(##Search,1,noun);
        o = child(location);
        if (o==0)
            "There's nothing here.";
        if (list_style & WORKFLAG_BIT ~= 0) {
            x = 0;
            objectloop(i in location) {
                if (x & 1 ~= 0) give i workflag; else give i ~workflag;
                ++x;
            }
        }
        print "You find ";
        WriteListFrom(o, list_style, 1);
        if (list_style && ENGLISH_BIT ~= 0) print ".";
        print "^";
        rtrue;
];

Class stylebit_class
 with name 'bit',
      number 0,
      declination false,
      before [;
        Set:
        if (list_style & self.number == 0)
           {list_style = list_style + self.number;
            print_ret (CDefArt) noun, " is now set.";}
          else print_ret (CDefArt) noun, " war already set.";

        UnSet:
        if (list_style & self.number ~= 0)
           {list_style = list_style - self.number;
            print_ret (CDefArt) noun, " ist no longer set.";}
          else print_ret (CDefArt) noun, " wasn't set."; ];

Object style_holder "Style holder";

Nearby q01 "newline_bit"   class stylebit_class, with name 'newline', number newline_bit;
Nearby q02 "indent_bit"    class stylebit_class, with name 'indent', number indent_bit;
Nearby q03 "fullinv_bit"   class stylebit_class, with name 'fullinv', number fullinv_bit;
Nearby q04 "english_bit"   class stylebit_class, with name 'english', number english_bit;
Nearby q05 "recurse_bit"   class stylebit_class, with name 'recurse', number recurse_bit;
Nearby q06 "always_bit"    class stylebit_class, with name 'always', number always_bit;
Nearby q07 "terse_bit"     class stylebit_class, with name 'terse', number terse_bit;
Nearby q08 "partinv_bit"   class stylebit_class, with name 'partinv', number partinv_bit;
Nearby q09 "defart_bit"    class stylebit_class, with name 'defart', number defart_bit;
Nearby q10 "isare_bit"     class stylebit_class, with name 'isare', number isare_bit;
Nearby q11 "conceal_bit"   class stylebit_class, with name 'conceal', number conceal_bit;
Nearby q12 "noarticle_bit" class stylebit_class, with name 'noarticle',number noarticle_bit;
Nearby q13 "workflag_bit"  class stylebit_class, with name 'workflag',number workflag_bit;

[ UnSetSub; "That's not a clearable bit."; ];

[ ListSub i x;
        objectloop(i in style_holder) {
            print (CDefArt) i;
            if (list_style & i.number == 0) print " isn't set.^";
            else print " is SET.^";
        }
        x = "Style = ";
        objectloop(i in style_holder &&
        (list_style & i.number)~=0 ) {
            print (string) x, (name) i;
            x = "+";
        }
        print "^";
];

! --------------------------------------------------------------------

[ Initialise;
        move Schluesselbund to player;
        move Purse to player;
        move Clothes to player; give Clothes worn;
        move Watch1 to player; give Watch1 worn;
        move Watch2 to player;
        location = Kitchen;
        list_style = TERSE_BIT + ENGLISH_BIT;

        NewListOnSub();

];

! -------------------------------------------------------------------

Object  Clothes "clothes",
    has pluralname clothing,
   with name 'clothes' 'clothing',
        description "Like, you're not naked.",
        before[;
            Disrobe: "Sorry, no Striptease.";
        ];

Class   Watch,
    has clothing,
   with name 'wristwatch' 'watch',
        plural "watches",
        description [;
            "It is now ",
                 LanguageTimeOfDay( the_time/60, the_time%60 ),
                 ".";
        ];

Watch     Watch1 "wristwatch"; ! worn
Watch     Watch2 "wristwatch"; ! not worn

Object  Workroom "Room",
    has light,
   with initial "You're in Andreas' room.^",
        description "The desk is almost buried under a mountain of
            paper.
            You can go west and south.",
        s_to Cell,
        w_to Kitchen;

Object  Cell "Cell", ! dark
   with description "A dark chamber, where you'll be locked up,
            if you don't finish the adventure you've
            been promising to write.",
        n_to Workroom,
        cant_go "You should plan for a long stay here.";

Object  Kitchen "Kitchen",
    has light,
   with description "A mini-Kitchen.",
        e_to Workroom;

Object  Cuffs "handcuffs" Cell,
    has clothing pluralname,
   with name 'pair' 'handcuffs';

Object  Desk "desk" Workroom,
    has static supporter,
   with name 'desk',
        initial "A desk takes up most of the space in this room.",
        lister_kind Desk__Lister,
        description "You examine the desk, and find decade-old
            papers, letters and diskettes.";

Lister  Desk__Lister "(Desk__Lister)",
    has transparent,
   with number 1025,
        GlueTexts ", as well as " ", plus " ", furthermore " ", even " ", and finally ",
        List__Glue[ i  t q x k;
            if (list_left <= 0) rfalse;
!!          print "[", i;
            i = i-1;
            t = i+list_left;
            q = self.#GlueTexts / 2;
            if (q>=t) {
                x=0;
                k=i;
            } else {
                k = (2*q*i + t - 1) / (2*t);
                x = (t * (2*k + 1)) / (2*q);
                if (x>t) x=t;
                x = x-i;
            }
!!          print " -> ", t, ",", q, ", ", k, ",", x, "]";
            if (x==1) print (string) AND__TX;
            else if (x==0) print (string) self.&GlueTexts --> k;
            else print ", ";
        ];

Object  Papers "papers" Desk,
   has  pluralname,
  with  name 'paper' 'papers',
        description "Old envelopes, junk mail, notes and sketches.";

Lister  Demo__Lister "(Demo__Lister)",
    has transparent,
   with number 1025,
        List__MiscMessage[ id x1;
            switch (id) {
                1025:
                        print ", almost hidden under ";
                1026:
                        rfalse;
                default:
                    return L__M( ##ListMiscellany, id, x1 );
            }
        ];

Object  WritingPad "writing pad" Desk,
    has supporter,
   with name 'writing' 'pad',
        lister_kind Demo__Lister;

Object  Envelope "envelope" WritingPad,
    has openable container,  ! empty
   with name 'envelope' 'letter';

Object  Pen "pen" WritingPad,
   with name 'pen';

Object  Vase "flower vase" Desk,
    has container open transparent,
   with name 'vase';

Object  Flowers "bouquet of wildflowers" Vase,
   with name 'wildflowers' 'flowers';

Object  Pencil "pencil" Desk,
   with name 'pencil' 'lead';

Object  Bookshelf "bookshelf" Workroom,
    has static supporter,
   with name 'bookshelf' 'shelf' 'bookshelves' 'shelves',
        initial "A bookshelf is mounted on the wall.",
        description "Besides Andreas' favorit books, it contains
            a lot of junk.";

Class   Laterne,
    has female switchable,
   with name 'lantern' 'lanterns//p' 'lamp' 'lamps//p',
        plural "Lanterns",
        description "That esstial item of adventure games, the battery-driven lantern.",
        list_together Laterne,
        after [;
            SwitchOn:
                give self light;
                print "You turn on ", (the) self, " and it lights up.";
                rtrue;
            SwitchOff:
                give self ~light;
                rfalse;
        ];

Laterne Lampe1 "Lantern" Bookshelf;
Laterne Lampe2 "Lantern" Bookshelf
    has light on;
Laterne Lampe3 "Lantern" Bookshelf;


Class   Tools
   with list_together Tools;

Tools   File "file" Kitchen,
   with name 'file',
        description "A file (did you want to bake it into a cake?)";

Tools   Pliers "pliers" Bookshelf,
    has pluralname,
   with name 'pliers';

Tools   Hammer "hammer" Desk,
   with name 'hammer';

Tools   Screwdriver "screwdriver" Workroom,
   with name 'screwdriver' 'driver',
        description "Not the liquid kind.";

Object  Schluesselbund "keyring"
   with name 'keyring' 'ring' 'keychain',
        description "Your keyring.",
    has transparent container;

Object  Schluessel_Eingang "door key" Schluesselbund
   with name 'door' 'key',
        description "The key to your flat.";
Object  Schluessel_Wein "wine cellar key" Schluesselbund,
   with name 'wine' 'cellar' 'key';
Object  Schluessel_Brief "bicycle key" Schluesselbund,
   with name 'bicycle' 'key';

Class   Bonbon
   with name 'bonbon' 'bonbons//p',
        list_together [;
            if (inventory_stage ~= 1) rfalse;
             c_style = (c_style | ENGLISH_BIT)
                     & (-1 - NEWLINE_BIT - INDENT_BIT);
        ],
        short_name [;
            print (string) self.basis;
            if (listing_together==0
            || (~~ listing_together ofclass Bonbon)
            || list_left==0 ) {
                print " bonbon";
            }
            rtrue;
        ],
        plural [;
            print (string) self.basis;
            if (listing_together==0
            || (~~ listing_together ofclass Bonbon)
            || list_left==0 ) {
                print " bonbons";
            }
            rtrue;
        ];

Bonbon  Bo1 "peppermint bonbon" Kitchen
   with name 'peppermint' 'mint',
        basis "peppermint";

Bonbon  Bo2 "peppermint bonbon" Kitchen
   with name 'peppermint' 'mint',
        basis "peppermint";

Bonbon  Bo3 "cassis bonbon" Kitchen
   with name 'cassis',
        basis "cassis";

Bonbon  Bo4 "strawberry bonbon" Kitchen
   with name 'strawberry',
        basis "strawberry";

Class   Easter_Egg,
    has neuter,
   with name 'egg' 'easter' 'eggs//p',
        list_together "easter eggs",
        farbe "white",
        short_name [;
            print (string) self.farbe;
            if (listing_together==0 || (~~ listing_together ofclass Easter_Egg) ) {
                print " egg";
            } else if (list_left==0 || c_style & NEWLINE_BIT ~= 0) {
                print " one";
            }
            rtrue;
        ],
        plural [;
            print (string) self.farbe;
            if (listing_together==0 || (~~ listing_together ofclass Easter_Egg) ) {
                print " eggs";
            } else if (list_left==0 || c_style & NEWLINE_BIT ~= 0) {
                print " ones";
            }
            rtrue;
        ],
        description
            "Just a simple cooked egg.";

Easter_Egg EI1 "easter egg" Workroom;
Easter_Egg EI2 "easter egg" Kitchen;
Easter_Egg EI3 "easter egg" Kitchen;

Easter_Egg EI4 "green egg" Desk,
   with name 'green',
        farbe "green",
        description "An egg, dyed fluorescent green.";

Easter_Egg EI5 "red egg" Workroom,
   with name 'red',
        farbe "red",
        description "A red-coloured egg.";

Class   Coin,
   with name 'coin',
        List_together "coins";

Class   GoldCoin class Coin,
   with name 'gold' 'golden',
        plural "gold dollars";

Class   SilverCoin class Coin,
   with name 'silver',
        plural "silver dollars";

Class   CopperCoin class Coin,
   with name 'copper',
        plural "copper coins";

Object  Purse "purse"
    has male container openable,
   with name 'purse' 'bag' 'portemonnaie';

GoldCoin   MG1 "gold dollar"   Purse;
GoldCoin   MG2 "gold dollar"   Purse;
SilverCoin MS1 "silver dollar" Purse;
SilverCoin MS2 "silver dollar" WritingPad;
SilverCoin MS3 "silver dollar" Bookshelf;
SilverCoin MS4 "silver dollar" Bookshelf;
SilverCoin MS5 "silver dollar" Cell;
CopperCoin MK1 "copper coin"   Purse;
CopperCoin MK2 "copper coin"   Purse;
CopperCoin MK3 "copper coin"   Purse;
CopperCoin MK4 "copper coin"   Purse;
CopperCoin MK5 "copper coin"   Purse;
CopperCoin MK6 "copper coin"   Purse;
CopperCoin MK7 "copper coin"   Purse;
CopperCoin MK8 "copper coin"   Purse;
CopperCoin MK9 "copper coin"   Workroom;

end;