Ser1$ = "10" Ser2$ = "00" Ser3$ = "00" ET$ = " ROLL 5 (Ver 2.0) - A DolSOFT CREATION Ser # " + Ser1$ + Ser2$ + Ser3$ + " " Exit$ = ET$ 'Exit$ = ET$ + " ---- Registration has not yet been paid! ---- " '****************************************************************************** CLS SD = 0 'sound is ON LOCATE , , 0 Q1$ = CHR$(16) Q2$ = CHR$(17) PJ$ = CHR$(23) BG = 0 CB = 0 6 OPTION BASE 1 7 DIM OK$(5, 19), R$(100), COUNT(10), KEEP(10), A$(20), B$(16), C(10), SCORE(5), Player$(5) 8 DIM FL$(5), CNT(5), roll(5), BOT(5), TOP(5) DIM J3$(15) Page% = 0 K$ = "Keep" VC1$ = "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»" VC2$ = "º º" VC3$ = "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" B$(1) = "ONES . . . . . . . ." B$(2) = "TWOS . . . . . . . ." B$(3) = "THREES . . . . . . ." B$(4) = "FOURS. . . . . . . . " B$(5) = "FIVES. . . . . . . ." B$(6) = "SIXES. . . . . . . ." B$(7) = "Three of a Kind. . . " B$(8) = "Four of a Kind . . ." B$(9) = "Full House . . . . ." B$(10) = "Small Straight . . ." B$(11) = "Large Straight . . . " B$(12) = "R O L L 5. . . . ." B$(13) = "Chance . . . . . . ." B$(14) = "Upper SubScore" B$(15) = "Upper Bonus for 63+" B$(16) = "Lower SubScore" A$(1) = "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍ» ÉÍÍÍÍÍÍÍÍÍ»" A$(2) = "º ³ ³ ³ ³ ³ º º º" A$(3) = "º ³ ³ ³ ³ ³ º º º" A$(4) = "º ³ ³ ³ ³ ³ º ÈÍÍÍÍÍÍÍÍͼ" A$(5) = "º ³ ³ ³ ³ ³ º ÉÍÍÍÍÍÍÍÍÍ»" A$(6) = "º ³ ³ ³ ³ ³ º º º" A$(7) = "º ³ ³ ³ ³ ³ º º º" A$(8) = "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄĶ ÈÍÍÍÍÍÍÍÍͼ" A$(9) = "º ³ ³ ³ ³ ³ º ÉÍÍÍÍÍÍÍÍÍ»" A$(10) = "º ³ ³ ³ ³ ³ º º º" A$(11) = "º ³ ³ ³ ³ ³ º º º" A$(12) = "º ³ ³ ³ ³ ³ º ÈÍÍÍÍÍÍÍÍͼ" A$(13) = "º ³ ³ ³ ³ ³ º ÉÍÍÍÍÍÍÍÍÍ»" A$(14) = "º ³ ³ ³ ³ ³ º º º" A$(15) = "º ³ ³ ³ ³ ³ º º º" A$(16) = "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄĶ ÈÍÍÍÍÍÍÍÍͼ" A$(17) = "º ³ ³ ³ ³ ³ º ÉÍÍÍÍÍÍÍÍÍ»" A$(18) = "º ³ ³ ³ ³ ³ º º º" A$(19) = "º ³ ³ ³ ³ ³ º º º" A$(20) = "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍͼ ÈÍÍÍÍÍÍÍÍͼ" R$(1) = "ÛßßßßÜ ÜÛßßßÛÜ ÛÛ ÛÛ Ûßßßßßß" R$(2) = "ÛÜÜÜÜÜß Û Û ÛÛ ÛÛ ÛÜÜÜÜÜ" R$(3) = "Û ßÜ ßÛÜÜÜÛß ÛÛÜÜÜÜÜ ÛÛÜÜÜÜÜ ÜÜÜÜÜÜß" J3$(1) = "ÛÛÛÛÛÛÛ" J3$(2) = "ÛÛÛ ÛÛÛ" J3$(3) = "ÛÛÛÛÛÛÛ" J3$(4) = "ÛßÛÛÛÛÛ" J3$(5) = "ÛÛÛÛÛÛÛ" J3$(6) = "ÛÛÛÛÛÜÛ" J3$(7) = "ÛßÛÛÛÛÛ" J3$(8) = "ÛÛÛ ÛÛÛ" J3$(9) = "ÛÛÛÛÛÜÛ" J3$(10) = "ÛßÛÛÛßÛ" J3$(11) = "ÛÛÛÛÛÛÛ" J3$(12) = "ÛÜÛÛÛÜÛ" J3$(13) = "ÛßÛÛÛßÛ" J3$(14) = "ÛÛÛ ÛÛÛ" J3$(15) = "ÛÜÛÛÛÜÛ" FD1$ = "Roll #1:" FD2$ = " Use F1-F7 to change colors... F8=Arrows F9=Abort F10=Save Changes" 3 BOT = 0 4 TOP = 0 5 NO$ = " " 9 ' 10 ' BOARD COLORS C1,BG,CB 11 ' DICE COLORS C2,C6,CB 12 ' MESSAGE COLORS C3,BG,CB 13 ' NAME COLORS C4,BG,CB 14 ' TOTAL SCORE COLORS C5,BG,CB 15 ' WORDS C7,BG,CB 16 ' 17 ' 18 ' 19 ' PRINT "Three color schemes are available:" PRINT "Color, Monochrome, or Laptop system (C, M, or L)?" 1 V$ = INKEY$: IF V$ = "" THEN 1 IF V$ = "Q" OR V$ = "q" THEN GOTO quit2 IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 1 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 1 IF V$ = CHR$(27) THEN GOTO quit2 IF V$ = "c" OR V$ = "C" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.col roll5.clr >nul": GOTO 2 IF V$ = "m" OR V$ = "M" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.mon roll5.clr >nul": GOTO 2 IF V$ = "l" OR V$ = "L" THEN CLS : PRINT "Loading ROLL5...": SHELL "copy roll5.lap roll5.clr >nul": GOTO 2 GOTO 1 2 CLS 20 OPEN "ROLL5.CLR" FOR INPUT AS #1 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 24 CLOSE #1 Q1$ = CHR$(Q1) Q2$ = CHR$(Q2) 30 GOSUB 7200 ' PRINTS "ROLL5" ACROSS TOP 100 ' 105 KEY OFF 110 COLOR 14, 0 LOCATE 12, 26: PRINT " To Play ROLL5 Press 'R'" 111 LOCATE 14, 26: PRINT " To Set COLORS Press 'C'" LOCATE 16, 26: PRINT " To See Hi SCORES Press 'S'" LOCATE 18, 26: PRINT " To QUIT Roll5 Press 'Q'" LOCATE 25, 2: PRINT "Alt/I for Instructions"; GOSUB SD2 COLOR 1, 4 FOR GAB = 9 TO 21 LOCATE GAB, 20: PRINT " "; LOCATE GAB, 57: PRINT " "; NEXT GAB COLOR 15, 4 LOCATE 8, 20: PRINT " At any time F10 toggles sound off/on! "; COLOR 15, 4 LOCATE 22, 20: PRINT " DolSOFT CREATIONS Version 2.0 "; COLOR 14, 0 112 'CH$ = INPUT$(1) V$ = INKEY$: IF V$ = "" THEN 112 CH$ = V$ IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF MID$(CH$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 110 IF MID$(CH$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 110 IF CH$ = CHR$(27) THEN GOTO quit2 113 IF CH$ = "R" OR CH$ = "r" THEN IF FirstGame$ = "N" THEN CHAIN "roll5" END IF FirstGame$ = "N" GOTO 160 END IF 114 IF CH$ = "C" OR CH$ = "c" THEN GOTO Colors 115 IF CH$ = "s" OR CH$ = "S" THEN GOSUB ShowScores GOTO 2 END IF 116 IF CH$ = "q" OR CH$ = "Q" THEN GOTO quit2 118 GOTO 112 ShowScores: 20000 '********************** show HI SCORES ****************************** 20001 '******************************************************************** 20010 SHELL "SORT /R HISCORES.DAT" FOR KL = 6 TO 23: LOCATE KL, 1: PRINT NO$; : NEXT KL 20015 OPEN "HISCORES.DAT" FOR INPUT AS #1 20020 COLOR c5, BG, CB: LOCATE 5, 21: PRINT "========================================"; 20025 COLOR C3, BG, CB 20030 FOR VB = 7 TO 23: INPUT #1, A$ LOCATE VB, 26: PRINT A$; NEXT VB CLOSE #1 COLOR c5, BG, CB: LOCATE 25, 2: PRINT " ========================================"; 204 FOR alk = 1 TO 200: NEXT alk LOCATE 25, 2: PRINT "press any key"; FOR alk = 1 TO 200: NEXT alk LOCATE 25, 2: PRINT "PRESS ANY KEY"; 20040 V$ = INKEY$: IF V$ = "" THEN 204 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = CHR$(27) THEN GOTO quit IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 20040 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 20040 20050 RETURN 150 SHELL "COLORS.BAS" 151 GOTO 2 160 GOSUB 9000 '*********** PRINTS THE PLAYING SCREEN ****************** 200 ' *********** INPUTS THE NUMBER OF PLAYERS *************** 201 IF SD = 0 THEN BEEP 299 COLOR C3, BG, CB: LOCATE 25, 2: PRINT " # OF PLAYERS (1-5) "; 300 N$ = INKEY$: IF N$ = "" THEN 300 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF N$ = CHR$(27) THEN GOTO quit IF MID$(N$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 300 IF MID$(N$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 300 301 IF ASC(N$) < 49 THEN 299 302 IF ASC(N$) > 53 THEN 299 303 N = VAL(N$) 307 COLOR C3, BG, CB: LOCATE 25, 4: PRINT NO$; IF V$ = CHR$(27) THEN GOTO quit 309 ROW = 6 '************ INPUTS THE NAMES OF THE PLAYERS ***************** 310 FOR P = 1 TO N 330 IF SD = 0 THEN SOUND 880, .5 COLOR C3, BG, CB: LOCATE 25, 4: PRINT "ENTER PLAYER #"; P; "NAME OR INITIALS (1-7 LETTERS) "; 340 INPUT ; Player$(P): LOCATE 25, 4: PRINT NO$; 341 IF LEN(Player$(P)) = 0 THEN 330 342 IF LEN(Player$(P)) > 7 THEN 330 346 IF LEN(Player$(P)) < 3 THEN COL = 74 347 IF LEN(Player$(P)) = 3 THEN COL = 73 248 IF LEN(Player$(P)) = 4 THEN COL = 73 249 IF LEN(Player$(P)) = 5 THEN COL = 72 250 IF LEN(Player$(P)) = 6 THEN COL = 72 251 IF LEN(Player$(P)) = 7 THEN COL = 71 352 COLOR c4, BG, CB 353 LOCATE ROW, COL: PRINT UCASE$(Player$(P)) 355 LOCATE ROW + 1, 75: COLOR c5, BG, CB: PRINT "0": ROW = ROW + 4 390 NEXT P 391 GOSUB 7100 '********** PRINTS PLAYERS' NAMES ACROSS TOP **************** 11000 '***************** BEGIN 13 TURNS OF PLAY ************************* 11002 FOR TURN = 1 TO 13 11004 FOR P = 1 TO N 11040 FOR TRY = 1 TO 3: TRY$ = STR$(TRY) 11045 IF SD = 0 THEN SOUND 440, .5 COLOR C3, BG, CB: LOCATE 25, 4: PRINT "OK, "; UCASE$(Player$(P)); ", For Roll #"; TRY$; ", Press The SPACEBAR !! "; 11120 FOR XC = 6 TO 19: IF XC = 12 THEN 11121 IF XC = L THEN 11121 COLOR C2, BG, CB: LOCATE XC, 18 + 8 * P: PRINT Q1$; : LOCATE XC, 24 + 8 * P: PRINT Q2$; COLOR c6, BG: LOCATE 6, 18 + 8 * P: PRINT Q1$; : LOCATE 6, 24 + 8 * P: PRINT Q2$; 11121 NEXT XC 11122 'IF sd = 0 THEN BEEP 'COLOR c6, BG: LOCATE 6, 26: PRINT Q1$; : LOCATE 6, 32: PRINT Q2$; IF TRY > 1 THEN 11124 11123 'V$ = INPUT$(1) V$ = INKEY$: IF V$ = "" THEN 11123 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = CHR$(27) THEN GOTO quit IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 11123 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 11123 IF ASC(V$) <> 32 THEN GOTO 11122 11124 LOCATE 25, 4: PRINT NO$; IF GI = 0 THEN LOCATE 4, 1: PRINT NO$; : GI = 1 11125 R = 1: C = -1 11126 FOR DICE = 1 TO 5 ' ROLLS THE DICE COLOR C3, BG, CB: FOR VV = 1 TO 5: LOCATE 2, VV * 13 + 6: PRINT VV; : NEXT VV 11127 C = C + 13 11130 IF KEEP(DICE) = 1 THEN 11270 11135 'V$=TIME$: R1$=MID$(V$,7,2): R1=VAL(R$): RANDOMIZE 1 11136 V$ = MID$(TIME$, 7, 2) 11137 RANDOMIZE VAL(V$) 11140 roll = INT(6 * RND) + 1 11150 COUNT(DICE) = roll 11209 LOCATE 1, 1: PRINT "Roll #"; TRY$; 11210 ON roll GOSUB 7010, 7020, 7030, 7040, 7050, 7060 11270 NEXT DICE 11280 'CALL SOUND 11281 L = 6 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 "; 11300 ' 11301 FOR JJ = 6 TO 19: 11303 IF JJ = L THEN 11306 11304 IF JJ = 12 THEN 11306 11305 COLOR C2, BG, CB: LOCATE JJ, 18 + 8 * P: PRINT Q1$; : LOCATE JJ, 24 + 8 * P: PRINT Q2$; 11306 NEXT JJ 11307 V$ = INKEY$: IF V$ = "" THEN 11307 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = CHR$(27) THEN GOTO quit IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 11307 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 11307 11310 'IF LEN(V$) = 2 THEN V$ = RIGHT$(V$, 1) 11320 IF ASC(V$) = 13 THEN 14000'CR ' IF LEN(V$) = 2 THEN V$ = LEFT$(V$, 1) 11330 IF MID$(V$, 2, 1) = "H" THEN 12500'MINUS DONE 11340 IF MID$(V$, 2, 1) = "P" THEN 12600'PLUS DONE 11350 IF ASC(V$) = 32 THEN 11390'SPACEBAR 11352 IF ASC(V$) = 48 THEN 13000'ZERO DONE 11360 IF ASC(V$) < 49 THEN 11300 11361 IF ASC(V$) > 53 THEN 11300 11380 V = VAL(V$): ON V GOSUB 13100, 13200, 13300, 13400, 13500 11385 GOTO 11280 11390 IF TRY = 3 THEN 11300 11411 NEXT TRY 11440 'GOSUB 13000 11450 FOR XX = 1 TO 5: KEEP(XX) = 0: NEXT XX 11451 LOCATE 4, 1: PRINT NO$ 11452 L = 5 11453 FOR FF = 6 TO 19: IF FF = 12 THEN 11455 11454 LOCATE FF, 3: PRINT " "; 11455 NEXT FF 11459 FOR BK = 1 TO 3: LOCATE BK, 1: PRINT NO$: NEXT BK: NEXT P 11460 NEXT TURN 11470 GOTO 15000 6100 '**************TO PRINT NAMES AND DICE NUMBERS (1-5)****************** 6105 COLOR 3, 5, 0: LOCATE 8, 24: PRINT Player$(1): LOCATE 8, 34: PRINT Player$(2) 6110 GOTO 6110 7000 '**********************FOR PRINTING DICE****************** 7010 'ONE 7011 IF SD = 0 THEN SOUND 220, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7012 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛÛÛÛÛÛÛ": LOCATE R + 1, C: PRINT "ÛÛÛ ÛÛÛ": LOCATE R + 2, C: PRINT "ÛÛÛÛÛÛÛ" 7013 RETURN 7020 'TWO 7021 IF SD = 0 THEN SOUND 247, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7022 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛßÛÛÛÛÛ": LOCATE R + 1, C: PRINT "ÛÛÛÛÛÛÛ": LOCATE R + 2, C: PRINT "ÛÛÛÛÛÜÛ" 7023 RETURN 7030 'THREE 7031 IF SD = 0 THEN SOUND 261.6, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7032 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛßÛÛÛÛÛ": LOCATE R + 1, C: PRINT "ÛÛÛ ÛÛÛ": LOCATE R + 2, C: PRINT "ÛÛÛÛÛÜÛ" 7033 RETURN 7040 'FOUR 7041 IF SD = 0 THEN SOUND 293.6, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7042 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛßÛÛÛßÛ": LOCATE R + 1, C: PRINT "ÛÛÛÛÛÛÛ": LOCATE R + 2, C: PRINT "ÛÜÛÛÛÜÛ" 7043 RETURN 7050 'FIVE 7051 IF SD = 0 THEN SOUND 329.6, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7052 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛßÛÛÛßÛ": LOCATE R + 1, C: PRINT "ÛÛÛ ÛÛÛ": LOCATE R + 2, C: PRINT "ÛÜÛÛÛÜÛ" 7053 RETURN 7060 'SIX 7061 IF SD = 0 THEN SOUND 349.23, 2 FOR AQ = 1 TO 3: LOCATE R - 1 + AQ, C: PRINT " "; : NEXT AQ 7062 COLOR C2, c6, CB: LOCATE R, C: PRINT "ÛßÛßÛßÛ": LOCATE R + 1, C: PRINT "ÛÛÛÛÛÛÛ": LOCATE R + 2, C: PRINT "ÛÜÛÜÛÜÛ" 7063 RETURN 7100 '************* PRINTS PLAYERS' NAME ON TOP OF COLUMNS ***************** 7101 CL = 25 7102 COLOR c4, BG, CB 7105 FOR P = 1 TO N 7110 IF LEN(Player$(P)) = 7 THEN PL = CL + 1: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7111 IF LEN(Player$(P)) = 6 THEN PL = CL + 2: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7112 IF LEN(Player$(P)) = 5 THEN PL = CL + 2: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7113 IF LEN(Player$(P)) = 4 THEN PL = CL + 3: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7114 IF LEN(Player$(P)) = 3 THEN PL = CL + 3: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7115 IF LEN(Player$(P)) = 2 THEN PL = CL + 4: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7116 IF LEN(Player$(P)) = 1 THEN PL = CL + 4: LOCATE 5, PL: PRINT UCASE$(Player$(P)); 7117 CL = CL + 8 7118 NEXT P 7119 RETURN 7200 ' ******************** DISPLAYS "R O L L 5" ************************* 7201 COLOR C2, CB, CB 7205 ' OPEN "ROLL.5" FOR INPUT AS #1 7207 FOR x = 1 TO 4 7210 'INPUT #1, R$(x) LOCATE x, 12: PRINT R$(x) 7212 NEXT x 7214 'CLOSE #1 7216 RETURN 9000 ' **************** PRINT SCORE CARD FOR 5 PEOPLE ******************** 9001 COLOR c1, BG, CB 9004 'OPEN "ROLL5.S1" FOR INPUT AS #1 9005 'FOR x = 1 TO 20 9010 'INPUT #1, A$(x) 9015 'NEXT x 9020 FOR x = 1 TO 19 9025 LOCATE x + 3, 3: PRINT A$(x); 9030 NEXT x 9032 LOCATE 23, 3: PRINT A$(20); 9033 'CLOSE #1 9100 'OPEN "ROLL5.S2" FOR INPUT AS #1 9105 'FOR x = 1 TO 16 9110 'INPUT #1, a$(x) 9115 'NEXT x 9117 'CLOSE #1 9119 ROW = 6: COL = 4 9120 COLOR C7, BG, CB: LOCATE ROW, COL: PRINT B$(1) 9121 LOCATE ROW + 1, COL: PRINT B$(2) 9122 LOCATE ROW + 2, COL: PRINT B$(3) 9123 LOCATE ROW + 3, COL: PRINT B$(4) 9124 LOCATE ROW + 4, COL: PRINT B$(5) 9125 LOCATE ROW + 5, COL: PRINT B$(6) 9126 LOCATE ROW + 7, COL: PRINT B$(7) 9127 LOCATE ROW + 8, COL: PRINT B$(8) 9128 LOCATE ROW + 9, COL: PRINT B$(9) 9129 LOCATE ROW + 10, COL: PRINT B$(10) 9130 LOCATE ROW + 11, COL: PRINT B$(11) 9131 LOCATE ROW + 12, COL: PRINT B$(12) 9132 LOCATE ROW + 13, COL: PRINT B$(13) 9133 LOCATE ROW + 15, COL: PRINT B$(14) 9134 LOCATE ROW + 16, COL: PRINT B$(15) 9135 LOCATE ROW + 17, COL: PRINT B$(16) 9200 RETURN 15000 GOTO 19000 'END OF GAME 12500 '***************** TO MOVE ARROW UP ONE LINE ********************** 12501 COLOR C2, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$; 12502 L = L - 1: IF L < 6 THEN L = 19 12503 IF L = 12 THEN L = L - 1 12505 COLOR c6, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$; 12599 GOTO 11282 12600 '**************** TO MOVE ARROW DOWN ONE LINE *********************** 12601 COLOR C2, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + P * 8: PRINT Q2$; 12602 L = L + 1: IF L > 19 THEN L = 6 12603 IF L = 12 THEN L = L + 1 12605 COLOR c6, BG, CB: LOCATE L, 18 + 8 * P: PRINT Q1$; : LOCATE L, 24 + 8 * P: PRINT Q2$; 12699 GOTO 11282 13000 '************** ON ZERO TO SET ALL DICE FLAGS TO 0 ******************* 13001 IF SD = 0 THEN SOUND 880, .5 COLOR C3, BG, CB 13002 FOR FL = 1 TO 5 13005 KEEP(FL) = 0 13007 NEXT FL 13008 LOCATE 4, 1: PRINT NO$ 13009 GOTO 11282 13100 '******************** TO SET DIE #1 ******************************** 13101 IF SD = 0 THEN SOUND 440, .5 COLOR C3, BG, CB 13105 IF KEEP(1) = 1 THEN KEEP(1) = 0: GOTO 13150 13110 KEEP(1) = 1 13130 LOCATE 4, 13: PRINT K$; 13140 GOTO 11282 13150 LOCATE 4, 13: PRINT " "; 13152 GOTO 11282 13200 '********************** TO SET DIE #2 ******************************* 13201 IF SD = 0 THEN SOUND 494, .5 COLOR C3, BG, CB 13205 IF KEEP(2) = 1 THEN KEEP(2) = 0: GOTO 13250 13210 KEEP(2) = 1 13230 LOCATE 4, 26: PRINT K$; 13240 GOTO 11282 13250 LOCATE 4, 26: PRINT " "; 13252 GOTO 11282 13300 '******************** TO SET DIE #3 ******************************** 13301 IF SD = 0 THEN SOUND 523.2, .5 COLOR C3, BG, CB 13305 IF KEEP(3) = 1 THEN KEEP(3) = 0: GOTO 13350 13310 KEEP(3) = 1 13330 LOCATE 4, 39: PRINT K$; 13340 GOTO 11282 13350 LOCATE 4, 39: PRINT " "; 13352 GOTO 11282 13400 '********************* TO SET DIE #4 ****************************** 13401 IF SD = 0 THEN SOUND 587.4, .5 COLOR C3, BG, CB 13405 IF KEEP(4) = 1 THEN KEEP(4) = 0: GOTO 13450 13410 KEEP(4) = 1 13430 LOCATE 4, 52: PRINT K$; 13440 GOTO 11282 13450 LOCATE 4, 52: PRINT " "; 13452 GOTO 11282 13500 '*********************** TO SET DIE #5 ***************************** 13501 IF SD = 0 THEN SOUND 659.2, .5 COLOR C3, BG, CB 13505 IF KEEP(5) = 1 THEN KEEP(5) = 0: GOTO 13550 13510 KEEP(5) = 1 13530 LOCATE 4, 65: PRINT K$; 13540 GOTO 11282 13550 LOCATE 4, 65: PRINT " "; 13552 GOTO 11282 14000 '********************* CHECKS CARRIAGE RETURN *********************** 14001 FOR PR = 6 TO 19: IF PR = 12 THEN 14003 14002 LOCATE PR, 18 + 8 * P: PRINT " "; : LOCATE PR, 24 + 8 * P: PRINT " "; 14003 NEXT PR 14008 COLOR C3, BG, CB 14009 ON L GOTO 1, 2, 3, 4, 5, 14010, 14030, 14050, 14070, 14090, 14110, 12, 14130, 14230, 14400, 14600, 14500, 14700, 14800 14010 IF OK$(P, L) = "Y" THEN 11300'*************** CHECK FOR ONES ************ 14011 fLAG = 0 14012 FOR ZZ = 1 TO 5 14014 IF COUNT(ZZ) = 1 THEN fLAG = fLAG + 1 14016 NEXT ZZ 14018 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14020 LOCATE 6, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14021 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14030 IF OK$(P, L) = "Y" THEN 11300' ************** CHECK FOR TWOS ************ 14031 fLAG = 0 14032 FOR ZZ = 1 TO 5 14033 IF COUNT(ZZ) = 2 THEN fLAG = fLAG + 2 14034 NEXT ZZ 14035 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14036 LOCATE 7, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14037 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14050 IF OK$(P, L) = "Y" THEN 11300'************ check for threes ************* 14051 fLAG = 0 14052 FOR ZZ = 1 TO 5 14053 IF COUNT(ZZ) = 3 THEN fLAG = fLAG + 3 14054 NEXT ZZ 14055 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14056 LOCATE 8, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14057 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14070 IF OK$(P, L) = "Y" THEN 11300'************** CHECK FOR FOURS *********** 14071 fLAG = 0 14072 FOR ZZ = 1 TO 5 14073 IF COUNT(ZZ) = 4 THEN fLAG = fLAG + 4 14074 NEXT ZZ 14075 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14076 LOCATE 9, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14077 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14090 IF OK$(P, L) = "Y" THEN 11300' ************** CHECK FOR FIVES ********** 14091 fLAG = 0 14092 FOR ZZ = 1 TO 5 14093 IF COUNT(ZZ) = 5 THEN fLAG = fLAG + 5 14094 NEXT ZZ 14095 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14096 LOCATE 10, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14097 GOSUB 16000: OK$(P, L) = "Y" 14098 GOTO 14999 14110 IF OK$(P, L) = "Y" THEN 11300'************* CHECK FOR SIXES ************* 14111 fLAG = 0 14112 FOR ZZ = 1 TO 5 14113 IF COUNT(ZZ) = 6 THEN fLAG = fLAG + 6 14114 NEXT ZZ 14115 SCORE(P) = SCORE(P) + fLAG: TOP(P) = TOP(P) + fLAG: TOP$ = STR$(TOP(P)): IF TOP(P) > 62 THEN GOSUB 18000 14116 LOCATE 11, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 21, 23 - LEN(TOP$) + P * 8: PRINT TOP(P) 14117 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14130 IF OK$(P, L) = "Y" THEN 11300'*********** CHECK FOR 3 OF A KIND ********** 14131 fLAG = 0: FOR Y = 1 TO 5: C(Y) = COUNT(Y): NEXT Y 14132 IF (C(1) = C(2)) AND (C(2) = C(3)) THEN 14145 14133 IF (C(1) = C(2)) AND (C(1) = C(4)) THEN 14145 14134 IF (C(1) = C(2)) AND (C(1) = C(5)) THEN 14145 14135 IF (C(1) = C(3)) AND (C(1) = C(4)) THEN 14145 14136 IF (C(1) = C(3)) AND (C(1) = C(5)) THEN 14145 14137 IF (C(1) = C(4)) AND (C(1) = C(5)) THEN 14145 14138 IF (C(2) = C(3)) AND (C(3) = C(4)) THEN 14145 14139 IF (C(2) = C(4)) AND (C(4) = C(5)) THEN 14145 14140 IF (C(2) = C(3)) AND (C(3) = C(5)) THEN 14145 14141 IF (C(3) = C(4)) AND (C(4) = C(5)) THEN 14145 14142 GOTO 14147 14145 FOR ZZ = 1 TO 5: fLAG = fLAG + C(ZZ): NEXT ZZ 14146 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)) 14147 LOCATE 13, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P) 14148 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14230 IF OK$(P, L) = "Y" THEN 11300'*********** CHECK FOR 4 OF A KIND ******* 14231 fLAG = 0: FOR Y = 1 TO 5: C(Y) = COUNT(Y): NEXT Y 14232 IF (C(1) = C(2)) AND (C(2) = C(3)) AND (C(1) = C(4)) THEN 14300 14233 IF (C(1) = C(2)) AND (C(1) = C(4)) AND (C(4) = C(5)) THEN 14300 14234 IF (C(1) = C(2)) AND (C(1) = C(5)) AND (C(5) = C(3)) THEN 14300 14235 IF (C(1) = C(3)) AND (C(1) = C(4)) AND (C(4) = C(5)) THEN 14300 14241 IF (C(2) = C(3)) AND (C(3) = C(4)) AND (C(4) = C(5)) THEN 14300 14299 GOTO 14304 14300 FOR ZZ = 1 TO 5: fLAG = fLAG + C(ZZ): NEXT ZZ 14302 SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)) 14304 LOCATE 14, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG: LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P) 14306 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14400 IF OK$(P, L) = "Y" THEN 11300'************* CHECK FOR FULL HOUSE ******* 14401 fLAG = 0: GOSUB 17000 14402 IF (COUNT(1) = COUNT(2)) AND (COUNT(2) = COUNT(3)) AND (COUNT(4) = COUNT(5)) THEN 14410 14403 IF (COUNT(1) = COUNT(2)) AND (COUNT(3) = COUNT(4)) AND (COUNT(4) = COUNT(5)) THEN 14410 14404 GOTO 14411 14410 fLAG = 25 14411 LOCATE 15, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG; 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) 14413 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14500 IF OK$(P, L) = "Y" THEN 11300'************ CHECK FOR LARGE STRAIGHT ***** 14501 fLAG = 0 14502 GOSUB 17000 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 14511 GOTO 14516 14515 fLAG = 40 14516 LOCATE 17, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG; 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) 14518 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14600 IF OK$(P, L) = "Y" THEN 11300'************ CHECK FOR SMALL STRAIGHT ****** 14601 fLAG = 0 14602 GOSUB 17000 'OPEN "SORTIN.DAT" FOR OUTPUT AS #3 14603 FOR RR = 1 TO 5: roll(RR) = COUNT(RR): NEXT RR '??????? 'IF roll(1) = roll(2) THEN roll(2) = roll(3): roll(3) = roll(4): roll(4) = roll(5) IF roll(2) = roll(3) THEN roll(3) = roll(4): roll(4) = roll(5) IF roll(3) = roll(4) THEN roll(4) = roll(5) IF (roll(1) = roll(2) - 1) AND (roll(2) = roll(3) - 1) AND (roll(3) = roll(4) - 1) THEN 14620 IF (roll(2) = roll(3) - 1) AND (roll(3) = roll(4) - 1) AND (roll(4) = roll(5) - 1) THEN 14620 14605 'SHELL "SORT SORTOUT.DAT" 14606 'OPEN "SORTOUT.DAT" FOR INPUT AS #3 14607 'FOR ZZ=1 TO 5: INPUT #3,COUNT(ZZ): NEXT ZZ : CLOSE #3 14608 IF (COUNT(1) = COUNT(2) - 1) AND (COUNT(2) = COUNT(3) - 1) AND (COUNT(3) = COUNT(4) - 1) THEN 14620 14609 IF (COUNT(2) = COUNT(3) - 1) AND (COUNT(3) = COUNT(4) - 1) AND (COUNT(4) = COUNT(5) - 1) THEN 14620 14610 GOTO 14621 14620 fLAG = 30 14621 LOCATE 16, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG; 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) 14623 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14700 '************** CHECK FOR ROLL5 ************* 14701 ' 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 IF CNT(P) > 0 THEN 11300 fLAG = 0: GOTO 14720 14710 IF CNT(P) = 1 THEN fLAG = 50 IF CNT(P) > 1 THEN fLAG = 100 14720 LOCATE 18, 23 - LEN(STR$(fLAG)) + 8 * P: DL = CNT(P) * 100 - 50: IF DL < 0 THEN DL = 0 PRINT DL; SCORE(P) = SCORE(P) + fLAG: BOT(P) = BOT(P) + fLAG: BOT$ = STR$(BOT(P)): LOCATE 23, 23 - LEN(BOT$) + 8 * P: PRINT BOT(P) GOSUB 16000 14725 IF fLAG = 50 OR fLAG = 0 THEN 14999 ' ****FOR NEXT PLAYER**** IF fLAG = 100 THEN P = P - 1: GOTO 14999'****FOR EXTRA TURN**** 14800 IF OK$(P, L) = "Y" THEN 11300'************* ENTER SCORE FOR CHANCE ******** 14801 fLAG = 0: FOR ZZ = 1 TO 5: fLAG = fLAG + COUNT(ZZ): NEXT ZZ 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) 14803 LOCATE 19, 23 - LEN(STR$(fLAG)) + 8 * P: PRINT fLAG; 14804 GOSUB 16000: OK$(P, L) = "Y": GOTO 14999 14999 GOTO 11450 17000 FOR II = 1 TO 5' ********* SORTS THE FIVE DICE ********* 17001 FOR JJ = II TO 5 17002 IF COUNT(II) <= COUNT(JJ) THEN 17006 17003 HNUM = COUNT(JJ) 17004 COUNT(JJ) = COUNT(II) 17005 COUNT(II) = HNUM 17006 NEXT JJ 17007 NEXT II 17015 RETURN 18000 ' SETS EXTRA 35 POINTS FOR TOP PORTION SCORE OF 63+ 18001 ' *************************************************** 18005 IF FL$(P) = "Y" THEN 18050 18010 FL$(P) = "Y" 18012 LOCATE 22, 20 + 8 * P: PRINT 35: SCORE(P) = SCORE(P) + 35: GOSUB 16000 18050 RETURN 16000 IF P = 1 THEN LOCATE 7, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P) 16001 IF P = 2 THEN LOCATE 11, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P) 16002 IF P = 3 THEN LOCATE 15, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P) 16003 IF P = 4 THEN LOCATE 19, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P) 16004 IF P = 5 THEN LOCATE 23, 76 - LEN(STR$(SCORE(P))): PRINT SCORE(P) 16006 GOSUB 21200: RETURN 19000 ' ************* END OF GAME ************** 19001 GOSUB 19500 CLS GOSUB ShowScores GOTO quit2 19002 V$ = INKEY$: IF V$ = "" THEN 19002 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = CHR$(27) THEN GOTO quit IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 19002 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 19002 19003 IF SD = 0 THEN BEEP GOTO 2 19005 LOCATE 25, 1: PRINT "Play Again or End play? Press P or E! "; 19010 V$ = INKEY$: IF V$ = "" THEN 19010 IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = CHR$(27) THEN GOTO quit IF MID$(V$, 2, 1) = "D" AND SD = 0 THEN SD = 1: GOSUB SD2: GOTO 19010 IF MID$(V$, 2, 1) = "D" AND SD = 1 THEN SD = 0: GOSUB SD2: GOTO 19010 19015 IF V$ = "p" OR V$ = "P" THEN GI = 0: GOTO 19100 19020 IF V$ = "e" OR V$ = "E" THEN 19200 19030 IF SD = 0 THEN BEEP GOTO 19010 19100 GOSUB 19500: GOTO 1 19200 GOSUB 19500: SYSTEM 19500 ' to save scores 19501 ' ****************** 19510 OPEN "roll5.sco" FOR APPEND AS #4 19514 FOR kp = 1 TO N 19515 IF SCORE(kp) > 99 THEN PRINT #4, SCORE(kp); TAB(10); UCASE$(Player$(kp)); TAB(22); DATE$ 19520 NEXT kp: CLOSE #4: RETURN 21000 ' sounds sounds sounds sounds 21001 ' ******************************* 21105 IF SD = 0 THEN FOR SND = 440 TO 1000 STEP 5: SOUND SND, .5: NEXT 21110 IF SD = 0 THEN FOR SND = 1000 TO 440 STEP -5: SOUND SND, .5: NEXT 21115 RETURN 21200 IF SD = 0 THEN SOUND 440, 1: SOUND 880, 1: SOUND 440, 1: SOUND 880, 1 RETURN SD2: IF SD = 0 THEN LOCATE 25, 68: PRINT "Sound is ON "; IF SD = 1 THEN LOCATE 25, 68: PRINT "Sound is OFF"; RETURN Colors: CLS CLR1: 'OPEN "roll5.s1" FOR INPUT AS #11 'FOR WW = 1 TO 20 'INPUT #11, J1$(WW) 'NEXT WW 'CLOSE #11 'OPEN "roll5.s2" FOR INPUT AS #12 'FOR WW = 1 TO 16 'INPUT #12, J2$(WW) 'NEXT WW 'CLOSE #12 CLR2: COLOR C3, BG LOCATE 1, 3: PRINT FD1$; LOCATE 25, 3: PRINT FD2$; LOCATE 2, 23: PRINT "1 2 3 4 5"; LOCATE 4, 16: PRINT K$ LOCATE 4, 40: PRINT K$ COLOR C2, c6 LOCATE 1, 15: PRINT J3$(1); LOCATE 2, 15: PRINT J3$(2); LOCATE 3, 15: PRINT J3$(3); LOCATE 1, 27: PRINT J3$(4); LOCATE 2, 27: PRINT J3$(5); LOCATE 3, 27: PRINT J3$(6); LOCATE 1, 39: PRINT J3$(7); LOCATE 2, 39: PRINT J3$(8); LOCATE 3, 39: PRINT J3$(9); LOCATE 1, 51: PRINT J3$(10); LOCATE 2, 51: PRINT J3$(11); LOCATE 3, 51: PRINT J3$(12); LOCATE 1, 63: PRINT J3$(13); LOCATE 2, 63: PRINT J3$(14); LOCATE 3, 63: PRINT J3$(15); COLOR c1, BG FOR WW = 1 TO 20 LOCATE WW + 4, 1: PRINT A$(WW); NEXT WW COLOR C7, BG WWC = 6 FOR WW = 1 TO 16 LOCATE WWC, 4: PRINT B$(WW); WWC = WWC + 1 IF WWC = 12 THEN WWC = 13 IF WWC = 20 THEN WWC = 21 NEXT WW COLOR c4, BG LOCATE 5, 73: PRINT "Bob"; LOCATE 9, 73: PRINT "Jim"; LOCATE 13, 72: PRINT "Jane"; LOCATE 17, 71: PRINT "Tarzan"; LOCATE 21, 73: PRINT "DOL"; LOCATE 5, 28: PRINT "Bob"; LOCATE 5, 36: PRINT "Jim"; LOCATE 5, 43: PRINT "Jane"; LOCATE 5, 50: PRINT "Tarzan"; LOCATE 5, 60: PRINT "DOL"; COLOR C2, BG FOR WW = 6 TO 11 LOCATE WW, 26: PRINT Q1$; " "; Q2$; NEXT WW FOR WW = 13 TO 19 LOCATE WW, 26: PRINT Q1$; " "; Q2$; NEXT WW FOR WW = 21 TO 23 LOCATE WW, 26: PRINT Q1$; " "; Q2$; NEXT WW COLOR c6, BG LOCATE 8, 26: PRINT Q1$; " "; Q2$; COLOR c5, BG LOCATE 6, 30: PRINT "3"; LOCATE 7, 30: PRINT "8"; LOCATE 8, 29: PRINT "12"; LOCATE 7, 73: PRINT "000"; LOCATE 11, 73: PRINT "000"; LOCATE 15, 73: PRINT "000"; LOCATE 19, 73: PRINT "000"; LOCATE 23, 73: PRINT "000"; LOCATE 25, 1, 0 GH: V$ = INKEY$: IF V$ = "" THEN GOTO GH IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF MID$(V$, 2, 1) = ";" THEN c1 = c1 + 1: IF c1 > 15 THEN c1 = 1 IF MID$(V$, 2, 1) = "<" THEN C2 = C2 + 1: IF C2 > 15 THEN C2 = 1 IF MID$(V$, 2, 1) = "=" THEN C3 = C3 + 1: IF C3 > 15 THEN C3 = 1 IF MID$(V$, 2, 1) = ">" THEN c4 = c4 + 1: IF c4 > 15 THEN c4 = 1 IF MID$(V$, 2, 1) = "?" THEN c5 = c5 + 1: IF c5 > 15 THEN c5 = 1 IF MID$(V$, 2, 1) = "@" THEN c6 = c6 + 1: IF c6 > 15 THEN c6 = 1 IF MID$(V$, 2, 1) = "A" THEN C7 = C7 + 1: IF C7 > 15 THEN C7 = 1 IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(16) THEN Q1$ = CHR$(26): Q2$ = CHR$(27): GOTO CLR2 IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(26) THEN Q1$ = CHR$(254): Q2$ = CHR$(254): GOTO CLR2 IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(254) THEN Q1$ = CHR$(1): Q2$ = CHR$(1): GOTO CLR2 IF MID$(V$, 2, 1) = "B" AND Q1$ = CHR$(1) THEN Q1$ = CHR$(16): Q2$ = CHR$(17): GOTO CLR2 IF MID$(V$, 2, 1) = "C" THEN GOTO CLR5 'abort changes IF MID$(V$, 2, 1) = "D" THEN GOTO CLR6 'save changes GOTO CLR2 CLR5: CLS : GOTO 30 CLR6: COLOR 14, 4 LOCATE 12, 12: PRINT " ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» " LOCATE 13, 12: PRINT " º º " LOCATE 14, 12: PRINT " º º " LOCATE 15, 12: PRINT " º º " LOCATE 16, 12: PRINT " º º " LOCATE 17, 12: PRINT " ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ " COLOR 0, 14 LOCATE 13, 14: PRINT " Save these color changes for: " COLOR 7, 4 LOCATE 14, 15: PRINT " Color system" LOCATE 15, 15: PRINT " Mono system" LOCATE 16, 15: PRINT " Laptop system" COLOR 14, 4 LOCATE 14, 15: PRINT " C" LOCATE 15, 15: PRINT " M" LOCATE 16, 15: PRINT " L" CL: V$ = INKEY$: IF V$ = "" THEN GOTO CL IF MID$(V$, 2, 1) = PJ$ THEN GOSUB Help IF V$ = "C" OR V$ = "c" THEN XFile$ = "roll5.col": GOTO CL9 IF V$ = "M" OR V$ = "m" THEN XFile$ = "roll5.mon": GOTO CL9 IF V$ = "L" OR V$ = "l" THEN XFile$ = "roll5.lap": GOTO CL9 GOTO CL CL9: OPEN XFile$ FOR OUTPUT AS #9 PRINT #9, c1 PRINT #9, C2 PRINT #9, C3 PRINT #9, c4 PRINT #9, c5 PRINT #9, c6 PRINT #9, C7 PRINT #9, ASC(Q1$) PRINT #9, ASC(Q2$) CLOSE #9 COLOR 4, 0 CLS GOTO 19 quit: ' GOTO 2 quit2: CLS COLOR 1, 2 PRINT Exit$ COLOR 7, 0 LOCATE 2, 1, 1 END Help: PCOPY 0, 1 COLOR c1, BG LOCATE 1, 1: PRINT VC1$; FOR VX = 2 TO 24 LOCATE VX, 1: PRINT VC2$; NEXT VX LOCATE 25, 1: PRINT VC3$; OPEN "roll5.hlp" FOR INPUT AS #5 COLOR c4, BG LINE INPUT #5, HLP$: LOCATE 1, (80 - LEN(HLP$)) / 2: PRINT HLP$; LINE INPUT #5, HLP$: LOCATE 25, (80 - LEN(HLP$)) / 2: PRINT HLP$; COLOR c5, BG FOR HE = 1 TO 23 LINE INPUT #5, HLP$ IF LEN(HLP$) < 76 THEN HLP$ = HLP$ + MID$(NO$, 1, 76 - LEN(HLP$)) HLP$ = LEFT$(HLP$, 76) LOCATE HE + 1, 3: PRINT HLP$; NEXT HE CLOSE #5 H: V$ = INKEY$: IF V$ = "" THEN GOTO H PCOPY 1, 0 RETURN