home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 9 / amigaformatcd09.iso / readerstuff / john_filsak / solitaire.rexx < prev   
Encoding:
OS/2 REXX Batch file  |  1996-11-13  |  6.7 KB  |  313 lines
  1. /*=============================*/
  2. /* "Solitaire" game for ARexx  */
  3. /*      © 1996 John Filsak     */
  4. /*=============================*/
  5.  
  6. /* Set up some constants */
  7. /* ===================== */
  8. esc='1b'x
  9. cr='a'x
  10. cls='c'x
  11. blackon=esc'[31m'
  12. whiteon=esc'[32m'
  13. blueon=esc'[33m'
  14. normal=esc'[0m'
  15. boldon=esc'[1m'
  16. boldoff=esc'[22m'
  17. wback=esc'[42m'
  18. bback=esc'[43m'
  19. gback=esc'[40m'
  20. blob='¤'
  21.  
  22. call open(win,'raw:100/100/400/239/Solitaire  ©1996 John Filsak')
  23. signal on break_c
  24.  
  25. /*================*/
  26. /* Main game loop */
  27. /*================*/
  28.  
  29. gameover=0
  30. do until gameover=1
  31.     call makegrid()
  32.     stoppit=0
  33.     do until stoppit=1
  34.         call moveit()
  35.     end
  36. if upper(choice(normal||cr||cr||cr" Would you like to play again? "))="N" then gameover=1
  37. end
  38. call ending
  39. exit
  40.  
  41. /*=============*/
  42. /* Subroutines */
  43. /*=============*/
  44.  
  45. /* Cursor movement etc */
  46. /*=====================*/
  47. moveit:
  48. ans=readch(win,1)
  49. /*The arrow keys generate a control character (155)
  50.   plus the letters A-D. The control character is
  51.   apparently ignored, and ARexx happily deals with
  52.   the movement letter*/
  53.  
  54. select
  55.     when ans="A" then do
  56.         select
  57.             when lft>=lft1 & lft<=lft1+4 & top>top1 then do
  58.                 top=top-1
  59.                 square=square-7
  60.             end
  61.             when (lft<lft1 | lft>lft1+4) & top>top2 then do
  62.                 top=top-1
  63.                 square=square-7
  64.             end
  65.             otherwise nop
  66.         end
  67.     call cpos(top,lft,"")
  68.     end
  69.     when ans="B" then do
  70.         select
  71.             when lft>=lft1 & lft<=lft1+4 & top<top1+6 then do
  72.                 top=top+1
  73.                 square=square+7
  74.             end
  75.             when (lft<lft1 | lft>lft1+4) & top<top2+2 then do
  76.                 top=top+1
  77.                 square=square+7
  78.             end
  79.             otherwise nop
  80.         end
  81.     call cpos(top,lft,"")
  82.     end
  83.     when ans="C" then do
  84.         select
  85.             when top>=top1 & top<=top1+1 & lft<lft1+4 then do
  86.                 lft=lft+2
  87.                 square=square+1
  88.             end
  89.             when top>=top2 & top<=top2+2 & lft<lft2+12 then do
  90.                 lft=lft+2
  91.                 square=square+1
  92.             end
  93.             when top>top2 & lft<lft1+4 then do
  94.                 lft=lft+2
  95.                 square=square+1
  96.             end
  97.             otherwise nop
  98.         end
  99.     call cpos(top,lft,"")
  100.     end
  101.     when ans="D" then do
  102.         select
  103.             when top>=top1 & top<=top1+1 & lft>lft1 then do
  104.                 lft=lft-2
  105.                 square=square-1
  106.             end
  107.             when top>=top2 & top<=top2+2 & lft>lft2 then do
  108.                 lft=lft-2
  109.                 square=square-1
  110.             end
  111.                 when top>top2 & lft>lft1 then do
  112.                 lft=lft-2
  113.                 square=square-1
  114.             end
  115.             otherwise nop
  116.             end
  117.     call cpos(top,lft,"")
  118.     end
  119. /* Jump over peg */
  120. /*===============*/
  121.     when ans="8" then do
  122.     sq2=square-14;sq1=square-7
  123.         if square>12 & square.square=1 & square.sq1=1 & square.sq2=0 then do
  124.             call cpos(top,lft,"·")
  125.             square.square=0
  126.             top=top-2
  127.             call cpos(top+1,lft,"·")
  128.             square=square-14
  129.             call hkeep()
  130.         end
  131.     end
  132.     when ans="2" then do
  133.         sq2=square+14;sq1=square+7
  134.         if square<34 & square.square=1 & square.sq1=1 & square.sq2=0 then do
  135.             call cpos(top,lft,"·")
  136.             square.square=0
  137.             top=top+2
  138.             call cpos(top-1,lft,"·")
  139.             square=square+14
  140.             call hkeep()
  141.         end
  142.     end
  143.     when ans="4" then do
  144.         sq2=square-2;sq1=square-1
  145.         if (square<22 | square>23 & square<29 | square>30) & square.square=1 & square.sq1=1 & square.sq2=0 then do
  146.             call cpos(top,lft,"·")
  147.             square.square=0
  148.             lft=lft-4
  149.             call cpos(top,lft+2,"·")
  150.             square=square-2
  151.             call hkeep()
  152.         end
  153.     end
  154.     when ans="6" then do
  155.         sq2=square+2;sq1=square+1
  156.         if (square<20 | square>21 & square<27 | square>28) & square.square=1 & square.sq1=1 & square.sq2=0 then do
  157.             call cpos(top,lft,"·")
  158.             square.square=0
  159.             lft=lft+4
  160.             call cpos(top,lft-2,"·")
  161.             square=square+2
  162.             call hkeep()
  163.         end
  164.     end
  165.     when upper(ans)="Q" then do
  166.         stoppit=1
  167.         call title()
  168.         call writech(win,cr cr" GAME STOPPED!"cr cr)
  169.     end
  170.     otherwise nop
  171. end
  172. if count=1 then do
  173.     stoppit=1
  174.     call writech(win,normal)
  175.     do a=3 to 16
  176.         call cpos(a,2,copies(" ",27))
  177.     end
  178.     if square.25=1 then do
  179.         call cpos(5,2,whiteon||boldon||bback" CONGRATULATIONS!! "gback||cr)
  180.         call writech(win,blackon||cr" You have completed"cr)
  181.         call writech(win," the game!"cr)
  182.     end
  183.     else do
  184.         call cpos(5,2,whiteon||boldon||bback"  WRONG!!  "gback||cr)
  185.         call writech(win,normal||cr" Your're supposed to finish"cr)
  186.         call writech(win," in the middle!"cr)
  187.         call writech(win,cr||blueon||boldon" Better luck next time!"cr)
  188.     end
  189.     call writech(win,cr||cr||normal" Press a key ...")
  190.     call readch(win,1)
  191. end
  192. return
  193.  
  194. /* Housekeeping for
  195.    jump routines    */
  196. /*==================*/
  197. hkeep:
  198. square.sq1=0
  199. square.square=1
  200. count=count-1
  201. call counter()
  202. call cpos(top,lft,blob)
  203. call cpos(top,lft,"")
  204. return
  205.  
  206. counter:
  207. call cpos(13,lft2+3,gback||blackon||normal||count-1" to go "blueon||boldon||wback)
  208. return
  209.  
  210. /* Make game grid */
  211. /*================*/
  212. makegrid:
  213. call title()
  214. if game~=1 then do
  215.     call writech(win,normal||cr||cr||cr" This is the traditional game of jumping over"cr)
  216.     call writech(win," and removing pegs, with the aim of having"cr)
  217.     call writech(win," just one left in the middle of the board."cr)
  218.     call writech(win,cr||cr||boldon||whiteon||" Press any key to start."normal)
  219.     call readch(win,1)
  220.     game=1
  221.     call title()
  222. end
  223. call writech(win,cr||cr||normal" Use the "boldon||whiteon"arrow keys"normal" to move"cr)
  224. call writech(win," the cursor to your desired"cr)
  225. call writech(win," peg."cr)
  226. call writech(win,cr" Use keys on the numeric pad"cr)
  227. call writech(win," to jump:"cr)
  228. call writech(win,boldon||whiteon||cr"   8 - UP"cr"   2 - DOWN"cr"   4 - LEFT"cr"   6 - RIGHT"cr)
  229. call writech(win,normal||cr"   Q - QUIT"boldon||wback||blueon)
  230.  
  231. do a=1 to 49
  232.     square.a=1
  233. end
  234. square.25=0
  235. square=25
  236. count=32
  237. top=5;top1=top;top2=top+2
  238. lft=37;lft1=lft;lft2=lft-4
  239.  
  240. do a=1 to 2
  241.     do b=0 to 4 by 2
  242.         call cpos(top,lft+b,blob" ")
  243.         if b=0 then call cpos(top,lft-1," ")
  244.     end
  245.     top=top+1
  246. end
  247. do a=1 to 3
  248.     do b=0 to 12 by 2
  249.         call cpos(top,lft2+b,blob" ")
  250.         if b=0 then call cpos(top,lft2-1," ")
  251.     end
  252.     top=top+1
  253. end
  254. do a=1 to 2
  255.     do b=0 to 4 by 2
  256.         call cpos(top,lft+b,blob" ")
  257.         if b=0 then call cpos(top,lft-1," ")
  258.     end
  259.     top=top+1
  260. end
  261. top=top-4;lft=lft+2
  262. call counter()
  263. call cpos(top,lft,"·")
  264. call cpos(top,lft,"")
  265. return
  266.  
  267. /* Get Y/N input */
  268. /* ============= */
  269. choice:
  270. parse arg text
  271. yn=""
  272. do until upper(yn)='Y'|upper(yn)='N'
  273.     call writech(win,text)
  274.     yn=readch(win,1)
  275.     call writech(win,yn cr)
  276.     if upper(yn)~='Y'&upper(yn)~='N'then call writeln(win," Please type Y or N.")
  277. end
  278. return yn
  279.  
  280. /* Position cursor */
  281. /* =============== */
  282. cpos:
  283. parse arg row,col,text
  284. call Writech(win,'9b'x||row'3B'x||col'48'x||text)
  285. return
  286.  
  287. /* Clear screen */
  288. /* ============ */
  289. title:
  290. call writech(win,cls)
  291. call cpos(1,18,boldon||wback||blackon" SOLITAIRE "gback)
  292. return
  293.  
  294. /* Closing courtesies */
  295. /* ================== */
  296. ending:
  297. call title()
  298. ending1:
  299. call writeln(win,cr||cr||cr" Thank you for playing Solitaire."cr)
  300. call writeln(win,blueon||boldon" Solitaire was written for your enjoyment by")
  301. call writech(win,blackon" John Filsak. ")
  302. do a=1 to 3750;end
  303. call close(win)
  304. return
  305.  
  306. /* Trap Ctrl-C */
  307. /* =========== */
  308. break_c:
  309. call title()
  310. call writeln(win,cr||cr||blackon" PROGRAM HALTED!"normal)
  311. call ending1()
  312. exit
  313.