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;