home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ROLL5.ZIP / ROLL5.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-13  |  34.1 KB  |  928 lines
  1.     Ser1$ = "10"
  2.     Ser2$ = "00"
  3.     Ser3$ = "00"
  4.  
  5.     ET$ = " ROLL 5 (Ver 2.0) - A DolSOFT CREATION                             Ser # " + Ser1$ + Ser2$ + Ser3$ + " "
  6.     Exit$ = ET$
  7.     'Exit$ = ET$ + "                 ---- Registration has not yet been paid! ----                  "
  8. '******************************************************************************
  9.     CLS
  10.     SD = 0        'sound is ON
  11.     LOCATE , , 0
  12.  
  13.     Q1$ = CHR$(16)
  14.     Q2$ = CHR$(17)
  15.     PJ$ = CHR$(23)
  16.     BG = 0
  17.     CB = 0
  18.  
  19. 6 OPTION BASE 1
  20. 7 DIM OK$(5, 19), R$(100), COUNT(10), KEEP(10), A$(20), B$(16), C(10), SCORE(5), Player$(5)
  21. 8 DIM FL$(5), CNT(5), roll(5), BOT(5), TOP(5)
  22.       DIM J3$(15)
  23.       Page% = 0
  24.       K$ = "Keep"
  25.     VC1$ = "╔══════════════════════════════════════════════════════════════════════════════╗"
  26.     VC2$ = "║                                                                              ║"
  27.     VC3$ = "╚══════════════════════════════════════════════════════════════════════════════╝"
  28.  
  29.    B$(1) = "ONES . . . . . . . ."
  30.    B$(2) = "TWOS . . . . . . . ."
  31.    B$(3) = "THREES . . . . . . ."
  32.    B$(4) = "FOURS. . . . . . . . "
  33.    B$(5) = "FIVES. . . . . . . ."
  34.    B$(6) = "SIXES. . . . . . . ."
  35.    B$(7) = "Three of a Kind. . . "
  36.    B$(8) = "Four of a Kind . . ."
  37.    B$(9) = "Full House . . . . ."
  38.    B$(10) = "Small Straight . . ."
  39.    B$(11) = "Large Straight . . . "
  40.    B$(12) = "R O L L   5. . . . ."
  41.    B$(13) = "Chance . . . . . . ."
  42.    B$(14) = "Upper SubScore"
  43.    B$(15) = "Upper Bonus for 63+"
  44.    B$(16) = "Lower SubScore"
  45.  
  46. A$(1) = "╔═══════════════════════╤═══════╤═══════╤═══════╤═══════╤═══════╗   ╔═════════╗"
  47. A$(2) = "║                       │       │       │       │       │       ║   ║         ║"
  48. A$(3) = "║                       │       │       │       │       │       ║   ║         ║"
  49. A$(4) = "║                       │       │       │       │       │       ║   ╚═════════╝"
  50. A$(5) = "║                       │       │       │       │       │       ║   ╔═════════╗"
  51. A$(6) = "║                       │       │       │       │       │       ║   ║         ║"
  52. A$(7) = "║                       │       │       │       │       │       ║   ║         ║"
  53. A$(8) = "╟───────────────────────┼───────┼───────┼───────┼───────┼───────╢   ╚═════════╝"
  54. A$(9) = "║                       │       │       │       │       │       ║   ╔═════════╗"
  55. A$(10) = "║                       │       │       │       │       │       ║   ║         ║"
  56. A$(11) = "║                       │       │       │       │       │       ║   ║         ║"
  57. A$(12) = "║                       │       │       │       │       │       ║   ╚═════════╝"
  58. A$(13) = "║                       │       │       │       │       │       ║   ╔═════════╗"
  59. A$(14) = "║                       │       │       │       │       │       ║   ║         ║"
  60. A$(15) = "║                       │       │       │       │       │       ║   ║         ║"
  61. A$(16) = "╟───────────────────────┼───────┼───────┼───────┼───────┼───────╢   ╚═════════╝"
  62. A$(17) = "║                       │       │       │       │       │       ║   ╔═════════╗"
  63. A$(18) = "║                       │       │       │       │       │       ║   ║         ║"
  64. A$(19) = "║                       │       │       │       │       │       ║   ║         ║"
  65. A$(20) = "╚═══════════════════════╧═══════╧═══════╧═══════╧═══════╧═══════╝   ╚═════════╝"
  66.  
  67. R$(1) = "█▀▀▀▀▄       ▄█▀▀▀█▄      ██           ██           █▀▀▀▀▀▀"
  68. R$(2) = "█▄▄▄▄▄▀      █     █      ██           ██           █▄▄▄▄▄"
  69. R$(3) = "█   ▀▄       ▀█▄▄▄█▀      ██▄▄▄▄▄      ██▄▄▄▄▄      ▄▄▄▄▄▄▀"
  70.                            
  71.  
  72. J3$(1) = "███████"
  73. J3$(2) = "███ ███"
  74. J3$(3) = "███████"
  75.  
  76. J3$(4) = "█▀█████"
  77. J3$(5) = "███████"
  78. J3$(6) = "█████▄█"
  79.  
  80. J3$(7) = "█▀█████"
  81. J3$(8) = "███ ███"
  82. J3$(9) = "█████▄█"
  83.  
  84. J3$(10) = "█▀███▀█"
  85. J3$(11) = "███████"
  86. J3$(12) = "█▄███▄█"
  87.  
  88. J3$(13) = "█▀███▀█"
  89. J3$(14) = "███ ███"
  90. J3$(15) = "█▄███▄█"
  91.  
  92.     FD1$ = "Roll #1:"
  93.     FD2$ = " Use F1-F7 to change colors...      F8=Arrows   F9=Abort   F10=Save Changes"
  94.  
  95.  
  96. 3 BOT = 0
  97. 4 TOP = 0
  98. 5 NO$ = "                                                                             "
  99. 9    '
  100. 10 ' BOARD COLORS       C1,BG,CB
  101. 11 ' DICE COLORS        C2,C6,CB
  102. 12 ' MESSAGE COLORS     C3,BG,CB
  103. 13 ' NAME COLORS        C4,BG,CB
  104. 14 ' TOTAL SCORE COLORS C5,BG,CB
  105. 15 ' WORDS              C7,BG,CB
  106. 16    '
  107. 17     '
  108. 18      '
  109. 19       '
  110.        
  111.     PRINT "Three color schemes are available:"
  112.     PRINT "Color, Monochrome, or Laptop system (C, M, or L)?"
  113. 1       V$ = INKEY$: IF V$ = "" THEN 1
  114.     IF V$ = "Q" OR V$ = "q" THEN GOTO quit2
  115.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 1
  116.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 1
  117.     IF V$ = CHR$(27) THEN GOTO quit2
  118.     IF V$ = "c" OR V$ = "C" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.col roll5.clr >nul": GOTO 2
  119.     IF V$ = "m" OR V$ = "M" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.mon roll5.clr >nul": GOTO 2
  120.     IF V$ = "l" OR V$ = "L" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.lap roll5.clr >nul": GOTO 2
  121.     GOTO 1
  122. 2 CLS
  123.  
  124. 20  OPEN "ROLL5.CLR" FOR INPUT AS #1
  125. 22  INPUT #1, c1: INPUT #1, C2: INPUT #1, C3: INPUT #1, c4: INPUT #1, c5: INPUT #1, c6: INPUT #1, C7: INPUT #1, Q1: INPUT #1, Q2
  126. 24  CLOSE #1
  127.     Q1$ = CHR$(Q1)
  128.     Q2$ = CHR$(Q2)
  129.  
  130. 30 GOSUB 7200      '         PRINTS "ROLL5" ACROSS TOP
  131.  
  132. 100 '
  133. 105 KEY OFF
  134.  
  135. 110 COLOR 14, 0
  136.     LOCATE 12, 26: PRINT "  To Play ROLL5 Press 'R'"
  137. 111 LOCATE 14, 26: PRINT "  To Set COLORS Press 'C'"
  138.     LOCATE 16, 26: PRINT " To See Hi SCORES Press 'S'"
  139.     LOCATE 18, 26: PRINT "  To QUIT Roll5 Press 'Q'"
  140.     LOCATE 25, 2: PRINT "Alt/I for Instructions";
  141.     GOSUB SD2
  142.     COLOR 1, 4
  143.     FOR GAB = 9 TO 21
  144.     LOCATE GAB, 20: PRINT "  ";
  145.     LOCATE GAB, 57: PRINT "  ";
  146.     NEXT GAB
  147.     COLOR 15, 4
  148.     LOCATE 8, 20: PRINT " At any time F10 toggles sound off/on! ";
  149.     COLOR 15, 4
  150.     LOCATE 22, 20: PRINT "     DolSOFT CREATIONS Version 2.0     ";
  151.     COLOR 14, 0
  152. 112 'CH$ = INPUT$(1)
  153.     V$ = INKEY$: IF V$ = "" THEN 112
  154.     CH$ = V$
  155.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  156.     IF MID$(CH$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 110
  157.     IF MID$(CH$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 110
  158.     IF CH$ = CHR$(27) THEN GOTO quit2
  159. 113 IF CH$ = "R" OR CH$ = "r" THEN
  160.         IF FirstGame$ = "N" THEN
  161.             CHAIN "roll5"
  162.             END IF
  163.         FirstGame$ = "N"
  164.         GOTO 160
  165.     END IF
  166. 114 IF CH$ = "C" OR CH$ = "c" THEN GOTO Colors
  167. 115 IF CH$ = "s" OR CH$ = "S" THEN
  168.     GOSUB ShowScores
  169.     GOTO 2
  170.     END IF
  171. 116 IF CH$ = "q" OR CH$ = "Q" THEN GOTO quit2
  172. 118 GOTO 112
  173.  
  174.  
  175. ShowScores:
  176. 20000 '********************** show HI SCORES ******************************
  177. 20001 '********************************************************************
  178. 20010 SHELL "SORT /R <ROLL5.SCO >HISCORES.DAT"
  179.     FOR KL = 6 TO 23: LOCATE KL, 1: PRINT NO$; : NEXT KL
  180. 20015 OPEN "HISCORES.DAT" FOR INPUT AS #1
  181. 20020 COLOR c5, BG, CB: LOCATE 5, 21: PRINT "========================================";
  182. 20025   COLOR C3, BG, CB
  183. 20030   FOR VB = 7 TO 23: INPUT #1, A$
  184.     LOCATE VB, 26: PRINT A$;
  185.     NEXT VB
  186.     CLOSE #1
  187.     COLOR c5, BG, CB: LOCATE 25, 2: PRINT "                   ========================================";
  188. 204     FOR alk = 1 TO 200: NEXT alk
  189.     LOCATE 25, 2: PRINT "press any key";
  190.     FOR alk = 1 TO 200: NEXT alk
  191.     LOCATE 25, 2: PRINT "PRESS ANY KEY";
  192. 20040 V$ = INKEY$: IF V$ = "" THEN 204
  193.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  194.     IF V$ = CHR$(27) THEN GOTO quit
  195.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 20040
  196.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 20040
  197.  
  198. 20050   RETURN
  199.  
  200. 150 SHELL "COLORS.BAS"
  201. 151 GOTO 2
  202.  
  203. 160 GOSUB 9000     '*********** PRINTS THE PLAYING SCREEN ******************
  204.  
  205. 200              '  *********** INPUTS THE NUMBER OF PLAYERS ***************
  206. 201 IF SD = 0 THEN BEEP
  207. 299 COLOR C3, BG, CB: LOCATE 25, 2: PRINT "  # OF PLAYERS (1-5)                              ";
  208. 300 N$ = INKEY$: IF N$ = "" THEN 300
  209.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  210.     IF N$ = CHR$(27) THEN GOTO quit
  211.     IF MID$(N$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 300
  212.     IF MID$(N$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 300
  213.  
  214. 301 IF ASC(N$) < 49 THEN 299
  215. 302 IF ASC(N$) > 53 THEN 299
  216. 303 N = VAL(N$)
  217. 307 COLOR C3, BG, CB: LOCATE 25, 4: PRINT NO$;
  218.     IF V$ = CHR$(27) THEN GOTO quit
  219.  
  220. 309 ROW = 6 '************  INPUTS THE NAMES OF THE PLAYERS *****************
  221. 310 FOR P = 1 TO N
  222. 330 IF SD = 0 THEN SOUND 880, .5
  223.     COLOR C3, BG, CB: LOCATE 25, 4: PRINT "ENTER PLAYER #"; P; "NAME OR INITIALS (1-7 LETTERS) ";
  224. 340 INPUT ; Player$(P): LOCATE 25, 4: PRINT NO$;
  225. 341 IF LEN(Player$(P)) = 0 THEN 330
  226. 342 IF LEN(Player$(P)) > 7 THEN 330
  227. 346 IF LEN(Player$(P)) < 3 THEN COL = 74
  228. 347 IF LEN(Player$(P)) = 3 THEN COL = 73
  229. 248 IF LEN(Player$(P)) = 4 THEN COL = 73
  230. 249 IF LEN(Player$(P)) = 5 THEN COL = 72
  231. 250 IF LEN(Player$(P)) = 6 THEN COL = 72
  232. 251 IF LEN(Player$(P)) = 7 THEN COL = 71
  233. 352 COLOR c4, BG, CB
  234. 353 LOCATE ROW, COL: PRINT UCASE$(Player$(P))
  235. 355 LOCATE ROW + 1, 75: COLOR c5, BG, CB: PRINT "0": ROW = ROW + 4
  236. 390 NEXT P
  237. 391 GOSUB 7100 '********** PRINTS PLAYERS' NAMES ACROSS TOP ****************
  238.  
  239.  
  240. 11000 '*****************  BEGIN 13 TURNS OF PLAY *************************
  241. 11002 FOR TURN = 1 TO 13
  242. 11004 FOR P = 1 TO N
  243. 11040 FOR TRY = 1 TO 3: TRY$ = STR$(TRY)
  244. 11045 IF SD = 0 THEN SOUND 440, .5
  245.     COLOR C3, BG, CB: LOCATE 25, 4: PRINT "OK, "; UCASE$(Player$(P)); ", For Roll #"; TRY$; ", Press The SPACEBAR !!               ";
  246. 11120 FOR XC = 6 TO 19: IF XC = 12 THEN 11121
  247.       IF XC = L THEN 11121
  248.       COLOR C2, BG, CB: LOCATE XC, 18 + 8 * P: PRINT Q1$; : LOCATE XC, 24 + 8 * P: PRINT Q2$;
  249.       COLOR c6, BG: LOCATE 6, 18 + 8 * P: PRINT Q1$; : LOCATE 6, 24 + 8 * P: PRINT Q2$;
  250. 11121 NEXT XC
  251. 11122 'IF sd = 0 THEN BEEP
  252.       'COLOR c6, BG: LOCATE 6, 26: PRINT Q1$; : LOCATE 6, 32: PRINT Q2$;
  253.     IF TRY > 1 THEN 11124
  254. 11123 'V$ = INPUT$(1)
  255.     V$ = INKEY$: IF V$ = "" THEN 11123
  256.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  257.     IF V$ = CHR$(27) THEN GOTO quit
  258.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 11123
  259.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 11123
  260.     IF ASC(V$) <> 32 THEN GOTO 11122
  261. 11124 LOCATE 25, 4: PRINT NO$;
  262.     IF GI = 0 THEN LOCATE 4, 1: PRINT NO$; : GI = 1
  263. 11125 R = 1: C = -1
  264. 11126 FOR DICE = 1 TO 5 '       ROLLS THE DICE
  265.     COLOR C3, BG, CB: FOR VV = 1 TO 5: LOCATE 2, VV * 13 + 6: PRINT VV; : NEXT VV
  266. 11127 C = C + 13
  267. 11130 IF KEEP(DICE) = 1 THEN 11270
  268. 11135 'V$=TIME$: R1$=MID$(V$,7,2): R1=VAL(R$): RANDOMIZE 1
  269. 11136 V$ = MID$(TIME$, 7, 2)
  270. 11137 RANDOMIZE VAL(V$)
  271. 11140 roll = INT(6 * RND) + 1
  272. 11150 COUNT(DICE) = roll
  273. 11209 LOCATE 1, 1: PRINT "Roll #"; TRY$;
  274. 11210 ON roll GOSUB 7010, 7020, 7030, 7040, 7050, 7060
  275. 11270 NEXT DICE
  276. 11280 'CALL SOUND
  277. 11281 L = 6
  278.  
  279. 11282 COLOR C3, BG, CB: LOCATE 25, 4: PRINT UCASE$(Player$(P)); ",s Options:  0, 1, 2, 3, 4, 5, "; CHR$(24); " ,"; CHR$(25); " , SPACEBAR, or ENTER       ";
  280.  
  281. 11300  '
  282. 11301 FOR JJ = 6 TO 19:
  283. 11303 IF JJ = L THEN 11306
  284. 11304 IF JJ = 12 THEN 11306
  285. 11305 COLOR C2, BG, CB: LOCATE JJ, 18 + 8 * P: PRINT Q1$; : LOCATE JJ, 24 + 8 * P: PRINT Q2$;
  286. 11306 NEXT JJ
  287. 11307   V$ = INKEY$: IF V$ = "" THEN 11307
  288.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  289.     IF V$ = CHR$(27) THEN GOTO quit
  290.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 11307
  291.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 11307
  292.  
  293. 11310 'IF LEN(V$) = 2 THEN V$ = RIGHT$(V$, 1)
  294. 11320 IF ASC(V$) = 13 THEN 14000'CR
  295.        
  296. '        IF LEN(V$) = 2 THEN V$ = LEFT$(V$, 1)
  297. 11330 IF MID$(V$, 2, 1) = "H" THEN 12500'MINUS     DONE
  298. 11340 IF MID$(V$, 2, 1) = "P" THEN 12600'PLUS      DONE
  299. 11350 IF ASC(V$) = 32 THEN 11390'SPACEBAR
  300. 11352 IF ASC(V$) = 48 THEN 13000'ZERO      DONE
  301. 11360 IF ASC(V$) < 49 THEN 11300
  302. 11361 IF ASC(V$) > 53 THEN 11300
  303. 11380 V = VAL(V$): ON V GOSUB 13100, 13200, 13300, 13400, 13500
  304. 11385 GOTO 11280
  305. 11390 IF TRY = 3 THEN 11300
  306. 11411 NEXT TRY
  307.  
  308. 11440 'GOSUB 13000
  309. 11450 FOR XX = 1 TO 5: KEEP(XX) = 0: NEXT XX
  310. 11451 LOCATE 4, 1: PRINT NO$
  311. 11452 L = 5
  312. 11453 FOR FF = 6 TO 19: IF FF = 12 THEN 11455
  313. 11454 LOCATE FF, 3: PRINT " ";
  314. 11455 NEXT FF
  315. 11459 FOR BK = 1 TO 3: LOCATE BK, 1: PRINT NO$: NEXT BK: NEXT P
  316. 11460 NEXT TURN
  317. 11470 GOTO 15000
  318.  
  319.  
  320. 6100 '**************TO PRINT NAMES AND DICE NUMBERS (1-5)******************
  321. 6105 COLOR 3, 5, 0: LOCATE 8, 24: PRINT Player$(1): LOCATE 8, 34: PRINT Player$(2)
  322. 6110 GOTO 6110
  323.  
  324.  
  325. 7000 '**********************FOR PRINTING DICE******************
  326. 7010 'ONE
  327. 7011 IF SD = 0 THEN SOUND 220, 2
  328.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  329. 7012 COLOR C2, c6, CB: LOCATE R, C: PRINT "███████": LOCATE R + 1, C: PRINT "███ ███": LOCATE R + 2, C: PRINT "███████"
  330. 7013 RETURN
  331. 7020 'TWO
  332. 7021 IF SD = 0 THEN SOUND 247, 2
  333.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  334. 7022 COLOR C2, c6, CB: LOCATE R, C: PRINT "█▀█████": LOCATE R + 1, C: PRINT "███████": LOCATE R + 2, C: PRINT "█████▄█"
  335. 7023 RETURN
  336. 7030 'THREE
  337. 7031 IF SD = 0 THEN SOUND 261.6, 2
  338.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  339. 7032 COLOR C2, c6, CB: LOCATE R, C: PRINT "█▀█████": LOCATE R + 1, C: PRINT "███ ███": LOCATE R + 2, C: PRINT "█████▄█"
  340. 7033 RETURN
  341. 7040 'FOUR
  342. 7041 IF SD = 0 THEN SOUND 293.6, 2
  343.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  344. 7042 COLOR C2, c6, CB: LOCATE R, C: PRINT "█▀███▀█": LOCATE R + 1, C: PRINT "███████": LOCATE R + 2, C: PRINT "█▄███▄█"
  345. 7043 RETURN
  346. 7050 'FIVE
  347. 7051 IF SD = 0 THEN SOUND 329.6, 2
  348.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  349. 7052 COLOR C2, c6, CB: LOCATE R, C: PRINT "█▀███▀█": LOCATE R + 1, C: PRINT "███ ███": LOCATE R + 2, C: PRINT "█▄███▄█"
  350. 7053 RETURN
  351. 7060 'SIX
  352. 7061 IF SD = 0 THEN SOUND 349.23, 2
  353.     FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT "       "; : NEXT AQ
  354. 7062 COLOR C2, c6, CB: LOCATE R, C: PRINT "█▀█▀█▀█": LOCATE R + 1, C: PRINT "███████": LOCATE R + 2, C: PRINT "█▄█▄█▄█"
  355. 7063 RETURN
  356.  
  357. 7100 '************* PRINTS PLAYERS' NAME ON TOP OF COLUMNS *****************
  358. 7101 CL = 25
  359. 7102 COLOR c4, BG, CB
  360. 7105 FOR P = 1 TO N
  361. 7110 IF LEN(Player$(P)) = 7 THEN PL = CL + 1: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  362. 7111 IF LEN(Player$(P)) = 6 THEN PL = CL + 2: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  363. 7112 IF LEN(Player$(P)) = 5 THEN PL = CL + 2: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  364. 7113 IF LEN(Player$(P)) = 4 THEN PL = CL + 3: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  365. 7114 IF LEN(Player$(P)) = 3 THEN PL = CL + 3: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  366. 7115 IF LEN(Player$(P)) = 2 THEN PL = CL + 4: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  367. 7116 IF LEN(Player$(P)) = 1 THEN PL = CL + 4: LOCATE 5, PL: PRINT UCASE$(Player$(P));
  368. 7117 CL = CL + 8
  369. 7118 NEXT P
  370. 7119 RETURN
  371.  
  372. 7200 ' ******************** DISPLAYS "R O L L 5" *************************
  373. 7201 COLOR C2, CB, CB
  374. 7205 ' OPEN "ROLL.5" FOR INPUT AS #1
  375. 7207 FOR x = 1 TO 4
  376. 7210 'INPUT #1, R$(x)
  377. LOCATE x, 12: PRINT R$(x)
  378. 7212 NEXT x
  379. 7214 'CLOSE #1
  380. 7216 RETURN
  381.  
  382. 9000 ' **************** PRINT SCORE CARD FOR 5 PEOPLE ********************
  383. 9001 COLOR c1, BG, CB
  384.  
  385.  
  386. 9004 'OPEN "ROLL5.S1" FOR INPUT AS #1
  387. 9005 'FOR x = 1 TO 20
  388. 9010 'INPUT #1, A$(x)
  389. 9015 'NEXT x
  390. 9020 FOR x = 1 TO 19
  391. 9025 LOCATE x + 3, 3: PRINT A$(x);
  392. 9030 NEXT x
  393. 9032 LOCATE 23, 3: PRINT A$(20);
  394. 9033 'CLOSE #1
  395.  
  396.  
  397. 9100 'OPEN "ROLL5.S2" FOR INPUT AS #1
  398. 9105 'FOR x = 1 TO 16
  399. 9110 'INPUT #1, a$(x)
  400. 9115 'NEXT x
  401. 9117 'CLOSE #1
  402. 9119 ROW = 6: COL = 4
  403. 9120 COLOR C7, BG, CB: LOCATE ROW, COL: PRINT B$(1)
  404. 9121 LOCATE ROW + 1, COL: PRINT B$(2)
  405. 9122 LOCATE ROW + 2, COL: PRINT B$(3)
  406. 9123 LOCATE ROW + 3, COL: PRINT B$(4)
  407. 9124 LOCATE ROW + 4, COL: PRINT B$(5)
  408. 9125 LOCATE ROW + 5, COL: PRINT B$(6)
  409. 9126 LOCATE ROW + 7, COL: PRINT B$(7)
  410. 9127 LOCATE ROW + 8, COL: PRINT B$(8)
  411. 9128 LOCATE ROW + 9, COL: PRINT B$(9)
  412. 9129 LOCATE ROW + 10, COL: PRINT B$(10)
  413. 9130 LOCATE ROW + 11, COL: PRINT B$(11)
  414. 9131 LOCATE ROW + 12, COL: PRINT B$(12)
  415. 9132 LOCATE ROW + 13, COL: PRINT B$(13)
  416. 9133 LOCATE ROW + 15, COL: PRINT B$(14)
  417. 9134 LOCATE ROW + 16, COL: PRINT B$(15)
  418. 9135 LOCATE ROW + 17, COL: PRINT B$(16)
  419. 9200 RETURN
  420.  
  421.  
  422. 15000 GOTO 19000 'END OF GAME
  423.  
  424. 12500  '***************** TO MOVE ARROW UP ONE LINE **********************
  425. 12501 COLOR C2, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$;
  426. 12502 L = L - 1: IF L < 6 THEN L = 19
  427. 12503 IF L = 12 THEN L = L - 1
  428. 12505 COLOR c6, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$;
  429. 12599 GOTO 11282
  430.  
  431. 12600 '**************** TO MOVE ARROW DOWN ONE LINE ***********************
  432. 12601 COLOR C2, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + P * 8: PRINT Q2$;
  433. 12602 L = L + 1: IF L > 19 THEN L = 6
  434. 12603 IF L = 12 THEN L = L + 1
  435. 12605 COLOR c6, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$;
  436. 12699 GOTO 11282
  437.  
  438. 13000 '************** ON ZERO TO SET ALL DICE FLAGS TO 0 *******************
  439. 13001 IF SD = 0 THEN SOUND 880, .5
  440.     COLOR C3, BG, CB
  441. 13002 FOR FL = 1 TO 5
  442. 13005 KEEP(FL) = 0
  443. 13007 NEXT FL
  444. 13008 LOCATE 4, 1: PRINT NO$
  445. 13009 GOTO 11282
  446.  
  447. 13100 '******************** TO SET DIE #1 ********************************
  448. 13101 IF SD = 0 THEN SOUND 440, .5
  449.     COLOR C3, BG, CB
  450. 13105 IF KEEP(1) = 1 THEN KEEP(1) = 0: GOTO 13150
  451. 13110 KEEP(1) = 1
  452. 13130 LOCATE 4, 13: PRINT K$;
  453. 13140 GOTO 11282
  454. 13150 LOCATE 4, 13: PRINT "    ";
  455. 13152 GOTO 11282
  456.  
  457. 13200 '********************** TO SET DIE #2 *******************************
  458. 13201 IF SD = 0 THEN SOUND 494, .5
  459.     COLOR C3, BG, CB
  460. 13205 IF KEEP(2) = 1 THEN KEEP(2) = 0: GOTO 13250
  461. 13210 KEEP(2) = 1
  462. 13230 LOCATE 4, 26: PRINT K$;
  463. 13240 GOTO 11282
  464. 13250 LOCATE 4, 26: PRINT "    ";
  465. 13252 GOTO 11282
  466.  
  467. 13300 '******************** TO SET DIE #3  ********************************
  468. 13301 IF SD = 0 THEN SOUND 523.2, .5
  469.     COLOR C3, BG, CB
  470. 13305 IF KEEP(3) = 1 THEN KEEP(3) = 0: GOTO 13350
  471. 13310 KEEP(3) = 1
  472. 13330 LOCATE 4, 39: PRINT K$;
  473. 13340 GOTO 11282
  474. 13350 LOCATE 4, 39: PRINT "    ";
  475. 13352 GOTO 11282
  476.  
  477. 13400 '*********************  TO SET DIE #4  ******************************
  478. 13401 IF SD = 0 THEN SOUND 587.4, .5
  479.     COLOR C3, BG, CB
  480. 13405 IF KEEP(4) = 1 THEN KEEP(4) = 0: GOTO 13450
  481. 13410 KEEP(4) = 1
  482. 13430 LOCATE 4, 52: PRINT K$;
  483. 13440 GOTO 11282
  484. 13450 LOCATE 4, 52: PRINT "    ";
  485. 13452 GOTO 11282
  486.  
  487. 13500 '***********************  TO SET DIE #5  *****************************
  488. 13501 IF SD = 0 THEN SOUND 659.2, .5
  489.     COLOR C3, BG, CB
  490. 13505 IF KEEP(5) = 1 THEN KEEP(5) = 0: GOTO 13550
  491. 13510 KEEP(5) = 1
  492. 13530 LOCATE 4, 65: PRINT K$;
  493. 13540 GOTO 11282
  494. 13550 LOCATE 4, 65: PRINT "    ";
  495. 13552 GOTO 11282
  496.  
  497. 14000 '*********************  CHECKS CARRIAGE RETURN  ***********************
  498. 14001 FOR PR = 6 TO 19: IF PR = 12 THEN 14003
  499. 14002 LOCATE PR, 18 + 8 * P: PRINT " "; : LOCATE PR, 24 + 8 * P: PRINT " ";
  500. 14003 NEXT PR
  501. 14008 COLOR C3, BG, CB
  502. 14009 ON L GOTO 1, 2, 3, 4, 5, 14010, 14030, 14050, 14070, 14090, 14110, 12, 14130, 14230, 14400, 14600, 14500, 14700, 14800
  503.  
  504. 14010 IF OK$(P, L) = "Y" THEN 11300'*************** CHECK FOR ONES ************
  505. 14011 fLAG = 0
  506. 14012 FOR ZZ = 1 TO 5
  507. 14014 IF COUNT(ZZ) = 1 THEN fLAG = fLAG + 1
  508. 14016 NEXT ZZ
  509. 14018 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  510. 14020 LOCATE 6, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  511. 14021 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  512.  
  513.  
  514.  
  515. 14030 IF OK$(P, L) = "Y" THEN 11300' ************** CHECK FOR TWOS ************
  516. 14031 fLAG = 0
  517. 14032 FOR ZZ = 1 TO 5
  518. 14033 IF COUNT(ZZ) = 2 THEN fLAG = fLAG + 2
  519. 14034 NEXT ZZ
  520. 14035 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  521. 14036 LOCATE 7, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  522. 14037 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  523.  
  524. 14050 IF OK$(P, L) = "Y" THEN 11300'************ check for threes *************
  525. 14051 fLAG = 0
  526. 14052 FOR ZZ = 1 TO 5
  527. 14053 IF COUNT(ZZ) = 3 THEN fLAG = fLAG + 3
  528. 14054 NEXT ZZ
  529. 14055 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  530. 14056 LOCATE 8, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  531. 14057 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  532.  
  533. 14070 IF OK$(P, L) = "Y" THEN 11300'**************  CHECK FOR FOURS ***********
  534. 14071 fLAG = 0
  535. 14072 FOR ZZ = 1 TO 5
  536. 14073 IF COUNT(ZZ) = 4 THEN fLAG = fLAG + 4
  537. 14074 NEXT ZZ
  538. 14075 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  539. 14076 LOCATE 9, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  540. 14077 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  541.  
  542. 14090 IF OK$(P, L) = "Y" THEN 11300' **************  CHECK FOR FIVES  **********
  543. 14091 fLAG = 0
  544. 14092 FOR ZZ = 1 TO 5
  545. 14093 IF COUNT(ZZ) = 5 THEN fLAG = fLAG + 5
  546. 14094 NEXT ZZ
  547. 14095 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  548. 14096 LOCATE 10, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  549. 14097 GOSUB 16000:  OK$(P, L) = "Y"
  550. 14098 GOTO 14999
  551.  
  552. 14110 IF OK$(P, L) = "Y" THEN 11300'*************  CHECK FOR SIXES *************
  553. 14111 fLAG = 0
  554. 14112 FOR ZZ = 1 TO 5
  555. 14113 IF COUNT(ZZ) = 6 THEN fLAG = fLAG + 6
  556. 14114 NEXT ZZ
  557. 14115 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000
  558. 14116 LOCATE 11, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P)
  559. 14117 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  560.  
  561. 14130 IF OK$(P, L) = "Y" THEN 11300'*********** CHECK FOR 3 OF A KIND **********
  562. 14131 fLAG = 0: FOR Y = 1 TO 5: C(Y) = COUNT(Y): NEXT Y
  563. 14132 IF (C(1) = C(2)) AND (C(2) = C(3)) THEN 14145
  564. 14133 IF (C(1) = C(2)) AND (C(1) = C(4)) THEN 14145
  565. 14134 IF (C(1) = C(2)) AND (C(1) = C(5)) THEN 14145
  566. 14135 IF (C(1) = C(3)) AND (C(1) = C(4)) THEN 14145
  567. 14136 IF (C(1) = C(3)) AND (C(1) = C(5)) THEN 14145
  568. 14137 IF (C(1) = C(4)) AND (C(1) = C(5)) THEN 14145
  569. 14138 IF (C(2) = C(3)) AND (C(3) = C(4)) THEN 14145
  570. 14139 IF (C(2) = C(4)) AND (C(4) = C(5)) THEN 14145
  571. 14140 IF (C(2) = C(3)) AND (C(3) = C(5)) THEN 14145
  572. 14141 IF (C(3) = C(4)) AND (C(4) = C(5)) THEN 14145
  573. 14142 GOTO 14147
  574. 14145 FOR ZZ = 1 TO 5: fLAG = fLAG + C(ZZ): NEXT ZZ
  575. 14146 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P))
  576. 14147 LOCATE 13, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  577. 14148 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  578.  
  579.  
  580. 14230 IF OK$(P, L) = "Y" THEN 11300'***********  CHECK FOR 4 OF A KIND *******
  581. 14231 fLAG = 0: FOR Y = 1 TO 5: C(Y) = COUNT(Y): NEXT Y
  582. 14232 IF (C(1) = C(2)) AND (C(2) = C(3)) AND (C(1) = C(4)) THEN 14300
  583. 14233 IF (C(1) = C(2)) AND (C(1) = C(4)) AND (C(4) = C(5)) THEN 14300
  584. 14234 IF (C(1) = C(2)) AND (C(1) = C(5)) AND (C(5) = C(3)) THEN 14300
  585. 14235 IF (C(1) = C(3)) AND (C(1) = C(4)) AND (C(4) = C(5)) THEN 14300
  586. 14241 IF (C(2) = C(3)) AND (C(3) = C(4)) AND (C(4) = C(5)) THEN 14300
  587. 14299 GOTO 14304
  588. 14300 FOR ZZ = 1 TO 5: fLAG = fLAG + C(ZZ): NEXT ZZ
  589. 14302 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P))
  590. 14304 LOCATE 14, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  591. 14306 GOSUB 16000:   OK$(P, L) = "Y": GOTO 14999
  592.  
  593. 14400 IF OK$(P, L) = "Y" THEN 11300'************* CHECK FOR FULL HOUSE *******
  594. 14401 fLAG = 0: GOSUB 17000
  595. 14402 IF (COUNT(1) = COUNT(2)) AND (COUNT(2) = COUNT(3)) AND (COUNT(4) = COUNT(5)) THEN 14410
  596. 14403 IF (COUNT(1) = COUNT(2)) AND (COUNT(3) = COUNT(4)) AND (COUNT(4) = COUNT(5)) THEN 14410
  597. 14404 GOTO 14411
  598. 14410 fLAG = 25
  599. 14411 LOCATE 15, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG;
  600. 14412 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  601. 14413 GOSUB 16000:  OK$(P, L) = "Y": GOTO 14999
  602.  
  603. 14500 IF OK$(P, L) = "Y" THEN 11300'************  CHECK FOR LARGE STRAIGHT *****
  604. 14501 fLAG = 0
  605. 14502 GOSUB 17000
  606. 14503 IF (COUNT(1) = COUNT(2) - 1) AND (COUNT(2) = COUNT(3) - 1) AND (COUNT(3) = COUNT(4) - 1) AND (COUNT(4) = COUNT(5) - 1) THEN 14515
  607. 14511 GOTO 14516
  608. 14515 fLAG = 40
  609. 14516 LOCATE 17, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG;
  610. 14517 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  611. 14518 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999
  612.  
  613. 14600 IF OK$(P, L) = "Y" THEN 11300'************ CHECK FOR SMALL STRAIGHT ******
  614. 14601 fLAG = 0
  615. 14602 GOSUB 17000       'OPEN "SORTIN.DAT" FOR OUTPUT AS #3
  616. 14603 FOR RR = 1 TO 5: roll(RR) = COUNT(RR): NEXT RR
  617.        
  618.     '???????
  619.     'IF roll(1) = roll(2) THEN roll(2) = roll(3): roll(3) = roll(4): roll(4) = roll(5)
  620.        
  621.     IF roll(2) = roll(3) THEN roll(3) = roll(4): roll(4) = roll(5)
  622.     IF roll(3) = roll(4) THEN roll(4) = roll(5)
  623.  
  624.     IF (roll(1) = roll(2) - 1) AND (roll(2) = roll(3) - 1) AND (roll(3) = roll(4) - 1) THEN 14620
  625.     IF (roll(2) = roll(3) - 1) AND (roll(3) = roll(4) - 1) AND (roll(4) = roll(5) - 1) THEN 14620
  626.  
  627. 14605 'SHELL "SORT <SORTIN.DAT >SORTOUT.DAT"
  628. 14606 'OPEN "SORTOUT.DAT" FOR INPUT AS #3
  629. 14607 'FOR ZZ=1 TO 5: INPUT #3,COUNT(ZZ): NEXT ZZ : CLOSE #3
  630. 14608 IF (COUNT(1) = COUNT(2) - 1) AND (COUNT(2) = COUNT(3) - 1) AND (COUNT(3) = COUNT(4) - 1) THEN 14620
  631. 14609 IF (COUNT(2) = COUNT(3) - 1) AND (COUNT(3) = COUNT(4) - 1) AND (COUNT(4) = COUNT(5) - 1) THEN 14620
  632. 14610 GOTO 14621
  633. 14620 fLAG = 30
  634. 14621 LOCATE 16, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG;
  635. 14622 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  636. 14623 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999
  637.  
  638.  
  639. 14700             '************** CHECK FOR ROLL5 *************
  640. 14701 '
  641. 14702 IF (COUNT(1) = COUNT(2)) AND (COUNT(2) = COUNT(3)) AND (COUNT(3) = COUNT(4)) AND (COUNT(4) = COUNT(5)) THEN CNT(P) = CNT(P) + 1: GOSUB 21000: GOTO 14710
  642.     IF CNT(P) > 0 THEN 11300
  643.     fLAG = 0: GOTO 14720
  644. 14710 IF CNT(P) = 1 THEN fLAG = 50
  645.     IF CNT(P) > 1 THEN fLAG = 100
  646. 14720 LOCATE 18, 23 - LEN(STR$(fLAG)) + 8 * P: DL = CNT(P) * 100 - 50: IF DL < 0 THEN DL = 0
  647.     PRINT DL;
  648.     SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  649.     GOSUB 16000
  650. 14725 IF fLAG = 50 OR fLAG = 0 THEN 14999  ' ****FOR NEXT PLAYER****
  651.     IF fLAG = 100 THEN P = P - 1: GOTO 14999'****FOR EXTRA TURN****
  652.  
  653.  
  654.  
  655. 14800 IF OK$(P, L) = "Y" THEN 11300'************* ENTER SCORE FOR CHANCE ********
  656. 14801 fLAG = 0: FOR ZZ = 1 TO 5: fLAG = fLAG + COUNT(ZZ): NEXT ZZ
  657. 14802 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P)
  658. 14803 LOCATE 19, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG;
  659. 14804 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999
  660.  
  661. 14999 GOTO 11450
  662.  
  663. 17000 FOR II = 1 TO 5' ********* SORTS THE FIVE DICE *********
  664. 17001 FOR JJ = II TO 5
  665. 17002 IF COUNT(II) <= COUNT(JJ) THEN 17006
  666. 17003 HNUM = COUNT(JJ)
  667. 17004 COUNT(JJ) = COUNT(II)
  668. 17005 COUNT(II) = HNUM
  669. 17006 NEXT JJ
  670. 17007 NEXT II
  671. 17015 RETURN
  672.  
  673. 18000 '  SETS EXTRA 35 POINTS FOR TOP PORTION SCORE OF 63+
  674. 18001 ' ***************************************************
  675. 18005 IF FL$(P) = "Y" THEN 18050
  676. 18010 FL$(P) = "Y"
  677. 18012 LOCATE 22, 20 + 8 * P: PRINT 35: SCORE(P) = SCORE(P) + 35: GOSUB 16000
  678. 18050 RETURN
  679.  
  680. 16000 IF P = 1 THEN LOCATE 7, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P)
  681. 16001 IF P = 2 THEN LOCATE 11, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P)
  682. 16002 IF P = 3 THEN LOCATE 15, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P)
  683. 16003 IF P = 4 THEN LOCATE 19, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P)
  684. 16004 IF P = 5 THEN LOCATE 23, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P)
  685. 16006 GOSUB 21200:   RETURN
  686.  
  687. 19000 '            ************* END OF GAME **************
  688. 19001   GOSUB 19500
  689.     CLS
  690.     GOSUB ShowScores
  691.     GOTO quit2
  692. 19002 V$ = INKEY$: IF V$ = "" THEN 19002
  693.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  694.     IF V$ = CHR$(27) THEN GOTO quit
  695.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 19002
  696.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 19002
  697.  
  698. 19003 IF SD = 0 THEN BEEP
  699.     GOTO 2
  700. 19005 LOCATE 25, 1: PRINT "Play Again or End play?  Press P or E!                                  ";
  701. 19010 V$ = INKEY$: IF V$ = "" THEN 19010
  702.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  703.     IF V$ = CHR$(27) THEN GOTO quit
  704.     IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 19010
  705.     IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 19010
  706.  
  707. 19015 IF V$ = "p" OR V$ = "P" THEN GI = 0: GOTO 19100
  708. 19020 IF V$ = "e" OR V$ = "E" THEN 19200
  709. 19030 IF SD = 0 THEN BEEP
  710.     GOTO 19010
  711.  
  712. 19100 GOSUB 19500:  GOTO 1
  713.  
  714. 19200 GOSUB 19500:  SYSTEM
  715.  
  716. 19500 '                       to save scores
  717. 19501 '                     ******************
  718. 19510 OPEN "roll5.sco" FOR APPEND AS #4
  719. 19514 FOR kp = 1 TO N
  720. 19515 IF SCORE(kp) > 99 THEN PRINT #4, SCORE(kp); TAB(10); UCASE$(Player$(kp)); TAB(22); DATE$
  721. 19520 NEXT kp:  CLOSE #4:  RETURN
  722.  
  723.  
  724. 21000 '              sounds sounds sounds sounds
  725. 21001 '            *******************************
  726. 21105 IF SD = 0 THEN FOR SND = 440 TO 1000 STEP 5: SOUND SND, .5: NEXT
  727. 21110 IF SD = 0 THEN FOR SND = 1000 TO 440 STEP -5: SOUND SND, .5: NEXT
  728. 21115 RETURN
  729.  
  730. 21200 IF SD = 0 THEN SOUND 440, 1: SOUND 880, 1: SOUND 440, 1: SOUND 880, 1
  731.     RETURN
  732.  
  733.  
  734. SD2:
  735.     IF SD = 0 THEN LOCATE 25, 68: PRINT "Sound is ON ";
  736.     IF SD = 1 THEN LOCATE 25, 68: PRINT "Sound is OFF";
  737.     RETURN
  738.  
  739. Colors:   CLS
  740. CLR1:
  741.  
  742.  
  743.       'OPEN "roll5.s1" FOR INPUT AS #11
  744.       'FOR WW = 1 TO 20
  745.       'INPUT #11, J1$(WW)
  746.       'NEXT WW
  747.       'CLOSE #11
  748.      
  749.       'OPEN "roll5.s2" FOR INPUT AS #12
  750.       'FOR WW = 1 TO 16
  751.       'INPUT #12, J2$(WW)
  752.       'NEXT WW
  753.       'CLOSE #12
  754.  
  755.  
  756. CLR2:
  757.     COLOR C3, BG
  758.     LOCATE 1, 3: PRINT FD1$;
  759.     LOCATE 25, 3: PRINT FD2$;
  760.     LOCATE 2, 23: PRINT "1           2           3           4           5";
  761.     LOCATE 4, 16: PRINT K$
  762.     LOCATE 4, 40: PRINT K$
  763.        
  764.       COLOR C2, c6
  765.     LOCATE 1, 15: PRINT J3$(1);
  766.     LOCATE 2, 15: PRINT J3$(2);
  767.     LOCATE 3, 15: PRINT J3$(3);
  768.     LOCATE 1, 27: PRINT J3$(4);
  769.     LOCATE 2, 27: PRINT J3$(5);
  770.     LOCATE 3, 27: PRINT J3$(6);
  771.     LOCATE 1, 39: PRINT J3$(7);
  772.     LOCATE 2, 39: PRINT J3$(8);
  773.     LOCATE 3, 39: PRINT J3$(9);
  774.     LOCATE 1, 51: PRINT J3$(10);
  775.     LOCATE 2, 51: PRINT J3$(11);
  776.     LOCATE 3, 51: PRINT J3$(12);
  777.     LOCATE 1, 63: PRINT J3$(13);
  778.     LOCATE 2, 63: PRINT J3$(14);
  779.     LOCATE 3, 63: PRINT J3$(15);
  780.      
  781.       COLOR c1, BG
  782.       FOR WW = 1 TO 20
  783.       LOCATE WW + 4, 1: PRINT A$(WW);
  784.       NEXT WW
  785.      
  786.       COLOR C7, BG
  787.       WWC = 6
  788.       FOR WW = 1 TO 16
  789.       LOCATE WWC, 4: PRINT B$(WW);
  790.       WWC = WWC + 1
  791.       IF WWC = 12 THEN WWC = 13
  792.       IF WWC = 20 THEN WWC = 21
  793.       NEXT WW
  794.        
  795.       COLOR c4, BG
  796.       LOCATE 5, 73: PRINT "Bob";
  797.       LOCATE 9, 73: PRINT "Jim";
  798.       LOCATE 13, 72: PRINT "Jane";
  799.       LOCATE 17, 71: PRINT "Tarzan";
  800.       LOCATE 21, 73: PRINT "DOL";
  801.      
  802.       LOCATE 5, 28: PRINT "Bob";
  803.       LOCATE 5, 36: PRINT "Jim";
  804.       LOCATE 5, 43: PRINT "Jane";
  805.       LOCATE 5, 50: PRINT "Tarzan";
  806.       LOCATE 5, 60: PRINT "DOL";
  807.     
  808.  
  809.     COLOR C2, BG
  810.     FOR WW = 6 TO 11
  811.     LOCATE WW, 26: PRINT Q1$; "     "; Q2$;
  812.     NEXT WW
  813.        
  814.     FOR WW = 13 TO 19
  815.     LOCATE WW, 26: PRINT Q1$; "     "; Q2$;
  816.     NEXT WW
  817.        
  818.     FOR WW = 21 TO 23
  819.     LOCATE WW, 26: PRINT Q1$; "     "; Q2$;
  820.     NEXT WW
  821.  
  822.     COLOR c6, BG
  823.     LOCATE 8, 26: PRINT Q1$; "     "; Q2$;
  824.      
  825.       COLOR c5, BG
  826.       LOCATE 6, 30: PRINT "3";
  827.       LOCATE 7, 30: PRINT "8";
  828.       LOCATE 8, 29: PRINT "12";
  829.       LOCATE 7, 73: PRINT "000";
  830.       LOCATE 11, 73: PRINT "000";
  831.       LOCATE 15, 73: PRINT "000";
  832.       LOCATE 19, 73: PRINT "000";
  833.       LOCATE 23, 73: PRINT "000";
  834.       
  835.  
  836. LOCATE 25, 1, 0
  837. GH:     V$ = INKEY$: IF V$ = "" THEN GOTO GH
  838.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  839.     IF MID$(V$, 2, 1) = ";" THEN c1 = c1 + 1: IF c1 > 15 THEN c1 = 1
  840.     IF MID$(V$, 2, 1) = "<" THEN C2 = C2 + 1: IF C2 > 15 THEN C2 = 1
  841.     IF MID$(V$, 2, 1) = "=" THEN C3 = C3 + 1: IF C3 > 15 THEN C3 = 1
  842.     IF MID$(V$, 2, 1) = ">" THEN c4 = c4 + 1: IF c4 > 15 THEN c4 = 1
  843.     IF MID$(V$, 2, 1) = "?" THEN c5 = c5 + 1: IF c5 > 15 THEN c5 = 1
  844.     IF MID$(V$, 2, 1) = "@" THEN c6 = c6 + 1: IF c6 > 15 THEN c6 = 1
  845.     IF MID$(V$, 2, 1) = "A" THEN C7 = C7 + 1: IF C7 > 15 THEN C7 = 1
  846.     IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(16) THEN Q1$ = CHR$(26): Q2$ = CHR$(27): GOTO CLR2
  847.     IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(26) THEN Q1$ = CHR$(254): Q2$ = CHR$(254): GOTO CLR2
  848.     IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(254) THEN Q1$ = CHR$(1): Q2$ = CHR$(1): GOTO CLR2
  849.     IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(1) THEN Q1$ = CHR$(16): Q2$ = CHR$(17): GOTO CLR2
  850.     IF MID$(V$, 2, 1) = "C" THEN GOTO CLR5  'abort changes
  851.     IF MID$(V$, 2, 1) = "D" THEN GOTO CLR6  'save changes
  852.     GOTO CLR2
  853.  
  854. CLR5:   CLS : GOTO 30
  855.  
  856. CLR6:   COLOR 14, 4
  857.     LOCATE 12, 12: PRINT " ╔═══════════════════════════════╗ "
  858.     LOCATE 13, 12: PRINT " ║                               ║ "
  859.     LOCATE 14, 12: PRINT " ║                               ║ "
  860.     LOCATE 15, 12: PRINT " ║                               ║ "
  861.     LOCATE 16, 12: PRINT " ║                               ║ "
  862.     LOCATE 17, 12: PRINT " ╚═══════════════════════════════╝ "
  863.     COLOR 0, 14
  864.     LOCATE 13, 14: PRINT " Save these color changes for: "
  865.     COLOR 7, 4
  866.     LOCATE 14, 15: PRINT "        Color system"
  867.     LOCATE 15, 15: PRINT "        Mono system"
  868.     LOCATE 16, 15: PRINT "        Laptop system"
  869.     COLOR 14, 4
  870.     LOCATE 14, 15: PRINT "        C"
  871.     LOCATE 15, 15: PRINT "        M"
  872.     LOCATE 16, 15: PRINT "        L"
  873. CL:     V$ = INKEY$: IF V$ = "" THEN GOTO CL
  874.     IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help
  875.     IF V$ = "C" OR V$ = "c" THEN XFile$ = "roll5.col": GOTO CL9
  876.     IF V$ = "M" OR V$ = "m" THEN XFile$ = "roll5.mon": GOTO CL9
  877.     IF V$ = "L" OR V$ = "l" THEN XFile$ = "roll5.lap": GOTO CL9
  878.     GOTO CL
  879. CL9:    OPEN XFile$ FOR OUTPUT AS #9
  880.     PRINT #9, c1
  881.     PRINT #9, C2
  882.     PRINT #9, C3
  883.     PRINT #9, c4
  884.     PRINT #9, c5
  885.     PRINT #9, c6
  886.     PRINT #9, C7
  887.     PRINT #9, ASC(Q1$)
  888.     PRINT #9, ASC(Q2$)
  889.     CLOSE #9
  890.     COLOR 4, 0
  891.     CLS
  892.     GOTO 19
  893.  
  894. quit: '  GOTO 2
  895. quit2:  CLS
  896.     COLOR 1, 2
  897.     PRINT Exit$
  898.     COLOR 7, 0
  899.     LOCATE 2, 1, 1
  900.     END
  901.  
  902. Help:   PCOPY 0, 1
  903.     COLOR c1, BG
  904.     LOCATE 1, 1: PRINT VC1$;
  905.     FOR VX = 2 TO 24
  906.     LOCATE VX, 1: PRINT VC2$;
  907.     NEXT VX
  908.     LOCATE 25, 1: PRINT VC3$;
  909.        
  910.  
  911.     OPEN "roll5.hlp" FOR INPUT AS #5
  912.     COLOR c4, BG
  913.     LINE INPUT #5, HLP$: LOCATE 1, (80 - LEN(HLP$)) / 2: PRINT HLP$;
  914.     LINE INPUT #5, HLP$: LOCATE 25, (80 - LEN(HLP$)) / 2: PRINT HLP$;
  915.     COLOR c5, BG
  916.     FOR HE = 1 TO 23
  917.     LINE INPUT #5, HLP$
  918.     IF LEN(HLP$) < 76 THEN HLP$ = HLP$ + MID$(NO$, 1, 76 - LEN(HLP$))
  919.     HLP$ = LEFT$(HLP$, 76)
  920.     LOCATE HE + 1, 3: PRINT HLP$;
  921.     NEXT HE
  922.     CLOSE #5
  923. H:      V$ = INKEY$: IF V$ = "" THEN GOTO H
  924.     PCOPY 1, 0
  925.     RETURN
  926.  
  927.  
  928.