Constant Story "52";
Constant Headline "^An Interactive Example
                  ^by Anson Turner 1997. Copyright relinquished.^";

Release 3;
Serial "971119";

Constant DEBUG;
Constant DIALECT_US;

Array card_flags --> 4;
Array suit_count -> 4;
Array bit_values --> $$0000000000000001
                    $$0000000000000010
                    $$0000000000000100
                    $$0000000000001000
                    $$0000000000010000
                    $$0000000000100000
                    $$0000000001000000
                    $$0000000010000000
                    $$0000000100000000
                    $$0000001000000000
                    $$0000010000000000
                    $$0000100000000000
                    $$0001000000000000;

Include "Parser";
Include "Verblib";

! ===========================================================================

Object cube "Featureless White Cube",
  has light,
 with description
         "You are inside a featureless white cube.";


! ===========================================================================
! DECK OF CARDS
! ===========================================================================

[ SuitNumMatch a     st c;

 for (st = 0:st <= 3:st++)
 {  if (card_flags-->st == card_flags-->(a - Club)) c++;
 }
 return c;
];

[ CardList cn     x c c2 tc st ns d ms ms2 csc nsp nsets;

 for (st = Club:st <= Spade:st++)
 {  c = st - Club; card_flags-->c = 0; suit_count->c = 0;
    objectloop(x ofclass st && x in cn)
    {  tc++; (suit_count->c)++;
       if (card_flags-->c == 0) nsp++;
       card_flags-->c = card_flags-->c | bit_values-->(x.number-2);
    }
    if (suit_count->c == 0) continue;
    nsets++;
    for (c2 = 0:c2 < c:c2++)
       if (card_flags-->c2 == card_flags-->c) { nsets--; break; }
 }
 print (LanguageNumber) tc," cards (";

 if (tc == 52) { print "a full deck)"; rtrue; }

 for (st = 0:st < 4: st++)
 {  csc = suit_count -> st; if (csc == 0) continue;
    ms = SuitNumMatch(st+Club);
    if (ns)
    {  if (nsets > 2) print ", "; else print " ";
       if (ns + ms == nsp) print "and ";
    }
    ns = ns + ms; c2 = 0;
    if (csc == 13)
       print "all of the ";
    else
    {  if (card_flags-->st      == $$0111000000000)
          print "the faces ";
       else if (card_flags-->st == $$1111000000000)
       {  print "the faces and ace"; if (ms > 1) print "s"; print " "; }
       else if (card_flags-->st == $$0000111111111)
          print "the numbers ";
       else if (card_flags-->st == $$1000111111111)
       {  print "the numbers and ace"; if (ms > 1) print "s"; print " ";}
       else if (card_flags-->st == $$0111111111111)
       {  print "all but the ace"; if (ms > 1) print "s"; print " ";}
       else
       {  print "the ";
          for (c = 2:c < 15:c++)
          {  if ((card_flags-->st & bit_values-->(c-2))==0) continue;
             if (c < 11 && csc > 2) { print c; if (ms > 1) print "'"; }
             else print (facename) c;
             if (ms > 1) { if (c == 6 && csc <= 2) print "e"; print "s"; }
             c2++;
             if (c2 < csc && csc > 2) print ",";
             if (c2 == csc-1) print " and";
             print " ";
          }
       }
       print "of ";
    }

    if (ms == 4) { print "every suit"; break; }
    ms2 = 0;
    for (d = st:d < 4:d++)
       if (card_flags-->d == card_flags-->st)
       {  print (suitname) d + Club; ms2++;
          suit_count->d = 0;
          if (ms2 < ms && ms > 2) print ",";
          if (ms2 == ms-1) print " and";
          if (ms2 < ms) print " ";
       }
 }
 print ")";
];

[ facename n;

 switch(n)
 {  2 to 10: print (LanguageNumber) n;
    11: print "jack";
    12: print "queen";
    13: print "king";
    14: print "ace";
 }
];

[ suitname cl;

 switch(cl)
 {  Club:    print "clubs";
    Diamond: print "diamonds";
    Heart:   print "hearts";
    Spade:   print "spades";
 }
];

Class Card
with name 'card' 'of' 'cards//p', article "the",
     description [;
        print "The front of the card has ";
        switch(self.number)
        {  2 to 10: print (LanguageNumber) self.number," little";
           11 to 13: print "the ",(facename) self.number," of";
           14: print "one";
               switch(self.suit)
               {  Club   : " club.";
                  Diamond: " diamond.";
                  Heart  : " heart.";
                  Spade  : " spade.";
               }
        }
        " ",(suitname) self.suit,
        ". The back shows dancing elves and cherubim.";
     ],
     list_together [; return CardList(parent(self)); ],
     parse_name [;
        if (parser_action==##TheSame) return -2;
        return -1;
     ],
     short_name [;
       print (facename) self.number," of ",(suitname) self.suit;
       rtrue;
     ];

Class Club, class Card, with name 'clubs//p' 'club', suit Club;
Class Diamond, class Card, with name 'diamonds//p' 'diamond', suit Diamond;
Class Heart, class Card, with name 'hearts//p' 'heart', suit Heart;
Class Spade, class Card, with name 'spades//p' 'spade', suit Spade;

Object card_box "small box" cube
  has openable container,
 with name 'box' 'small' 'cardboard' 'little',
      before [;
         Receive:
            if (self hasnt open) rfalse;
            if (~~(noun ofclass Card))
            {  give self ~open;
               "The box snaps shut as you attempt this.";
            }
      ],
      description [;
         print "It's a small cardboard box, adorned with fine artwork: cherubim
           on one side, elves on the reverse. The box is ";
         if (self has open) "open."; else "closed.";
      ];

Club, with name 'ac' '1c' 'a//' '1//' 'ace' 'one' 'a^s//p' '1^s//p' 'aces//p'
               'ones//p', number 14;
Club, with name '2c' '2//' 'two' 'deuce' 'number' '2^s//p' 'twos//p' 'deuces//p'
               'numbers//p', number 2;
Club, with name '3c' '3//' 'three' 'number' '3^s//p' 'threes//p' 'numbers//p', number 3;
Club, with name '4c' '4//' 'four' 'number' '4^s//p' 'fours//p' 'numbers//p', number 4;
Club, with name '5c' '5//' 'five' 'number' '5^s//p' 'fives//p' 'numbers//p', number 5;
Club, with name '6c' '6//' 'six' 'number' '6^s//p' 'sixes//p' 'numbers//p', number 6;
Club, with name '7c' '7//' 'seven' 'number' '7^s//p' 'sevens//p' 'numbers//p', number 7;
Club, with name '8c' '8//' 'eight' 'number' '8^s//p' 'eights//p' 'numbers//p', number 8;
Club, with name '9c' '9//' 'nine' 'number' '9^s//p' 'nines//p' 'numbers//p', number 9;
Club, with name '10c' '10' 'ten' 'number' '10^s//p' 'tens//p' 'numbers//p', number 10;
Club, with name 'jc' 'j//' 'jack' 'face' 'j^s//p' 'jacks//p' 'faces//p', number 11;
Club, with name 'qc' 'q//' 'queen' 'face' 'q^s//p' 'queens//p' 'faces//p', number 12;
Club, with name 'kc' 'k//' 'king' 'face' 'k^s//p' 'kings//p' 'faces//p', number 13;

Diamond, with name 'ad' '1d' 'a//' 'ace' 'one' 'a^s//p' '1^s//p' 'aces//p'
               'ones//p', number 14;
Diamond, with name '2d' '2//' 'two' 'deuce' 'number' '2^s//p' 'twos//p' 'deuces//p'
                  'numbers//p', number 2;
Diamond, with name '3d' '3//' 'three' 'number' '3^s//p' 'threes//p' 'numbers//p', number 3;
Diamond, with name '4d' '4//' 'four' 'number' '4^s//p' 'fours//p' 'numbers//p', number 4;
Diamond, with name '5d' '5//' 'five' 'number' '5^s//p' 'fives//p' 'numbers//p', number 5;
Diamond, with name '6d' '6//' 'six' 'number' '6^s//p' 'sixes//p' 'numbers//p', number 6;
Diamond, with name '7d' '7//' 'seven' 'number' '7^s//p' 'sevens//p' 'numbers//p', number 7;
Diamond, with name '8d' '8//' 'eight' 'number' '8^s//p' 'eights//p' 'numbers//p', number 8;
Diamond, with name '9d' '9//' 'nine' 'number' '9^s//p' 'nines//p' 'numbers//p', number 9;
Diamond, with name '10d' '10' 'ten' 'number' '10^s//p' 'tens//p' 'numbers//p', number 10;
Diamond, with name 'jd' 'j//' 'jack' 'face' 'j^s//p' 'jacks//p' 'faces//p', number 11;
Diamond, with name 'qd' 'q//' 'queen' 'face' 'q^s//p' 'queens//p' 'faces//p', number 12;
Diamond, with name 'kd' 'k//' 'king' 'face' 'k^s//p' 'kings//p' 'faces//p', number 13;

Heart, with name 'ah' '1h' 'a//' 'ace' 'one' 'a^s//p' '1^s//p' 'aces//p'
               'ones//p', number 14,
           after [; Take: "Have a heart. (Taken.)"; ];
Heart, with name '2h' '2//' 'two' 'deuce' 'number' '2^s//p' 'twos//p' 'deuces//p'
                'numbers//p', number 2;
Heart, with name '3h' '3//' 'three' 'number' '3^s//p' 'threes//p' 'numbers//p', number 3;
Heart, with name '4h' '4//' 'four' 'number' '4^s//p' 'fours//p' 'numbers//p', number 4;
Heart, with name '5h' '5//' 'five' 'number' '5^s//p' 'fives//p' 'numbers//p', number 5;
Heart, with name '6h' '6//' 'six' 'number' '6^s//p' 'sixes//p' 'numbers//p', number 6;
Heart, with name '7h' '7//' 'seven' 'number' '7^s//p' 'sevens//p' 'numbers//p', number 7;
Heart, with name '8h' '8//' 'eight' 'number' '8^s//p' 'eights//p' 'numbers//p', number 8;
Heart, with name '9h' '9//' 'nine' 'number' '9^s//p' 'nines//p' 'numbers//p', number 9;
Heart, with name '10h' '10' 'ten' 'number' '10^s//p' 'tens//p' 'numbers//p', number 10;
Heart, with name 'jh' 'j//' 'jack' 'face' 'j^s//p' 'jacks//p' 'faces//p', number 11;
Heart, with name 'qh' 'q//' 'queen' 'face' 'q^s//p' 'queens//p' 'faces//p', number 12;
Heart, with name 'kh' 'k//' 'king' 'face' 'k^s//p' 'kings//p' 'faces//p', number 13;

Spade, with name 'as' '1s' 'a//' 'ace' 'one' 'a^s//p' '1^s//p' 'aces//p'
               'ones//p', number 14;
Spade, with name '2s' '2//' 'two' 'deuce' 'number' '2^s//p' 'twos//p' 'deuces//p'
                'numbers//p', number 2;
Spade, with name '3s' '3//' 'three' 'number' '3^s//p' 'threes//p' 'numbers//p', number 3;
Spade, with name '4s' '4//' 'four' 'number' '4^s//p' 'fours//p' 'numbers//p', number 4;
Spade, with name '5s' '5//' 'five' 'number' '5^s//p' 'fives//p' 'numbers//p', number 5;
Spade, with name '6s' '6//' 'six' 'number' '6^s//p' 'sixes//p' 'numbers//p', number 6;
Spade, with name '7s' '7//' 'seven' 'number' '7^s//p' 'sevens//p' 'numbers//p', number 7;
Spade, with name '8s' '8//' 'eight' 'number' '8^s//p' 'eights//p' 'numbers//p', number 8;
Spade, with name '9s' '9//' 'nine' 'number' '9^s//p' 'nines//p' 'numbers//p', number 9;
Spade, with name '10s' '10' 'ten' 'number' '10^s//p' 'tens//p' 'numbers//p', number 10;
Spade, with name 'js' 'j//' 'jack' 'face' 'j^s//p' 'jacks//p' 'faces//p', number 11;
Spade, with name 'qs' 'q//' 'queen' 'face' 'q^s//p' 'queens//p' 'faces//p', number 12;
Spade, with name 'ks' 'k//' 'king' 'face' 'k^s//p' 'kings//p' 'faces//p', number 13;

! ===========================================================================



! ===========================================================================

[ Initialise     x;

 location = cube;
 inventory_style = FULLINV_BIT + ENGLISH_BIT + RECURSE_BIT;
 objectloop(x ofclass Card) move x to card_box;
 "^^^^^^^";
];


Include "Grammar";

End;

You are viewing proxied material from mercury.661.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.