home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 January / PSL Monthly Shareware CD-ROM (Public Software Library) (January 1994).iso / games / dos / ascii_ga / yahtzee.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-06-28  |  9.5 KB  |  298 lines
  1. 10  '                    YAHTZEE  J. E. STEITZ 6/27/83
  2. 20  CLS:LOCATE 1,25:PRINT"YAHTZEE  By J. E. Steitz":LOCATE 2,34:PRINT"6/27/82"
  3. 30  LOCATE 4,1:PRINT"This game replicates the game of YAHTZEE as published by Milton Bradley"
  4. 40  PRINT"Company.  The rules of the game are quite simple.  If you purchase the"
  5. 50  PRINT"copyrighted game, you may obtain the printed rules which are followed"
  6. 60  PRINT"exactly in this demonstration of the IBM Personal Computer.
  7. 70  PRINT:PRINT"During play, instructions are given at the very bottom of the screen to"
  8. 80  PRINT"let you know what to do at each step.  You may use the ARROW keys or the"
  9. 90  PRINT"SPACE BAR to move the cursor from place to place on the screen.  The cursor"
  10. 100  PRINT"looks like this: ";:COLOR 26:PRINT CHR$(16);:COLOR 7:PRINT" and flashes so you will notice it."
  11. 110  PRINT:PRINT"When you have decided what you want to do, you must remember to hit the"
  12. 120  COLOR 15:PRINT"RETURN ";:COLOR 7:PRINT"("+CHR$(17)+CHR$(196)+CHR$(217)+") key to inform the computer that you have made some choice or"
  13. 130  PRINT"taken some action."
  14. 140  PRINT:PRINT"Hit the ";:COLOR 15:PRINT"RETURN";:COLOR 7:PRINT" KEY TO CONTINUE."
  15. 150  A$=INKEY$:IF A$="" THEN 150
  16. 160  IF ASC(A$)<>13 THEN 150
  17. 170  DEFINT I-O
  18. 180  DEFSTR A-H
  19. 190  OPTION BASE 1
  20. 200  DIM DIE(5),J1(5,2),ANAME(2,2),OSCORE(2,2)
  21. 210  ANAME(1,1)="test":CRS=CHR$(16)
  22. 220  DEF FNUP$(A$)=CHR$(ASC(LEFT$(A$,1)) AND 223)
  23. 230  A = TIME$
  24. 240  A = RIGHT$(A,2)+MID$(A,3,2)+LEFT$(A,2)
  25. 250  RANDOMIZE VAL(A)
  26. 260  OCOL=70:KEY OFF
  27. 270  FACE(1,1)="       "
  28. 280  FACE(1,2)="   "+CHR$(2)+"   "
  29. 290  FACE(1,3)="       "
  30. 300  FACE(2,1)=" "+CHR$(2)+"     "
  31. 310  FACE(2,2)="       "
  32. 320  FACE(2,3)="     "+CHR$(2)+" "
  33. 330  FACE(3,1)="     "+CHR$(2)+" "
  34. 340  FACE(3,2)="   "+CHR$(2)+"   "
  35. 350  FACE(3,3)=" "+CHR$(2)+"     "
  36. 360  FACE(4,1)=" "+CHR$(2)+"   "+CHR$(2)+" "
  37. 370  FACE(4,2)="       "
  38. 380  FACE(4,3)=" "+CHR$(2)+"   "+CHR$(2)+" "
  39. 390  FACE(5,1)=" "+CHR$(2)+"   "+CHR$(2)+" "
  40. 400  FACE(5,2)="   "+CHR$(2)+"   "
  41. 410  FACE(5,3)=" "+CHR$(2)+"   "+CHR$(2)+" "
  42. 420  FACE(6,1)=" "+CHR$(2)+"   "+CHR$(2)+" "
  43. 430  FACE(6,2)=" "+CHR$(2)+"   "+CHR$(2)+" "
  44. 440  FACE(6,3)=" "+CHR$(2)+"   "+CHR$(2)+" "
  45. 450  CLS
  46. 460  INPUT"How many players (1-6)";NP
  47. 470  IF NP=>1 AND NP<=6 THEN 500
  48. 480  PRINT "The number of players may only be 1 to 6. Try again"
  49. 490  GOTO 460
  50. 500  ERASE OSCORE,ANAME
  51. 510  DIM ANAME(NP),OSCORE(NP,14)
  52. 520  FOR I=1 TO NP
  53. 530  PRINT"Enter the name for player number ";I
  54. 540  INPUT ANAME(I)
  55. 550  ANAME(I)=LEFT$(ANAME(I),6)
  56. 560  ANAME(I)=FNUP$(ANAME(I))+MID$(ANAME(I),2)
  57. 570  FOR J=1 TO 13
  58. 580  OSCORE(I,J)=-1
  59. 590  NEXT J
  60. 600  OSCORE(I,14)=0
  61. 610  NEXT I
  62. 620  '              DISPLAY THE SCORING TABLE
  63. 630  CLS
  64. 640  PRINT "               ERRTHENTHENTHENTHENTHENTHENFNTHENTHENTHENTHENTHENTHENFNTHENTHENTHENTHENTHENTHENFNTHENTHENTHENTHENTHENTHENFNTHENTHENTHENTHENTHENTHENFNTHENTHENTHENTHENTHENTHENOPTION"
  65. 650  PRINT " ACES..........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  66. 660  PRINT " TWOS..........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  67. 670  PRINT " THREES........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  68. 680  PRINT " FOURS.........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  69. 690  PRINT " FIVES.........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  70. 700  PRINT " SIXES.........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  71. 710  PRINT "               PSETTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHEN<0xB5!>"
  72. 720  PRINT " TOTAL UPPER...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  73. 730  PRINT " BONUS FOR 63..CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  74. 740  PRINT "               PSETTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHEN<0xB5!>"
  75. 750  PRINT " 3 OF A KIND...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  76. 760  PRINT " 4 OF A KIND...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  77. 770  PRINT " FULL HOUSE....CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  78. 780  PRINT " SM. STRAIGHT..CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  79. 790  PRINT " LG. STRAIGHT..CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  80. 800  PRINT " YAHTZEE.......CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  81. 810  PRINT " CHANCE........CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  82. 820  PRINT " YAHTZEE BONUS.CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  83. 830  PRINT "               PSETTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHENINSTRTHENTHENTHENTHENTHENTHEN<0xB5!>"
  84. 840  PRINT " TOTAL LOWER...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  85. 850  PRINT " TOTAL UPPER...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  86. 860  PRINT " GRAND TOTAL...CALL......CALL......CALL......CALL......CALL......CALL......CALL"
  87. 870  PRINT "               ERLTHENTHENTHENTHENTHENTHENSTEPTHENTHENTHENTHENTHENTHENSTEPTHENTHENTHENTHENTHENTHENSTEPTHENTHENTHENTHENTHENTHENSTEPTHENTHENTHENTHENTHENTHENSTEPTHENTHENTHENTHENTHENTHENSAVE";
  88. 880  FOR NROUND=1 TO 13
  89. 890  FOR NPLAYER = 1 TO NP
  90. 900  FOR I=1 TO NP
  91. 910  IF I=NPLAYER THEN COLOR 26
  92. 920  LOCATE 1,17+(I-1)*7:PRINT USING"&";ANAME(I);
  93. 930  COLOR 7
  94. 940  NEXT I
  95. 950  FOR NROLL=1 TO 2
  96. 960  GOSUB 2850      'Roll and Display the Dice
  97. 970  '                 DICE SELECTION ROUTINE
  98. 980  OPOS = 1
  99. 990  CCRS=CRS
  100. 1000  LOCATE 25,1:PRINT"                                 Type an X next to each die you want to keep.";
  101. 1010  LOCATE 5+4*(OPOS-1),OCOL-2:COLOR 26:PRINT CCRS ;:COLOR 7
  102. 1020  A=INKEY$:IF A="" THEN 1020
  103. 1030  IF A = CHR$(13) THEN 1290          'accept input
  104. 1040  IF A = " " THEN 1270               'Space bar
  105. 1050  IF FNUP$(A)="X" THEN 1250          'die selected
  106. 1060  IF ASC(LEFT$(A,1))<> 0 THEN 1020
  107. 1070  INKY=ASC(RIGHT$(A,1))
  108. 1080  IF INKY=72 THEN 1220               'cursor up
  109. 1090  IF INKY<>80 THEN 1020
  110. 1100  OPOS = OPOS + 1                   'cursor down
  111. 1110  IF OPOS>5 THEN OPOS=1
  112. 1120  CCRS=CRS
  113. 1130  LOCATE 5,OCOL-2
  114. 1140  FOR I=1 TO 5
  115. 1150  APRT=" "
  116. 1160  IF J1(I,1)=0 THEN 1190
  117. 1170  APRT="X"
  118. 1180  IF I=OPOS THEN CCRS="X"
  119. 1190  LOCATE 5+4*(I-1),OCOL-2:PRINT APRT;
  120. 1200  NEXT I
  121. 1210  GOTO 1010
  122. 1220  OPOS=OPOS-1   ' cursor up
  123. 1230  IF OPOS<1 THEN OPOS=5
  124. 1240  GOTO 1120
  125. 1250  J1(OPOS,1)=1   '   select the die
  126. 1260  GOTO 1100   'move to next position
  127. 1270  J1(OPOS,1)=0  'unselect the die (Space bar was hit)
  128. 1280  GOTO 1100
  129. 1290  FOR I=1 TO 5
  130. 1300  LOCATE 5+4*(I-1),OCOL-2:PRINT" ";
  131. 1310  NEXT I
  132. 1320  NSAVE=J1(1,1)
  133. 1330  FOR I=2 TO 5
  134. 1340  NSAVE=NSAVE+J1(I,1)
  135. 1350  NEXT I
  136. 1360  IF NSAVE=5 THEN 1390
  137. 1370  NEXT NROLL
  138. 1380  GOSUB 2850 'Roll and display the dice for the third time
  139. 1390  '                  SELECT SCORING ROUTINE
  140. 1400  FOR K=1 TO 5:J1(K,1)=0:NEXT K
  141. 1410  LOCATE 25,1:PRINT"Move cursor to the item you want to score and hit the return key             ";
  142. 1420  FOR I=1 TO 13
  143. 1430  IF OSCORE(NPLAYER,I)=-1 THEN 1460
  144. 1440  NEXT I
  145. 1450  PRINT"game over?"
  146. 1460  IF I<7 THEN ILINE=I+1 ELSE ILINE=I+5
  147. 1470  LOCATE ILINE,1:COLOR 26:PRINT CRS;:COLOR 7
  148. 1480  A=INKEY$:IF A="" THEN 1480
  149. 1490  IF A=" " THEN 1550
  150. 1500  IF A=CHR$(13) THEN 1670
  151. 1510  IF ASC(LEFT$(A,1))<>0 THEN 1480
  152. 1520  INKY=ASC(RIGHT$(A,1))
  153. 1530  IF INKY=72 THEN 1610
  154. 1540  IF INKY <> 80 THEN 1480
  155. 1550  LOCATE ILINE,1:PRINT" "; '      Cursor down
  156. 1560  ILINE=ILINE+1
  157. 1570  IF ILINE=8 THEN ILINE=12:GOTO 1590
  158. 1580  IF ILINE=19 THEN ILINE = 2
  159. 1590  IF ILINE<8 THEN I=ILINE-1 ELSE I=ILINE-5
  160. 1600  IF OSCORE(NPLAYER,I)=-1 THEN 1470 ELSE 1560
  161. 1610  LOCATE ILINE,1:PRINT" ";
  162. 1620  ILINE=ILINE-1
  163. 1630  IF ILINE=11 THEN ILINE=7:GOTO 1650
  164. 1640  IF ILINE=1 THEN ILINE=18
  165. 1650  IF ILINE<8 THEN I=ILINE-1 ELSE I=ILINE-5
  166. 1660  IF OSCORE(NPLAYER,I)=-1 THEN 1470 ELSE 1620
  167. 1670  ALL5="NO"   'Assume no yahtzee
  168. 1680  FOR L=2 TO 5
  169. 1690  IF J1(L,2)<>J1(1,2) THEN 1720
  170. 1700  NEXT L
  171. 1710  ALL5="YES"
  172. 1720  IF I>6 THEN 1840
  173. 1730  NTOT=0
  174. 1740  FOR ND=1 TO 5
  175. 1750  IF J1(ND,2)=I THEN NTOT=NTOT+I
  176. 1760  J1(ND,1)=0
  177. 1770  NEXT ND
  178. 1780  NTOP=NTOT
  179. 1790  FOR L=1 TO 6
  180. 1800  IF OSCORE(NPLAYER,L)<>-1 THEN NTOP=NTOP+OSCORE(NPLAYER,L)
  181. 1810  NEXT L
  182. 1820  LOCATE 9,17+(NPLAYER-1)*7:PRINT USING "######";NTOP;
  183. 1830  GOTO 2410
  184. 1840  '                 VALIDATE AND SCORE LOWER HALF
  185. 1850  NDTOT=J1(1,2) 'Get the total of all dice
  186. 1860  FOR L=2 TO 5
  187. 1870  NDTOT=NDTOT+J1(L,2)
  188. 1880  NEXT L
  189. 1890  IF I=13 THEN NTOT=NDTOT:GOTO 2410 'Go score chance line
  190. 1900  IF I<> 12 THEN 1930                  'Not Yahtzee
  191. 1910  IF ALL5="YES" THEN NTOT=50 ELSE NTOT=0
  192. 1920  GOTO 2420     'Go score the YAHTZEE line
  193. 1930  '           Distribute pips for analysis
  194. 1940  FOR L=1 TO 6:NPIP(L)=0:NEXT L
  195. 1950  FOR L=1 TO 5
  196. 1960  NPIP(J1(L,2))=NPIP(J1(L,2))+1
  197. 1970  NEXT L
  198. 1980  IF I<>7 THEN 2050  'Not 3 of a kind
  199. 1990  NTOT=NDTOT
  200. 2000  FOR L=1 TO 6
  201. 2010  IF NPIP(L)=>3 THEN 2410    'Qualifies for 3 of a kind
  202. 2020  NEXT L
  203. 2030  NTOT=0
  204. 2040  GOTO 2410
  205. 2050  IF I<>8 THEN 2120  'Not 4 of a kind
  206. 2060  NTOT=NDTOT
  207. 2070  FOR L=1 TO 6
  208. 2080  IF NPIP(L)=>4 THEN 2410    'Qualifies for 4 of a kind
  209. 2090  NEXT L
  210. 2100  NTOT=0
  211. 2110  GOTO 2410
  212. 2120  '               May only be full house, sm or lg straight
  213. 2130  IF ALL5="YES" AND OSCORE(NPLAYER,J1(1,2))<>-1 THEN JOKER$="yes" ELSE JOKER$="NO"
  214. 2140  IF I<>9 THEN 2210
  215. 2150  NTOT=25         'Assume a good full house
  216. 2160  IF JOKER$="YES" THEN 2410
  217. 2170  FOR K=1 TO 6
  218. 2180  IF NPIP(K)=1 OR NPIP(K)>3 THEN NTOT=0
  219. 2190  NEXT K
  220. 2200  GOTO 2410
  221. 2210  '              Only the sm and lg straights are left
  222. 2220  IF I<>10 THEN 2320
  223. 2230  NTOT=30      'Assume a good small straight
  224. 2240  IF JOKER$="YES" THEN 2410
  225. 2250  OBIT=0
  226. 2260  FOR K=1 TO 6
  227. 2270  IF NPIP(K)=0 THEN OBIT=0 ELSE OBIT=OBIT+1
  228. 2280  IF OBIT=4 THEN 2410   'qualifies as a small straight
  229. 2290  NEXT K
  230. 2300  NTOT=0                ' fails as a small straight
  231. 2310  GOTO 2410
  232. 2320  NTOT=40   'Must be trying for a large straight
  233. 2330  IF JOKER$="YES" THEN 2410
  234. 2340  OBIT=0
  235. 2350  FOR K=1 TO 6
  236. 2360  IF NPIP(K)=0 THEN OBIT=0 ELSE OBIT=OBIT+1
  237. 2370  IF OBIT=5 THEN 2410
  238. 2380  NEXT K
  239. 2390  NTOT=0
  240. 2400  '                    ADD 100 IF THIS IS SECOND OR LATER YAHTZEE
  241. 2410  IF ALL5="YES" AND OSCORE(NPLAYER,12)>0 THEN OSCORE(NPLAYER,14)=OSCORE(NPLAYER,14)+100 'Score 100 point bonus for extra yahtzees
  242. 2420  OSCORE(NPLAYER,I)= NTOT
  243. 2430  LOCATE ILINE,1:PRINT" ";
  244. 2440  LOCATE ILINE,17+(NPLAYER-1)*7:PRINT USING "######";NTOT;
  245. 2450  NEXT NPLAYER
  246. 2460  NEXT NROUND
  247. 2470  LOCATE 25,1:PRINT SPC(77);
  248. 2480  '                  PRINT FINAL TOTALS
  249. 2490  LSCORE=0
  250. 2500  FOR N=1 TO NP
  251. 2510  NTOP=OSCORE(N,1)
  252. 2520  FOR M=2 TO 6
  253. 2530  NTOP=NTOP+OSCORE(N,M)
  254. 2540  NEXT M
  255. 2550  IF NTOP =>63 THEN NB63=35 ELSE NB63=0
  256. 2560  LOCATE 10,17+(N-1)*7:PRINT USING "######";NB63;
  257. 2570  NTUPPER=NTOP+NB63
  258. 2580  LOCATE 19,17+(N-1)*7:PRINT USING "######";OSCORE(N,14)
  259. 2590  NBOT=OSCORE(N,7)
  260. 2600  FOR M=8 TO 14
  261. 2610  NBOT=NBOT+OSCORE(N,M)
  262. 2620  NEXT M
  263. 2630  LOCATE 21,17+(N-1)*7:PRINT USING "######";NBOT;
  264. 2640  LOCATE 22,17+(N-1)*7:PRINT USING "######";NTUPPER;
  265. 2650  LOCATE 23,17+(N-1)*7:PRINT USING "######";NTUPPER+NBOT;
  266. 2660  IF NTUPPER+NBOT>LSCORE THEN LSCORE=NTUPPER+NBOT:NNNAME=N
  267. 2670  NEXT N
  268. 2680  LOCATE 24,17+(NNNAME-1)*7:COLOR 26:PRINT"WINNER";:COLOR 7
  269. 2690  LOCATE 25,1:INPUT"Do you want to play another (Y,N)";A
  270. 2700  IF A="" THEN 2690
  271. 2710  IF FNUP$(A)="N" THEN END
  272. 2720  IF FNUP$(A)<>"Y" THEN 2690
  273. 2730  LOCATE 25,1:PRINT SPC(77);
  274. 2740  LOCATE 25,1:INPUT"Same players (Y,N)";A
  275. 2750  IF A="" THEN 2730
  276. 2760  IF FNUP$(A)="N" THEN 450
  277. 2770  IF FNUP$(A)<>"Y" THEN 2730
  278. 2780  FOR I=1 TO NP
  279. 2790  FOR J=1 TO 13
  280. 2800  OSCORE(I,J)=-1
  281. 2810  NEXT J
  282. 2820  OSCORE(I,14)=0
  283. 2830  NEXT I
  284. 2840  GOTO 630
  285. 2850  '                  ROUTINE TO ROLL  AND DISPLAY UP TO FIVE DICE
  286. 2860  FOR I=1 TO 5
  287. 2870  IF J1(I,1)=0 THEN J1(I,2)=INT(RND(1)*6) + 1 ' Roll only unlocked dice
  288. 2880  J1(I,1)=0 ' Reset dice locking flag
  289. 2890  NEXT I
  290. 2900  COLOR 0,7
  291. 2910  FOR I=1 TO 5
  292. 2920  FOR J=1 TO 3
  293. 2930  LOCATE 2+4*(I-1)+J,OCOL:PRINT FACE(J1(I,2),J)
  294. 2940  NEXT J
  295. 2950  NEXT I
  296. 2960  COLOR 7,0
  297. 2970  RETURN
  298.