home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 5 / ctrom5b.zip / ctrom5b / PROGRAM / DIVERSEN / TIPI2A / PPUZZLE.TPI < prev    next >
Text File  |  1994-09-10  |  2KB  |  93 lines
  1. # PPUZZLE.TPI
  2. # by Kent Peterson 10/30/93
  3.  
  4. defstr board$
  5. "ABCDEFGHIJKLMNOP" board$ store
  6.  
  7. defvar counter
  8. 0 counter store
  9.  
  10. define display
  11.  0 0 locate
  12.  " 1|" print$
  13.  board$ fetch dup$ 4 left$ print$ cr
  14.  " 2|" print$
  15.  dup$ 5 4 mid$ print$ cr
  16.  " 3|" print$
  17.  dup$ 9 4 mid$ print$ cr
  18.  " 4|" print$
  19.  4 right$ print$ cr
  20.  |  -+----
  21.  |   |5678
  22. enddef
  23.  
  24. define move ( n -- )
  25. # Changes the board in one of 8 ways
  26.  case 1 of
  27.  2 3 4 1 5 6 7 8 9 10 11 12 13 14 15 16
  28.  endof
  29.  2 of
  30.  1 2 3 4 6 7 8 5 9 10 11 12 13 14 15 16
  31.  endof
  32.  3 of
  33.  1 2 3 4 5 6 7 8 10 11 12 9 13 14 15 16
  34.  endof
  35.  4 of
  36.  1 2 3 4 5 6 7 8 9 10 11 12 14 15 16 13
  37.  endof
  38.  5 of
  39.  5 2 3 4 9 6 7 8 13 10 11 12 1 14 15 16
  40.  endof
  41.  6 of
  42.  1 6 3 4 5 10 7 8 9 14 11 12 13 2 15 16
  43.  endof
  44.  7 of
  45.  1 2 7 4 5 6 11 8 9 10 15 12 13 14 3 16
  46.  endof
  47.  8 of
  48.  1 2 3 8 5 6 7 12 9 10 11 16 13 14 15 4
  49.  endof
  50.  endcase
  51.  ""
  52.  16 do
  53.   board$ fetch 1 mid$ swap$ +$
  54.  loop
  55.  board$ store
  56. enddef
  57.  
  58. define getmove ( -- move )
  59.  "12345678" 27 chr$ +$
  60.  begin inkey$ len instr * 
  61.   dup if dup drop$ endif drop$
  62.  until
  63. enddef
  64.  
  65. define checkforwin
  66.  counter fetch dup 1 + counter store
  67.  1 30 locate print |  moves
  68.  board$ fetch "ABCDEFGHIJKLMNOP" =$
  69.  if 2 30 locate | You win!
  70.     begin key until
  71.     8 0 locate 1 cursor bye
  72.  endif
  73. enddef
  74.  
  75. cls
  76. 0 cursor
  77. randomize
  78. 1 10 locate | Shuffling...
  79. 10 do display 8 random move loop
  80. 1 10 locate | Use the keys
  81. 2 10 locate | 1-8 to put the
  82. 3 10 locate | puzzle back into
  83. 4 10 locate | alphabetical order.
  84. 5 10 locate | Press [ESC] to exit.
  85. begin
  86.  display
  87.  checkforwin
  88.  getmove
  89.  dup 9 = if 8 0 locate
  90.             1 cursor bye
  91.          else move endif
  92. 0 until
  93.