1: 
   2: logic
   3: {
   4:   array deck
   5:   { 
   6:         1, 2, 3, 4, 5, 6, 7, 8, 9,
   7:     10,11,12,13,14,15,16,17,18,19,
   8:     20,21,22,23,24,25,26,27,28,29,
   9:     30,31,32,33,34,35,36,37,38,39,
  10:     40,41,42,43,44,45,46,47,48,49,
  11:     50,51,52
  12:   }
  13:   int cards_in_deck { 52 }  
  14:   int _save_slot { 0 }
  15:   
  16:   array waste
  17:   { 
  18:         1, 2, 3, 4, 5, 6, 7, 8, 9,
  19:     10,11,12,13,14,15,16,17,18,19,
  20:     20,21,22,23,24,25,26,27,28,29,
  21:     30,31,32,33,34,35,36,37,38,39,
  22:     40,41,42,43,44,45,46,47,48,49,
  23:     50,51,52
  24:   }  
  25:   int cards_in_waste { 0 }
  26:     
  27:   /* we only need to know what the top card in each foundation is */    
  28:   array foundation { 0, 0, 0, 0 }
  29:   int number_of_foundations { 4 }
  30:   
  31:   /*
  32:    * The longest tableau column starts with 7 face-down cards.
  33:    * One is turned face-up by the player; then at worst
  34:    * we can move an entire suit - 12 more cards - onto it.
  35:    * Therefore, the maximum length of a column is 18 cards.
  36:    */
  37:   int tableau_column_length { 18 }
  38:   int number_of_columns { 6 }
  39:   int cards_to_flip { 3 }
  40:   
  41:   array tableau { 
  42:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  43:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  44:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  45:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  46:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  47:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  48:     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  49:   }
  50:   
  51:   array tableau_length { 0, 0, 0, 0, 0, 0, 0 }
  52: 
  53:   int scratch { 0 }
  54:   int scratch2 { 0 }
  55:   int last_dealt { 0 }  
  56:   int started { 0 }
  57:   int selected { -1 }
  58:   int selected_row { 0 }
  59:   int selected_column { 0 }  
  60:   
  61:   // The player starts the game by dealing from the deck to the tableau
  62:   when { started == 0 }
  63:   allow
  64:   {
  65:     // shuffle the deck
  66:     for card ( 1..cards_in_deck )
  67:     {
  68:       scratch = random[card]; 
  69:       last_dealt = deck[scratch];
  70:       deck[scratch] = deck[card-1];
  71:       deck[card-1] = last_dealt;
  72:     }
  73:     
  74:     // deal out the tableau
  75:     for column ( 0..number_of_columns )
  76:     {
  77:       for row ( 0..column )
  78:       {
  79:         /* deal a card */ 
  80:         cards_in_deck--; 
  81:         last_dealt = deck[cards_in_deck];
  82:         
  83:         /* place the dealt card in tableau, face down */
  84:         tableau[ (column * tableau_column_length) + row ] = 0 - last_dealt;
  85:         tableau_length[ column ]++;
  86:       }
  87:     }    
  88:     started = 1;
  89:   } label { "start game" }
  90: 
  91:   // Any time after the start of the game, if there are enough cards in the deck
  92:   // the player may flip them
  93:   when { (started == 1) and (cards_in_deck > 0) }
  94:   allow
  95:   {
  96:     scratch = cards_to_flip;
  97:     if( cards_in_deck < scratch )
  98:     {
  99:       scratch = cards_in_deck;
 100:     }
 101:     
 102:     for i ( 1..scratch )
 103:     {
 104:         /* deal a card */ 
 105:         cards_in_deck--; 
 106:         last_dealt = deck[cards_in_deck];
 107:         
 108:         /* add the dealt card to the waste */
 109:         waste[ cards_in_waste ] = last_dealt;        
 110:         cards_in_waste++;
 111:     }
 112:   } label { "flip" }
 113: 
 114:   // On the other hand, if there are no cards left at all,
 115:   // we always have the option of adding the waste back to the deck
 116:   when { (started == 1) and (cards_in_deck == 0) }
 117:   allow
 118:   { 
 119:     for i ( 1..cards_in_waste )
 120:     {
 121:         deck[i-1] = waste[cards_in_waste - i];
 122:     }
 123:     cards_in_deck = cards_in_waste;
 124:     cards_in_waste = 0;
 125:   } label { "flip" }
 126:   
 127:   // Any time after the start of the game
 128:   // any face-down card at the bottom of its column may be turned face-up
 129:   for column ( 0..number_of_columns )
 130:   {
 131:     for row ( 0..tableau_length[column] )
 132:     {
 133:       when 
 134:       { 
 135:         (started == 1) 
 136:         and (row == (tableau_length[column] - 1))
 137:         and (tableau[ (column * tableau_column_length) + row ] < 0)
 138:       }
 139:       allow
 140:       {
 141:         tableau[ (column * tableau_column_length) + row ] = 
 142:             0 - tableau[ (column * tableau_column_length) + row ];
 143:       }
 144:       label { "Turn face-up " ( (column * tableau_column_length) + row ) }
 145:     }
 146:   }
 147:   
 148:   // Any time after the start of the game that no cards are selected,
 149:   // any face-up card in the tableau is potentially a candidate for selection
 150:   for column ( 0..number_of_columns )
 151:   {
 152:     for row ( 0..tableau_length[column] )
 153:     {
 154:       when 
 155:       { 
 156:         (
 157:           ((selected == -1) and (row < tableau_length[column]))
 158:           and (tableau[ (column * tableau_column_length) + row ] > 0)
 159:         )
 160:         and (started == 1)
 161:       }
 162:       allow
 163:       {
 164:         selected = ((column * tableau_column_length) + row);
 165:         selected_row = row;
 166:         selected_column = column;
 167: 
 168:         // actually, the card can only be selected if it and all cards below it are
 169:         // in sequence down by alternate colour          
 170:         for i ( 1..( tableau_length[column]- ( row+1 ) ) )
 171:         {
 172:            if
 173:            (
 174:               (
 175:                 (((tableau[ selected + i]-1) / 26) ^
 176:                 ((tableau[ selected ]-1) / 26))
 177:                 != ( i & 1 )
 178:               )
 179:               or
 180:               (
 181:                ( ((tableau[ selected ]-1) % 13) -
 182:                ((tableau[ selected + i ]-1) % 13))
 183:                != i
 184:               )
 185:             )
 186:             {
 187:               selected = -1; // wasn't supposed to do that after all
 188:             }
 189:         }
 190:       }
 191:       label { "Select "  ((column * tableau_column_length) + row) }
 192:     }
 193:       
 194:     // Whenever there is a selected card, and it can legally be moved on top of
 195:     // another card in the tableau, allow the user to do so
 196:     when 
 197:     { 
 198:       ((selected > -1) and (tableau_length[column] > 0)) // special rule below will catch king moves
 199:       and 
 200:       (
 201:         (
 202:           (
 203:             (((tableau[selected]-1) / 26) != 
 204:               ((tableau[ (column * tableau_column_length) + (tableau_length[column]-1) ]-1) / 26))
 205:           )
 206:         )
 207:         and
 208:         (
 209:           (((tableau[selected]-1) % 13) == 
 210:             (((tableau[ (column * tableau_column_length) + (tableau_length[column]-1) ]-1) % 13)-1))
 211:         )
 212:       )
 213:     }
 214: 
 215:     allow
 216:     {
 217:       // This language needs local variables, functions, postincrement..
 218:       scratch = (column * tableau_column_length) + tableau_length[column];
 219:       scratch2 = selected;
 220: 
 221:       for i 
 222:         ( selected_row .. (tableau_length[selected_column]-1) )
 223:       {
 224:         tableau[ scratch ] = tableau[ scratch2 ];
 225:         tableau[ scratch2 ] = 0;
 226:         scratch++;
 227:         scratch2++;
 228:       }
 229: 
 230:       tableau_length[column] += (scratch2 - selected);
 231:       tableau_length[selected_column] -= (scratch2 - selected);
 232: 
 233:       selected = -1;
 234:     }
 235:     label { "Move "  ((column * tableau_column_length) + (tableau_length[column])) }
 236: 
 237:     // Also check the top card in the waste
 238:     when 
 239:     { 
 240:       (selected == -2)
 241:       and 
 242:       (
 243:         (
 244:           (
 245:             ( tableau_length[column] > 0 )
 246:             and
 247:             (
 248:               (
 249:                 (((waste[cards_in_waste-1]-1) / 26) != 
 250:                   ((tableau[ (column * tableau_column_length) + (tableau_length[column]-1) ]-1) / 26))
 251:               )
 252:               and
 253:               (
 254:                 (((waste[cards_in_waste-1]-1) % 13) == 
 255:                   (((tableau[ (column * tableau_column_length) + (tableau_length[column]-1) ]-1) % 13)-1))
 256:               )
 257:             )
 258:           )
 259:         )
 260:         or
 261:         (
 262:           (((waste[cards_in_waste-1]-1) % 13) == 12)
 263:           and
 264:           ( tableau_length[column] == 0 )
 265:         )
 266:       )
 267:     }
 268:     allow
 269:     {
 270:       scratch = (column * tableau_column_length) + tableau_length[column];
 271:       cards_in_waste--;
 272:       tableau[ scratch ] = waste[cards_in_waste];      
 273:       tableau_length[column]++;
 274:       selected = -1;
 275:     }
 276:     label { "Move "  ((column * tableau_column_length) + (tableau_length[column])) }
 277:     
 278:     // If selected card is a king, and there is an empty row, it can move there.
 279:     when 
 280:     { 
 281:       (( selected > -1 ) and ( ((tableau[ selected ]-1)%13) == 12 ))
 282:       and 
 283:       ( tableau_length[column] == 0 )
 284:     }
 285:     allow
 286:     {
 287:       // This language needs local variables, functions, postincrement..
 288:       scratch = (column * tableau_column_length) + tableau_length[column];
 289:       scratch2 = selected;
 290: 
 291:       for i 
 292:         ( selected_row .. (tableau_length[selected_column]-1) )
 293:       {
 294:         tableau[ scratch ] = tableau[ scratch2 ];
 295:         tableau[ scratch2 ] = 0;
 296:         scratch++;
 297:         scratch2++;
 298:       }
 299: 
 300:       tableau_length[column] += (scratch2 - selected);
 301:       tableau_length[selected_column] -= (scratch2 - selected);
 302: 
 303:       selected = -1;
 304:     }
 305:     label { "Move "  ((column * tableau_column_length) + (tableau_length[column])) }  
 306:   }
 307:   
 308:   // If selected card is the last card in the row, or in the waste,
 309:   // see if we can move it to a foundation      
 310:   for f ( 0..(number_of_foundations-1))
 311:   {
 312:     when 
 313:     { 
 314:       (
 315:         (( selected > -1 ) 
 316:           and (selected_row == (tableau_length[selected_column]-1)))
 317:         and
 318:         ( 
 319:           (  (foundation[f] == 0) and (((tableau[ selected ]-1)%13) == 0)  )
 320:           or
 321:           (
 322:             (((foundation[f]-1) / 13) == ((tableau[ selected ]-1)/ 13))
 323:             and (((foundation[f]-1)%13) == (((tableau[ selected ]-1)%13) - 1 ))
 324:           )
 325:         )
 326:       )
 327:       or
 328:       (
 329:         ( selected == -2 ) 
 330:         and 
 331:         (
 332:           (  (foundation[f] == 0) and (((waste[cards_in_waste-1]-1)%13) == 0)  )
 333:           or
 334:           (
 335:             (((foundation[f]-1) / 13) == ((waste[cards_in_waste-1]-1)/ 13))
 336:             and (((foundation[f]-1)%13) == (((waste[cards_in_waste-1]-1)%13) - 1 ))
 337:           )
 338:         )
 339:       )
 340:     }
 341:     allow
 342:     {
 343:       if( selected != -2 )
 344:       {
 345:         tableau_length[selected_column] = tableau_length[selected_column] - 1;
 346:         foundation[f] = tableau[ selected ];
 347:         tableau[ selected ] = 0;
 348:       }
 349:       if( selected == -2 )
 350:       {
 351:         cards_in_waste--;
 352:         foundation[f] = waste[cards_in_waste];
 353:       }
 354:       selected = -1;
 355:     }
 356:     label { "Foundation " f }
 357:   }
 358:   
 359:   // the top card in the waste can be selected
 360:   when { (selected == -1) and (cards_in_waste > 0) }
 361:   allow { selected = -2; }
 362:   label { "Select waste" }
 363: 
 364:   // ..and deselected
 365:   when { selected == -2 }
 366:   allow { selected = -1; }
 367:   label { "Unselect waste" }
 368:   
 369:   // todo: if there's not enough cards in the deck to flip, 
 370:   // allow the waste to be reshuffled into the deck
 371:     
 372:   // selected cards can be unselected at any time
 373:   when { selected != -1 } allow { selected = -1; } label { "Unselect " selected }
 374: }
 375: 
 376: 
 377: display
 378: {
 379:   stringtable card
 380:   {
 381:     "&nbsp;",
 382:     "A&diams;","2&diams;","3&diams;","4&diams;","5&diams;","6&diams;","7&diams;","8&diams;","9&diams;","10&diams;","J&diams;","Q&diams;","K&diams;",
 383:     "A&hearts;","2&hearts;","3&hearts;","4&hearts;","5&hearts;","6&hearts;","7&hearts;","8&hearts;","9&hearts;","10&hearts;","J&hearts;","Q&hearts;","K&hearts;",
 384:     "A&clubs;","2&clubs;","3&clubs;","4&clubs;","5&clubs;","6&clubs;","7&clubs;","8&clubs;","9&clubs;","10&clubs;","J&clubs;","Q&clubs;","K&clubs;",
 385:     "A&spades;","2&spades;","3&spades;","4&spades;","5&spades;","6&spades;","7&spades;","8&spades;","9&spades;","10&spades;","J&spades;","Q&spades;","K&spades;"
 386:   }
 387: 
 388:   box
 389:   {
 390:     content { "Klondike patience" }
 391:   }
 392: 
 393:   newline
 394: 
 395:   box
 396:   {
 397:     if( started == 0 )
 398:     {
 399:       bind_action { "start game" }
 400:       while_active 
 401:       {
 402:         width { 2em }
 403:         height { 2em }
 404:         border { 1px solid black }
 405:         content { "Start game" }
 406:       }
 407:     }
 408:   }
 409:   
 410:   box
 411:   {
 412:     if( started == 1 )
 413:     {
 414:       width { 8em }
 415:       height { 2em }
 416:       content { "&nbsp;" }
 417:       bind_action { "flip" }
 418:       
 419:       if( cards_in_deck > 0 )
 420:       {
 421:         content { "## (" cards_in_deck ")"  }
 422:       }
 423:       border { 1px solid black }
 424:     }
 425:   }
 426: 
 427:   box
 428:   {
 429:     if( started == 1 )
 430:     {
 431:       width { 8em }
 432:       height { 2em }
 433:       content { "&nbsp;" }
 434:       
 435:       if( selected == -2 )
 436:       {
 437:         border { 1px solid blue }
 438:       }
 439:       
 440:       if( selected != -2 )
 441:       {
 442:         border { 1px solid black }
 443:       }
 444:       
 445:       bind_action { "Select waste" }
 446:       bind_action { "Unselect waste" }
 447:       
 448:       if( cards_in_waste > 0 )
 449:       {
 450:         content { card[ waste[ cards_in_waste - 1 ]] " (" cards_in_waste ")"  }
 451:         if( ((waste[ cards_in_waste - 1 ]-1) /26) == 0 )
 452:         {
 453:           background{ #fbb }
 454:         }
 455:       }
 456:     }
 457:   }
 458: 
 459:   newline
 460: 
 461:   for row ( 0..(tableau_column_length-1) )
 462:   {
 463:     for column ( 0..number_of_columns )
 464:     {
 465:       box
 466:       {
 467:         width { 2em }
 468:         height { 2em }
 469:         if( tableau[ (column * tableau_column_length) + row ] < 0 )
 470:         {
 471:           content { "##" }
 472:           border { 1px solid black }
 473:           bind_action { "Turn face-up " ( (column * tableau_column_length) + row ) }
 474:         }
 475:         if( tableau[ (column * tableau_column_length) + row ] == 0 )
 476:         {
 477:           content { "&nbsp;" } // otherwise the table cell disappears :(
 478:           border { 1px solid white } // assume a white background
 479:           bind_action { "Move "  ((column * tableau_column_length) + row) }
 480:           while_active { background { #7fd } }
 481:         }
 482:         if( tableau[ (column * tableau_column_length) + row ] > 0 )
 483:         {
 484:           content { card[ tableau[ (column * tableau_column_length) + row ] ] }
 485:           if( selected == ((column * tableau_column_length) + row) )
 486:           {
 487:             border { 1px solid blue }
 488:           }
 489:           if( selected != ((column * tableau_column_length) + row) )
 490:           {
 491:             border { 1px solid black }
 492:           }
 493:           if( ((tableau[ (column * tableau_column_length) + row ]-1) /26) == 0 )
 494:           {
 495:             background{ #fbb }
 496:           }
 497:           bind_action { "Select "  ((column * tableau_column_length) + row) }
 498:           bind_action { "Unselect "  ((column * tableau_column_length) + row) }
 499:         }                
 500:       }
 501:     }
 502:     newline
 503:   }
 504: 
 505:   newline
 506:   
 507:   for f ( 0..(number_of_foundations-1) )
 508:   {
 509:       box
 510:       {
 511:         width { 2em }
 512:         height { 2em }
 513:         content { card[foundation[f]] }
 514:         border { 1px solid black }
 515:         bind_action { "Foundation " f }
 516:         while_active { background { #7fd } }
 517:         if( ((foundation[f]-1) /26) == 0 )
 518:         {
 519:           background{ #fbb }
 520:         }
 521:       }
 522:   }  
 523: }