'=========================================================================== ' Subject: ETERNAL REST (MINESWEEPER) Date: 01-15-99 (23:00) ' Author: Joshua W. Jung Code: QB, QBasic, PDS ' Origin: SiliconValley/Lab/5317/ Packet: GAMES.ABC '=========================================================================== ' ' - Q B A S I C - ' ' E T E R N A L R E S T by Joshua W. Jung ' ' is a spin off of Windows 3.11 Version of Minesweeper ' ' 'Line Numbers 0 - 99 DEFINT I, X-Y COMMON SHARED Pauses, Rows, Columns, Mines, PMines, Move$, z$ DECLARE SUB Stops () DECLARE SUB Intro () DECLARE SUB HelpMe () DECLARE SUB BigLetter (Word$, Size%, Cr%, Style%, Position%) DECLARE SUB GetInputs () DECLARE SUB StartGame () CLEAR , , 5120 CLS SCREEN 12 RANDOMIZE TIMER CALL Intro CALL GetInputs DO CALL GetInputs LOOP END 'Data for SubProgram HelpMe DATA 0,0,42, 0,42,0, 0,42,42, 42,0,0, 42,0,42 DATA 42,21,0, 42,42,42, 21,21,21, 21,21,63, 21,63,21 DATA 21,63,63, 63,21,21, 63,21,63, 63,63,21, 63,63,63 'Data for SubProgram GetInputs DATA "What level do you want to play?", 5 DATA "(D)umbButt", 6 DATA "(B)eginner", 7 DATA "(A)dvanced", 8 DATA "(E)xpert ", 9 DATA "(M)aster ",10 DATA "(C)ustom ", 11 DATA "Rows: ", 13 DATA "Columns:",14 DATA "Mines: ", 15 'Data for SubProgram GetImages 'BoxOut DATA 300,219,300,200,319,200,7 DATA 301,218,301,201,318,201,7 DATA 302,217,302,202,317,202,7 DATA 301,219,319,219,319,201,13 DATA 302,218,318,218,318,202,13 DATA 303,217,317,217,317,203,13 'Flag DATA 300,249,300,230,319,230,319,230,7 DATA 301,248,301,231,318,231,318,231,7 DATA 302,247,302,232,317,232,317,232,7 DATA 301,249,319,249,319,231,319,231,13 DATA 302,248,318,248,318,232,318,232,13 DATA 303,247,317,247,317,233,317,233,13 DATA 311,235,311,241,306,238,311,235,4 DEFINT A-H, J-W, Z '---------------------------------------------------------------------------- SUB BigLetter (Word$, Size, Cr, Style, Position) COLOR 15 REDIM Box(-1 TO 7, -1 TO 15) WordLength = LEN(Word$) * Size * 8 WordHeight = Size * 16 WordCenter = 320 - (WordLength / 2) PALETTE 15, 0 FOR Letter = 1 TO LEN(Word$) LOCATE 1, 1 PRINT MID$(Word$, Letter, 1) FOR X = 0 TO 7 FOR Y = 0 TO 15 Box(X, Y) = POINT(X, Y) NEXT Y NEXT X FOR X = 0 TO 7 left = WordCenter + (X * Size) right = left + Size LR = (left + right) \ 2 FOR Y = 0 TO 15 up = Position + (Y * Size) down = up + Size UD = (up + down) \ 2 IF Box(X, Y) THEN SELECT CASE Style CASE 1 'Solid LINE (left, up)-(right, down), Cr, BF CASE 2 'Squares LINE (left, up)-(right, down), Cr, B CASE 3 'Slant (\) LINE (left, up)-(right, down), Cr CASE 4 'Slant II (/) LINE (right, up)-(left, down), Cr CASE 5 'Vertical Lines LINE (LR, up)-(LR, down), Cr CASE 6 'Horizontal Lines LINE (left, UD)-(right, UD), Cr CASE 7 'Crosses LINE (LR, up)-(LR, down), Cr LINE (left, UD)-(right, UD), Cr CASE 8 'Xs LINE (left, up)-(right, down), Cr LINE (right, up)-(left, down), Cr CASE 9 'Outline IF Box(X - 1, Y) = 0 THEN LINE (left, up)-(left, down), Cr IF Box(X + 1, Y) = 0 THEN LINE (right, up)-(right, down), Cr IF Box(X, Y - 1) = 0 THEN LINE (left, up)-(right, up), Cr IF Box(X, Y + 1) = 0 THEN LINE (left, down)-(right, down), Cr CASE 10 'Spider Web IF Box(X - 1, Y) THEN LINE (LR, UD)-(left, UD), Cr IF Box(X + 1, Y) THEN LINE (LR, UD)-(right, UD), Cr IF Box(X, Y - 1) THEN LINE (LR, UD)-(LR, up), Cr IF Box(X, Y + 1) THEN LINE (LR, UD)-(LR, down), Cr IF Box(X - 1, Y - 1) THEN LINE (LR, UD)-(left, up), Cr IF Box(X + 1, Y - 1) THEN LINE (LR, UD)-(right, up), Cr IF Box(X - 1, Y + 1) THEN LINE (LR, UD)-(left, down), Cr IF Box(X + 1, Y + 1) THEN LINE (LR, UD)-(right, down), Cr CASE 11 'Bubbles CIRCLE (LR, UD), Size \ 2, Cr CASE 12 'Circles CIRCLE (LR, UD), Size \ 2, Cr PAINT STEP(0, 0), Cr CASE 13 'Shadow IF Box(X + 1, Y) = 0 THEN LINE (right, up)-(right, down), Cr IF Box(X, Y + 1) = 0 THEN LINE (left, down)-(right, down), Cr IF Box(X + 1, Y + 1) = 0 THEN PSET (right, down), Cr CASE 14 'Separated Squares LINE (left + 1, up + 1)-(right - 1, down - 1), Cr, BF CASE 15 LINE (left, down)-(LR, up), Cr LINE STEP(0, 0)-(right, down), Cr LINE STEP(0, 0)-(left, down), Cr LINE (left, up)-(right, up), Cr END SELECT END IF NEXT Y NEXT X WordCenter = WordCenter + (Size * 8) NEXT Letter LOCATE 1, 1 PRINT " " PALETTE END SUB DEFSNG A-Z '---------------------------------------------------------------------------- SUB GetInputs CLS PALETTE PALETTE 0, (65536 + 256) * 26 PALETTE 13, 0 PALETTE 1, 65536 * 28 'Asks questions as input statements COLOR 15 LOCATE 3, 13 INPUT "What is your name"; Name$ LOCATE 5, 13 PRINT "Do you need Instructions (y/n)?" DO DO Ins$ = INKEY$ LOOP WHILE Ins$ = "" IF Ins$ = "y" OR Ins$ = "Y" THEN CALL HelpMe: GOTO 400 IF Ins$ = "n" THEN Ins$ = "N" LOOP WHILE Ins$ <> "N" 400 COLOR 15 CLS : REDIM A$(11), Row(11) A$(1) = "How's it going, " + Name$: Row(1) = 3 FOR i = 2 TO 11 READ A$(i), Row(i) NEXT i FOR i = 1 TO 8 LOCATE Row(i), INT((80 - LEN(A$(i))) / 2) PRINT A$(i) NEXT i 'Waits for level reply DO DO Level$ = INKEY$ LOOP UNTIL Level$ <> "" IF Level$ = CHR$(27) THEN CALL Stops IF Level$ = "D" OR Level$ = "d" THEN GOSUB DumbButt: GOTO 599 IF Level$ = "B" OR Level$ = "b" THEN GOSUB Beginner: GOTO 599 IF Level$ = "A" OR Level$ = "a" THEN GOSUB Advanced: GOTO 599 IF Level$ = "E" OR Level$ = "e" THEN GOSUB Expert: GOTO 599 IF Level$ = "M" OR Level$ = "m" THEN GOSUB Master: GOTO 599 IF Level$ = "C" OR Level$ = "c" THEN GOSUB Custom: GOTO 599 LOOP GOTO 599 END 'Sets DumbButt parameters DumbButt: Rows = 6 Columns = 6 Mines = 5 RETURN 'Sets Beginner parameters Beginner: Rows = 10 Columns = 10 Mines = 16 RETURN 'Sets Advanced parameters Advanced: Rows = 15 Columns = 15 Mines = 38 RETURN 'Sets Expert parameters Expert: Rows = 18 Columns = 24 Mines = 100 RETURN 'Sets Master parameters Master: Rows = 21 Columns = 30 Mines = 175 RETURN 'Gets custom parameters Custom: LOCATE Row(9), INT((79 - LEN(A$(9))) / 2) - 4 PRINT A$(9); INPUT Rows$ Rows = INT(VAL(Rows$) + .5) IF Rows < 6 THEN Rows = 6 IF Rows > 21 THEN Rows = 21 LOCATE Row(10), INT((79 - LEN(A$(10))) / 2) - 4 PRINT A$(10); INPUT Columns$ Columns = INT(VAL(Columns$) + .5) IF Columns < 6 THEN Columns = 6 IF Columns > 30 THEN Columns = 30 LOCATE Row(11), INT((79 - LEN(A$(11))) / 2) - 4 PRINT A$(11); INPUT Mines$ Mines = INT(VAL(Mines$) + .5) IF Mines < 5 THEN Mines = 5 IF Mines > Rows * Columns * 3 / 4 THEN Mines = INT(Rows * Columns * 3 / 4) RETURN 599 CLS PMines = Mines 'Palettes everything black so viewer can't see FOR i = 0 TO 15 PALETTE i, 0 NEXT i PALETTE 11, 63 COLOR 11 LOCATE 12, 30 PRINT "Loading" 'Puts numbers on screen to save FOR i = 0 TO 8 COLOR i IF i = 4 THEN COLOR 15 LOCATE 2, i * 3 + 2 PRINT i NEXT i 'Draws boxes around numbers FOR X = 9 TO 201 STEP 24 LINE (X, 13)-(X + 19, 32), 13, B NEXT X 'Draws Mine to be used LINE (0, 90)-(19, 109), 4, BF CIRCLE (9, 99), 3, 8 PAINT (9, 99), 8, 8 FOR l = 2 TO 16 STEP 7 LINE (2, l + 90)-(16, 18 - l + 90), 8 NEXT l LINE (9, 92)-(9, 106), 8 LINE (0, 90)-(19, 109), 13, B 'Draws BoxOut and BoxIn FOR j = 1 TO 6 READ Bx1, By1, Bx2, By2, Bx3, By3, Bc LINE (Bx1, By1)-(Bx2, By2), Bc LINE -(Bx3, By3), Bc NEXT j LINE (341, 211)-(347, 217), 4, BF LINE (341, 211)-(347, 217), 8, B LINE (341, 211)-(347, 217), 8 LINE (347, 211)-(341, 217), 8 'Draws Flag marker LINE (300, 230)-(319, 249), 10, BF LINE (311, 237)-(310, 245), 8, B LINE (305, 245)-(316, 245), 8 LINE (307, 244)-(314, 244), 8 FOR i = 1 TO 7 READ Bx1, By1, Bx2, By2, Bx3, By3, Bx4, By4, Bc LINE (Bx1, By1)-(Bx2, By2), Bc LINE -(Bx3, By3), Bc LINE -(Bx4, By4), Bc NEXT i PAINT (309, 237), 4, 4 'Draws HappyFace CIRCLE (509, 19), 9, 8 PAINT (509, 19), 14, 8 CIRCLE (506, 17), 3, 8, , , 2.3 PAINT (506, 17), 8, 8 CIRCLE (512, 17), 3, 8, , , 2.3 PAINT (512, 17), 8, 8 CIRCLE (509, 14), 9, 8, 4.18, 5.24 CIRCLE (509, 17), 7, 8, 4, 5.42 LINE (503, 22)-(505, 21), 8 LINE (515, 22)-(513, 21), 8 'Draws BadFace CIRCLE (409, 409), 9, 8 PAINT (409, 409), 14, 8 LINE (403, 405)-(407, 409), 8 LINE (407, 405)-(403, 409), 8 LINE (411, 405)-(415, 409), 8 LINE (415, 405)-(411, 409), 8 LINE (404, 405)-(408, 409), 8 LINE (408, 405)-(404, 409), 8 LINE (410, 405)-(414, 409), 8 LINE (414, 405)-(410, 409), 8 LINE (403, 412)-(415, 413), 8, B 'Draws FinishFace CIRCLE (209, 419), 9, 8 PAINT (209, 419), 14, 8 CIRCLE (205, 417), 3, 8, , , .75 PAINT (205, 416), 8, 8 CIRCLE (213, 417), 3, 8, , , .75 PAINT (213, 416), 8, 8 LINE (201, 416)-(217, 417), 8, B CIRCLE (209, 414), 9, 8, 4.18, 5.24 CIRCLE (209, 417), 7, 8, 4, 5.42 LINE (203, 422)-(205, 421), 8 LINE (215, 422)-(213, 421), 8 CALL StartGame END SUB '---------------------------------------------------------------------------- SUB HelpMe CLS '-*-*-*-*- C O N T R O L S -*-*-*-*- DIM XCn(12), YCn(12), h$(25) COLOR 12 LOCATE 1, 5 PRINT " C O N T R O L S : " LINE (46, 14)-(182, 14), 12 LINE (303, 5)-(303, 474), 12 COLOR 14 LOCATE 2, 8 PRINT "- During Play -" LOCATE 18, 8 PRINT "- After Play -" XCn(1) = 40 YCn(1) = 40 XCn(2) = 10 YCn(2) = 70 XCn(3) = 40 YCn(3) = 70 XCn(4) = 70 YCn(4) = 70 XCn(5) = 40 YCn(5) = 102 XCn(6) = 40 YCn(6) = 134 XCn(7) = 40 YCn(7) = 166 XCn(8) = 32 YCn(8) = 198 XCn(9) = 3 YCn(9) = 230 XCn(10) = 40 YCn(10) = 294 XCn(11) = 32 YCn(11) = 326 XCn(12) = 32 YCn(12) = 358 c = 1 FOR i = 1 TO 4 LINE (XCn(i) - 2, YCn(i) + 2)-(XCn(i) + 25, YCn(i) + 29), c, B LINE (XCn(i) - 2, YCn(i) + 2)-(XCn(i) + 25, YCn(i) + 29), c LINE (XCn(i) - 2, YCn(i) + 29)-(XCn(i) + 25, YCn(i) + 2), c LINE (XCn(i) + 1, YCn(i) + 5)-(XCn(i) + 22, YCn(i) + 26), c, B LINE (XCn(i) + 2, YCn(i) + 6)-(XCn(i) + 21, YCn(i) + 25), 0, BF NEXT i FOR i = 5 TO 12 l = 2 * (40 - XCn(i)) LINE (XCn(i) - 2, YCn(i) + 2)-(XCn(i) + 25 + l, YCn(i) + 29), c, B LINE (XCn(i) - 2, YCn(i) + 2)-(XCn(i) + 1, YCn(i) + 5), c LINE (XCn(i) - 2, YCn(i) + 29)-(XCn(i) + 1, YCn(i) + 26), c LINE (XCn(i) + 25 + l, YCn(i) + 2)-(XCn(i) + 22 + l, YCn(i) + 5), c LINE (XCn(i) + 25 + l, YCn(i) + 29)-(XCn(i) + 22 + l, YCn(i) + 26), c LINE (XCn(i) + 1, YCn(i) + 5)-(XCn(i) + 22 + l, YCn(i) + 26), c, B NEXT i COLOR 15 LOCATE 6, 16 PRINT "Hit -Arrows- to move" LOCATE 8, 16 PRINT "Hit -R- to restart" LOCATE 10, 16 PRINT "Hit -M- to Mark mine" LOCATE 12, 16 PRINT "Hit -P- to Pause" LOCATE 14, 16 PRINT "Hit -Esc- to Quit game" LOCATE 16, 16 PRINT "Hit -Space- to Uncover" LOCATE 20, 16 PRINT "Hit -N- for New game" LOCATE 22, 16 PRINT "Hit -Esc- to Quit prog" LOCATE 24, 16 PRINT "Hit -Any- to Startover" COLOR 11 LOCATE 4, 7 PRINT CHR$(24) LOCATE 6, 7 PRINT CHR$(25) FOR X = 48 TO 55 FOR Y = 48 TO 61 PSET (Y - 34, X + 35), POINT(X, Y) PSET (137 - Y, 138 - X), POINT(X, Y) NEXT Y NEXT X LOCATE 8, 7 PRINT "R" LOCATE 10, 7 PRINT "M" LOCATE 12, 7 PRINT "P" LOCATE 14, 6 PRINT "Esc" LOCATE 16, 3 PRINT "Space Bar" LOCATE 20, 7 PRINT "N" LOCATE 22, 6 PRINT "Esc" LOCATE 24, 6 PRINT "Any" '-*-*-*-*- H O W T O P L A Y -*-*-*-*- COLOR 12 LOCATE 1, 45 PRINT "H O W T O P L A Y : " LINE (350, 14)-(534, 14), 12 COLOR 14 LOCATE 2, 47 PRINT "- Object -" h$(1) = "When playing, you are presented with a " h$(2) = "mine field, and your objective is to loc-" h$(3) = "ate all the mines as quickly as possible." h$(4) = "To do this, you uncover the squares on" h$(5) = "the game board that do not contain mines." h$(6) = "If you uncover all the squares without" h$(7) = "mines, you win; if you uncover a mine in-" h$(8) = "stead of marking it, you lose the game." h$(9) = "If you play faster, you score better. Use" h$(10) = "the counters in the top corners to keep" h$(11) = "track of your progress.The counter on the" h$(12) = "right is a timer, which displays the time" h$(13) = "in seconds. It does not begin until you" h$(14) = "hit a key. The one on the left indicates" h$(15) = "the number of mines hidden in the field." h$(16) = "Every time you mark a square as a mine," h$(17) = "this number decreases by one." h$(18) = "If an uncovered square is labeled 1, and" h$(19) = "there is only one coverd square touching" h$(20) = "it, that square must be a mine. If an un-" h$(21) = "covered square already has the correct" h$(22) = "number of adjacent mines marked, clear" h$(23) = "around it. Don't guess. If you can't fig-" h$(24) = "ure out how to move, try approaching the" h$(25) = "area from a different direction." PR = 3 COLOR 15 restH = 8 FOR i = 1 TO 25 FOR j = 1 TO LEN(h$(i)) LOCATE PR, j + 39 PRINT MID$(h$(i), j, 1) NEXT j IF i = 17 THEN PR = PR + 1 COLOR 14 LOCATE 20, 47 PRINT "- Hints -" COLOR 15 END IF PR = PR + 1 NEXT i SLEEP COLOR 1 LOCATE 28, 3 PRINT "Hit any key to continue" SLEEP 299 END SUB '---------------------------------------------------------------------------- SUB Intro Hap = 0 CLS 'Finds how many operations in 3 seconds LOCATE 13, 34 COLOR 15 PRINT "Loading" Pauses = 0 TIME$ = "00:00:00" DO Pauses = Pauses + 1 LOOP UNTIL TIMER > .58 CLS GOSUB Happen 'Changes colors to black so viewer can't see what's going on FOR c = 1 TO 14 PALETTE c, 0 NEXT c GOSUB Happen 'Draws mine to be used CIRCLE (9, 9), 3, 4 PAINT (9, 9), 4, 4 FOR l = 2 TO 16 STEP 7 LINE (2, l)-(16, 18 - l), 4 NEXT l LINE (9, 2)-(9, 16), 4 GOSUB Happen REDIM Mine%(121) GET (0, 0)-(19, 19), Mine% CLS LOCATE 13, 34 COLOR 15 PRINT "Loading" GOSUB Happen 'Draws background dots DEFINT C, X-Y FOR i = 1 TO Pauses * 1.8 X = INT(RND * 640) Y = INT(RND * 480) r = INT(RND * 3) IF r = 2 THEN r = 1 ELSE r = 0 c = INT(RND * 20 + 1) IF c > 14 OR c = 1 OR c = 2 THEN c = 4 CIRCLE (X, Y), r, c GOSUB Happen NEXT i DEFSNG C, X-Y PALETTE PALETTE 15, 0 GOSUB Happen rest = 7 'Places mines for border (horizontal) FOR X = 20 TO 600 STEP 20 PUT (X, 20), Mine%, PSET PUT (620 - X, 440), Mine%, PSET GOSUB delay1 NEXT X GOSUB Happen rest = 7 'Places mines for border (vertical) FOR Y = 20 TO 440 STEP 20 PUT (20, 460 - Y), Mine%, PSET PUT (600, Y), Mine%, PSET GOSUB delay1 NEXT Y GOSUB Happen rest = .05 'Shows credits COLOR 14 REDIM cred1%(625), cred2%(217) GET (224, 194)-(412, 206), cred1% GET (280, 257)-(348, 268), cred2% LOCATE 13, 31 PRINT "Jung Productions Co." LOCATE 15, 29 PRINT "in Fredericksburg, Texas" LOCATE 17, 36 PRINT "Presents:" GOSUB delay2 GOSUB Happen 'Puts back random dots for top and bottom PUT (224, 194), cred1%, PSET PUT (280, 257), cred2%, PSET M$ = "ETERNAL REST" rest = 3 'Brings message on screen 1 letter at a time COLOR 1 FOR i = 1 TO 13 LOCATE 15, 27 PRINT LEFT$(M$, i) GOSUB delay2 NEXT i GOSUB Happen rest = 3 'Moves message across screen COLOR 1 FOR i = 27 TO 40 LOCATE 15, i PRINT " "; M$ GOSUB delay2: GOSUB Happen NEXT i GOSUB Happen rest = 6 COLOR 1 'Spreads message out 1 letter at a time FOR i = 1 TO 13 FOR M% = 39 + i TO i * 2 + 25 STEP -1 LOCATE 15, M% PRINT MID$(M$, i, 1); " " GOSUB delay2: GOSUB Happen NEXT M% IF i = 7 THEN i = 9 NEXT i GOSUB Happen REDIM red(15), green(15), blue(15) 'Gets color attributes FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i Hap = 1 GOSUB Happen rest = 7 'Fades background dots except colors 4 and 9 FOR i = 3 TO 14 red = red(i): green = green(i): blue = blue(i) red1 = red(i) / 21: green1 = green(i) / 21: blue1 = blue(i) / 21 FOR j = 0 TO 21 PALETTE i, 65536 * blue + 256 * green + red blue = blue - blue1: green = green - green1: red = red - red1 GOSUB delay3: GOSUB Happen NEXT j IF i = 3 THEN i = 4 NEXT i GOSUB Happen rest = 3 'Fades mines and color 4 FOR c% = 63 TO 0 STEP -1 PALETTE 4, c% GOSUB delay3: GOSUB Happen NEXT c% GOSUB Happen 'Puts message using SubProgram BigLetter CLS BigLetter "ETERNAL", 8, 1, 1, 100 BigLetter "ETERNAL", 8, 2, 13, 100 BigLetter "REST", 8, 1, 1, 253 BigLetter "REST", 8, 2, 13, 253 GOSUB Happen rest = .1 GOSUB delay3: GOSUB Happen rest = 2 'Fades blue to red FOR i = 42 TO 0 STEP -1 blue = i: red = 63 - (i * 3 / 2) PALETTE 1, 65536 * blue + red GOSUB delay3: GOSUB Happen NEXT i GOSUB Happen 'Fades message and color 1 FOR i = 1 TO 5 IF i = 1 THEN pc1 = 63: pc2 = 22: pc = -1: rest = 3 IF i = 2 THEN pc1 = 22: pc2 = 37: pc = 1: rest = 3 IF i = 3 THEN pc1 = 37: pc2 = 5: pc = -1: rest = 3 IF i = 4 THEN pc1 = 5: pc2 = 22: pc = 1: rest = 4 IF i = 5 THEN pc1 = 22: pc2 = 0: pc = -1: rest = 1 FOR c% = pc1 TO pc2 STEP pc PALETTE 1, c% GOSUB delay3: GOSUB Happen IF i = 5 AND c% = 18 THEN SLEEP 1 NEXT c% NEXT i GOSUB Happen rest = 2 'Fades green to red and then to black FOR i = 42 TO 0 STEP -1 green = i: red = 42 - i PALETTE 2, 256 * green + red GOSUB delay3: GOSUB Happen NEXT i rest = 2 FOR i = 42 TO 0 STEP -1 PALETTE 2, i GOSUB delay3: GOSUB Happen NEXT i GOSUB Happen rest = .1 GOSUB delay3 PALETTE GOTO 199 END 'Does delays in SubProgram Intro delay1: FOR t = 1 TO Pauses / rest NEXT t RETURN 'Does delays in SubProgram Intro delay2: FOR t = 1 TO Pauses / rest NEXT t RETURN 'Does delays in SubProgram Intro delay3: FOR t = 1 TO Pauses / rest NEXT t RETURN 'Sees what player wants to do Happen: z$ = INKEY$ IF z$ = "" THEN GOTO 190 IF z$ = CHR$(27) THEN CALL Stops IF z$ = CHR$(32) THEN IF Hap = 0 THEN REDIM red(15), green(15), blue(15) 'Gets color attributes FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i END IF GOTO 199 END IF 190 RETURN 199 END SUB '---------------------------------------------------------------------------- SUB StartGame 'Saves mine dimensions and mine and numbers REDIM Mine%(121), Flag%(121), BoxTemp%(121), BoxOut%(121), BoxIn%(121) REDIM HappyFace%(115), BadFace%(115), FinishFace%(115) REDIM N0%(121), N1%(121), N2%(121), N3%(121), N4%(121) REDIM N5%(121), N6%(121), N7%(121), N8%(121) GET (0, 90)-(19, 109), Mine% GET (300, 230)-(319, 249), Flag% GET (300, 200)-(319, 219), BoxOut% GET (341, 211)-(347, 217), BoxIn% GET (500, 10)-(518, 28), HappyFace% GET (400, 400)-(418, 418), BadFace% GET (200, 410)-(218, 428), FinishFace% GET (9, 13)-(28, 32), N0% GET (33, 13)-(52, 32), N1% GET (57, 13)-(76, 32), N2% GET (81, 13)-(100, 32), N3% GET (105, 13)-(124, 32), N4% GET (129, 13)-(148, 32), N5% GET (153, 13)-(172, 32), N6% GET (177, 13)-(196, 32), N7% GET (201, 13)-(220, 32), N8% PMines = Mines RestartHere: CLS BigLetter "Hit any key", 6, 4, 10, 200 p$ = "" GOSUB PassWord Mines = PMines 'Dimensions and Saves Mine and Numbers REDIM Mine(Rows + 2, Columns + 2), PMine(Rows + 2, Columns + 2) REDIM XShow(Rows * Columns - Mines), YShow(Rows * Columns - Mines) CLS 'Places mines at random FOR i = 1 TO Mines DO Y = INT(RND * Rows + 1) X = INT(RND * Columns + 1) LOOP WHILE Mine(Y, X) = 9 Mine(Y, X) = 9 NEXT i 'Figures out number of mines around each place FOR i = 1 TO Rows FOR j = 1 TO Columns IF Mine(i, j) = 9 THEN GOTO 820 M = 0 IF Mine(i - 1, j - 1) = 9 THEN M = M + 1 IF Mine(i - 1, j) = 9 THEN M = M + 1 IF Mine(i - 1, j + 1) = 9 THEN M = M + 1 IF Mine(i, j - 1) = 9 THEN M = M + 1 IF Mine(i, j + 1) = 9 THEN M = M + 1 IF Mine(i + 1, j - 1) = 9 THEN M = M + 1 IF Mine(i + 1, j) = 9 THEN M = M + 1 IF Mine(i + 1, j + 1) = 9 THEN M = M + 1 Mine(i, j) = M 820 NEXT j NEXT i 'Does box of -+- Mine(x, y) = -1 -+- around border FOR i = 0 TO Columns + 1 Mine(0, i) = -1 Mine(Rows + 1, i) = -1 NEXT i FOR i = 0 TO Rows + 1 Mine(i, 0) = -1 Mine(i, Columns + 1) = -1 NEXT i CLS 'Draws borders BorderWidth1 = 20 * Columns + 16 BorderHeigth1 = 20 * (Rows + 1) + 24 xa1 = INT((639 - BorderWidth1) / 2) - 5 xb1 = xa1 + BorderWidth1 + 5 ya1 = INT((479 - BorderHeigth1) / 2) + 2 ya1 = INT(ya1 / 16 + .5) * 16 - 13 yb1 = ya1 + BorderHeigth1 + 8 LINE (xa1, ya1)-(xb1, yb1), 7, B LINE (xa1 + 1, ya1 + 1)-(xb1 - 1, yb1 - 1), 7, B xa2 = xa1 + 10 xb2 = xb1 - 10 ya2 = ya1 + 10 yb2 = ya2 + 20 LINE (xa2 - 1, ya2 - 1)-(xb2 + 1, yb2 + 1), 7, B LINE (xa2 - 2, ya2 - 2)-(xb2 + 2, yb2 + 2), 7, B LINE (xa2, ya2)-(xb2, yb2), 13, B LINE (xa2 + 1, ya2 + 1)-(xb2 - 1, yb2 - 1), 13, B xa3 = xa2 xb3 = xb2 ya3 = ya1 + 40 yb3 = yb1 - 11 LINE (xa3 - 1, ya3 - 1)-(xb3 + 1, yb3 + 1), 7, B LINE (xa3 - 2, ya3 - 2)-(xb3 + 2, yb3 + 2), 7, B LINE (xa3, ya3)-(xb3, yb3), 13, B WordRow = INT((ya1 - 2) / 16) + 2 WordColumn1 = INT(xa1 / 8) + 3 WordColumn2 = 77 - WordColumn1 XStart = xa3 + 1 YStart = ya3 + 1 'Draws BoxOut on field FOR i = XStart TO (Columns - 1) * 20 + XStart STEP 20 FOR j = YStart TO (Rows - 1) * 20 + YStart STEP 20 PUT (i, j), BoxOut%, PSET NEXT j NEXT i 'Dimensions and Saves Mine and Numbers PALETTE PALETTE 0, (65536 + 256 + 1) * 25 PALETTE 1, 65536 * 35 PALETTE 2, 256 * 35 PALETTE 4, 53 PALETTE 5, 65536 * 35 + 28 PALETTE 6, 65536 * 15 + 256 * 45 + 45 PALETTE 7, 65536 * 37 + 256 * 37 + 37 PALETTE 8, 0 PALETTE 9, 28 PALETTE 10, 256 * 21 PALETTE 11, 65536 * 15 + 256 * 15 + 5 PALETTE 12, (65536 + 256 + 1) * 24 PALETTE 13, (65536 + 256 + 1) * 18 PALETTE 14, 65536 * 14 + 256 * 42 + 42 PALETTE 15, 256 * 25 + 45 PAINT (0, 0), 11, 7 TIME$ = "00:00:00" 'Refigures word columns for specific number of mines and time IF Mines > 99 THEN ColumnWord1 = WordColumn1: GOTO 825 IF Mines > 9 THEN ColumnWord1 = WordColumn1 + 1: GOTO 825 IF Mines <= 9 THEN ColumnWord1 = WordColumn1 + 2: GOTO 825 825 IF INT(TIMER) <= 9 THEN ColumnWord2 = WordColumn2: GOTO 830 IF INT(TIMER) > 9 THEN ColumnWord2 = WordColumn2 - 1: GOTO 830 IF INT(TIMER) > 99 THEN ColumnWord2 = WordColumn2 - 2: GOTO 830 830 'Prints HappyFace in Center PUT (309, ya2 + 1), HappyFace%, PSET 832 'Prints # of mines and time in top corners COLOR 9 LOCATE WordRow, ColumnWord1 PRINT Mines LOCATE WordRow, ColumnWord2 PRINT USING "####"; INT(TIMER) '****--*--****--*--****--*--****--*--****--*--****--*--****--*--****--*--**** '**** M A I N P R O G R A M **** '****--*--****--*--****--*--****--*--****--*--****--*--****--*--****--*--**** CheatNum = 0 PartDone = 0 WholeDone = Rows * Columns XColumn = 1 YRow = 1 XPut = (XColumn - 1) * 20 + XStart YPut = (YRow - 1) * 20 + YStart GET (XPut + 11, YPut + 11)-(XPut + 17, YPut + 17), BoxTemp% PUT (XPut + 11, YPut + 11), BoxIn%, PSET DO Move$ = INKEY$ LOOP WHILE Move$ = "" TIME$ = "00:00:00" GOTO 503 DO DO LOCATE WordRow, ColumnWord2 PRINT USING "####"; INT(TIMER) Move$ = INKEY$ LOOP WHILE Move$ = "" 503 PUT (XPut + 11, YPut + 11), BoxTemp%, PSET IF Move$ = CHR$(0) + "H" THEN YRow = YRow - 1: PMove$ = Move$ IF Move$ = CHR$(0) + "P" THEN YRow = YRow + 1: PMove$ = Move$ IF Move$ = CHR$(0) + "K" THEN XColumn = XColumn - 1: PMove$ = Move$ IF Move$ = CHR$(0) + "M" THEN XColumn = XColumn + 1: PMove$ = Move$ IF Move$ = CHR$(32) THEN GOSUB ShowPlace IF Move$ = "M" OR Move$ = "m" THEN GOSUB MarkFlag IF Move$ = "F" OR Move$ = "f" THEN GOSUB MarkFlag IF Pass = 1 AND CheatNum < 3 THEN IF Move$ = "B" OR Move$ = "b" THEN GOSUB ShowBlanks IF Move$ = "*" THEN GOSUB GetAClue IF VAL(Move$) >= 1 AND VAL(Move$) <= 8 THEN GOSUB ShowNumbers END IF IF Move$ = CHR$(27) THEN CALL Stops IF Move$ = "R" OR Move$ = "r" THEN 'Palettes everything black so viewer can't see FOR i = 0 TO 15 PALETTE i, 0 NEXT i PALETTE 11, 63 COLOR 11 LOCATE 13, 35 PRINT "Loading" GOTO NewGame END IF IF XColumn = 0 THEN XColumn = Columns IF XColumn = Columns + 1 THEN XColumn = 1 IF YRow = 0 THEN YRow = Rows IF YRow = Rows + 1 THEN YRow = 1 XPut = (XColumn - 1) * 20 + XStart YPut = (YRow - 1) * 20 + YStart GET (XPut + 11, YPut + 11)-(XPut + 17, YPut + 17), BoxTemp% PUT (XPut + 11, YPut + 11), BoxIn%, PSET LOOP END MarkFlag: IF Mines = 0 AND Mine(YRow, XColumn) <> -2 THEN GOTO 880 IF Mine(YRow, XColumn) = -1 THEN GOTO 880 IF Mine(YRow, XColumn) = -2 THEN Mine(YRow, XColumn) = PMine(YRow, XColumn) PUT (XPut, YPut), BoxOut%, PSET PartDone = PartDone - 1 Mines = Mines + 1 GOTO 878 END IF PUT (XPut, YPut), Flag%, PSET PMine(YRow, XColumn) = Mine(YRow, XColumn) Mine(YRow, XColumn) = -2 Mines = Mines - 1 PartDone = PartDone + 1 IF PartDone = WholeDone THEN GOTO YouWin 878 LOCATE WordRow, ColumnWord1 PRINT Mines 880 RETURN ShowPlace: IF Mine(YRow, XColumn) = -1 THEN GOTO 885 PartDone = PartDone + 1 IF Mine(YRow, XColumn) = 0 THEN ABX = XColumn ABY = YRow PUT (XPut, YPut), N0%, PSET Mine(YRow, XColumn) = -1 ShN = 0 ShD = 0 GOSUB BreakOpen XColumn = ABX YRow = ABY GOTO 884 END IF IF Mine(YRow, XColumn) = 1 THEN PUT (XPut, YPut), N1%, PSET IF Mine(YRow, XColumn) = 2 THEN PUT (XPut, YPut), N2%, PSET IF Mine(YRow, XColumn) = 3 THEN PUT (XPut, YPut), N3%, PSET IF Mine(YRow, XColumn) = 4 THEN PUT (XPut, YPut), N4%, PSET IF Mine(YRow, XColumn) = 5 THEN PUT (XPut, YPut), N5%, PSET IF Mine(YRow, XColumn) = 6 THEN PUT (XPut, YPut), N6%, PSET IF Mine(YRow, XColumn) = 7 THEN PUT (XPut, YPut), N7%, PSET IF Mine(YRow, XColumn) = 8 THEN PUT (XPut, YPut), N8%, PSET IF Mine(YRow, XColumn) = 9 THEN PUT (XPut, YPut), Mine%, PSET PXP = XPut PYP = YPut GOTO YouLose END IF Mine(YRow, XColumn) = -1 884 IF PartDone = WholeDone THEN GOTO YouWin IF WholeDone - PartDone = Mines THEN GOTO ShowWin 885 RETURN ShowBlanks: CheatNum = CheatNum + 1 FOR YRow = 1 TO Rows FOR XColumn = 1 TO Columns XPut = (XColumn - 1) * 20 + XStart YPut = (YRow - 1) * 20 + YStart IF Mine(YRow, XColumn) = 0 THEN ABX = XColumn ABY = YRow PUT (XPut, YPut), N0%, PSET PartDone = PartDone + 1 Mine(YRow, XColumn) = -1 ShN = 0 ShD = 0 GOSUB BreakOpen XColumn = ABX YRow = ABY END IF NEXT XColumn NEXT YRow IF PartDone = WholeDone THEN GOTO YouWin IF WholeDone - PartDone = Mines THEN GOTO ShowWin RETURN BreakOpen: YR = YRow - 1 XC = XColumn - 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow - 1 XC = XColumn IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow - 1 XC = XColumn + 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow XC = XColumn - 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow XC = XColumn + 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow + 1 XC = XColumn - 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow + 1 XC = XColumn IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak YR = YRow + 1 XC = XColumn + 1 IF XC > 0 AND XC <= Columns AND YR > 0 AND YR <= Rows THEN GOSUB ShowBreak ShD = ShD + 1 IF ShD <= ShN THEN YRow = YShow(ShD) XColumn = XShow(ShD) GOTO BreakOpen END IF RETURN ShowBreak: XPut = (XC - 1) * 20 + XStart YPut = (YR - 1) * 20 + YStart IF Mine(YR, XC) = -1 THEN GOTO 888 PartDone = PartDone + 1 IF Mine(YR, XC) = 0 THEN PUT (XPut, YPut), N0%, PSET Mine(YR, XC) = -1 FOR i = ShD + 1 TO ShN IF XC = XShow(i) AND YR = YShow(i) THEN GOTO 888 NEXT i ShN = ShN + 1 YShow(ShN) = YR XShow(ShN) = XC GOTO 887 END IF IF Mine(YR, XC) = 1 THEN PUT (XPut, YPut), N1%, PSET IF Mine(YR, XC) = 2 THEN PUT (XPut, YPut), N2%, PSET IF Mine(YR, XC) = 3 THEN PUT (XPut, YPut), N3%, PSET IF Mine(YR, XC) = 4 THEN PUT (XPut, YPut), N4%, PSET IF Mine(YR, XC) = 5 THEN PUT (XPut, YPut), N5%, PSET IF Mine(YR, XC) = 6 THEN PUT (XPut, YPut), N6%, PSET IF Mine(YR, XC) = 7 THEN PUT (XPut, YPut), N7%, PSET IF Mine(YR, XC) = 8 THEN PUT (XPut, YPut), N8%, PSET Mine(YR, XC) = -1 887 IF PartDone = WholeDone THEN GOTO YouWin IF WholeDone - PartDone = Mines THEN GOTO ShowWin 888 RETURN GetAClue: CheatNum = CheatNum + 1 DO i = INT(RND * Columns + 1) j = INT(RND * Rows + 1) LOOP WHILE Mine(j, i) = -1 OR Mine(j, i) = -2 XPut = (i - 1) * 20 + XStart YPut = (j - 1) * 20 + YStart IF Mine(j, i) = 0 THEN PUT (XPut, YPut), N0%, PSET XColumn = i YRow = j GOTO ShowPlace END IF IF Mine(j, i) = 1 THEN PUT (XPut, YPut), N1%, PSET IF Mine(j, i) = 2 THEN PUT (XPut, YPut), N2%, PSET IF Mine(j, i) = 3 THEN PUT (XPut, YPut), N3%, PSET IF Mine(j, i) = 4 THEN PUT (XPut, YPut), N4%, PSET IF Mine(j, i) = 5 THEN PUT (XPut, YPut), N5%, PSET IF Mine(j, i) = 6 THEN PUT (XPut, YPut), N6%, PSET IF Mine(j, i) = 7 THEN PUT (XPut, YPut), N7%, PSET IF Mine(j, i) = 8 THEN PUT (XPut, YPut), N8%, PSET IF Mine(j, i) = 9 THEN PUT (XPut, YPut), Flag%, PSET Mines = Mines - 1 LOCATE WordRow, ColumnWord1 PRINT Mines END IF Mine(j, i) = -1 PartDone = PartDone + 1 IF PartDone = WholeDone THEN GOTO ShowWin IF WholeDone - PartDone = Mines THEN GOTO ShowWin RETURN ShowNumbers: CheatNum = CheatNum + 1 Var = VAL(Move$) FOR YRow = 1 TO Rows FOR XColumn = 1 TO Columns XPut = (XColumn - 1) * 20 + XStart YPut = (YRow - 1) * 20 + YStart IF Mine(YRow, XColumn) = Var THEN IF Mine(YRow, XColumn) = 1 THEN PUT (XPut, YPut), N1%, PSET IF Mine(YRow, XColumn) = 2 THEN PUT (XPut, YPut), N2%, PSET IF Mine(YRow, XColumn) = 3 THEN PUT (XPut, YPut), N3%, PSET IF Mine(YRow, XColumn) = 4 THEN PUT (XPut, YPut), N4%, PSET IF Mine(YRow, XColumn) = 5 THEN PUT (XPut, YPut), N5%, PSET IF Mine(YRow, XColumn) = 6 THEN PUT (XPut, YPut), N6%, PSET IF Mine(YRow, XColumn) = 7 THEN PUT (XPut, YPut), N7%, PSET IF Mine(YRow, XColumn) = 8 THEN PUT (XPut, YPut), N8%, PSET Mine(YRow, XColumn) = -1 PartDone = PartDone + 1 END IF NEXT XColumn NEXT YRow IF PartDone = WholeDone THEN GOTO YouWin IF WholeDone - PartDone = Mines THEN GOTO ShowWin RETURN PassWord: p = 0 DO p = p + 1 DO Ck$ = INKEY$ LOOP WHILE Ck$ = "" GOSUB Caps IF LEN(p$) = 1 AND p$ <> "D" THEN Pass = 0: GOTO PR: LOOP WHILE p < 8 IF p$ = "DROWSSAP" THEN Pass = 1 ELSE Pass = 0 PR: RETURN Caps: IF Ck$ = CHR$(27) THEN CALL Stops IF Ck$ = "a" OR Ck$ = "d" OR Ck$ = "o" OR Ck$ = "p" OR Ck$ = "r" OR Ck$ = "s" OR Ck$ = "w" THEN IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 IF ASC(Ck$) > 90 AND Ck$ <> "" THEN p$ = p$ + CHR$(ASC(Ck$) - 32): GOTO 989 END IF p$ = p$ + Ck$ 989 RETURN YouLose: PUT (309, ya2 + 1), BadFace%, PSET FOR YRow = 1 TO Rows FOR XColumn = 1 TO Columns XPut = (XColumn - 1) * 20 + XStart YPut = (YRow - 1) * 20 + YStart IF Mine(YRow, XColumn) = 0 THEN PUT (XPut, YPut), N0%, PSET IF Mine(YRow, XColumn) = 1 THEN PUT (XPut, YPut), N1%, PSET IF Mine(YRow, XColumn) = 2 THEN PUT (XPut, YPut), N2%, PSET IF Mine(YRow, XColumn) = 3 THEN PUT (XPut, YPut), N3%, PSET IF Mine(YRow, XColumn) = 4 THEN PUT (XPut, YPut), N4%, PSET IF Mine(YRow, XColumn) = 5 THEN PUT (XPut, YPut), N5%, PSET IF Mine(YRow, XColumn) = 6 THEN PUT (XPut, YPut), N6%, PSET IF Mine(YRow, XColumn) = 7 THEN PUT (XPut, YPut), N7%, PSET IF Mine(YRow, XColumn) = 8 THEN PUT (XPut, YPut), N8%, PSET IF Mine(YRow, XColumn) = 9 THEN PUT (XPut, YPut), Mine%, PSET NEXT XColumn NEXT YRow FOR i = PXP TO PXP + 19 FOR j = PYP TO PYP + 19 IF POINT(i, j) = 4 THEN PSET (i, j), 2 NEXT j NEXT i '------------- E F F E C T S ------------ FOR i = 1 TO Pauses / 5 X = INT(RND * 14) + 3 Y = INT(RND * 14) + 3 Rx = ABS(10 - ABS(10 - X)) Ry = ABS(10 - ABS(10 - Y)) IF Rx > Ry THEN Rad = Ry ELSE Rad = Rx XBlow = PXP + X YBlow = PYP + Y FOR j = 0 TO Rad ColBlow = INT(RND * 16) CIRCLE (XBlow, YBlow), j, ColBlow NEXT j NEXT i FOR i = 0 TO 14 Rb = INT(RND * 30) Rg = INT(RND * 30) Rr = INT(RND * 30) PALETTE i, (65536 * Rb) + (256 * Rg) + Rr NEXT i PALETTE 14, 37 PALETTE 15, 37 REDIM XBLood(35), YBlood(35), YStep(35) FOR i = 1 TO 35 XBLood(i) = INT(RND * 640) YBlood(i) = INT(RND * 480 - 479) YStep(i) = INT(RND * 3 + 1) NEXT i DO FOR i = 1 TO 35 CIRCLE (XBLood(i), YBlood(i)), 5, 14 PAINT (XBLood(i), YBlood(i)), 14, 14 CIRCLE (XBLood(i), YBlood(i)), 5, 15 PAINT (XBLood(i), YBlood(i)), 15, 15 YBlood(i) = YBlood(i) + YStep(i) IF YBlood(i) > 480 THEN DO XBLood(i) = INT(RND * 640) LOOP WHILE POINT(XBLood(i), 1) = 4 YBlood(i) = -5 YStep(i) = INT(RND * 3 + 2) END IF FOR Del = 1 TO Pauses / 2500 NEXT Del NEXT i z$ = INKEY$ LOOP WHILE z$ = "" IF z$ = CHR$(27) THEN CALL Stops IF z$ = "N" OR z$ = "n" THEN 'Palettes everything black so viewer can't see FOR i = 0 TO 15 PALETTE i, 0 NEXT i PALETTE 11, 63 COLOR 11 LOCATE 13, 35 PRINT "Loading" GOTO NewGame END IF RESTORE REDIM red(15), green(15), blue(15) FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i GOTO 899 END ShowWin: FOR i = 1 TO Columns FOR j = 1 TO Rows IF Mine(j, i) = 9 THEN XPut = (i - 1) * 20 + XStart YPut = (j - 1) * 20 + YStart PUT (XPut, YPut), Flag%, PSET END IF NEXT j NEXT i YouWin: PUT (309, ya2 + 1), FinishFace%, PSET SLEEP CLS RESTORE PALETTE 8, 0 NumHapDone = 0 DO XHappy = INT(RND * 32) * 20 YHappy = INT(RND * 24) * 20 IF POINT(XHappy + 10, YHappy + 10) = 14 THEN GOTO 969 PUT (XHappy, YHappy), FinishFace%, PSET 967 NumHapDone = NumHapDone + 1 z$ = INKEY$ IF z$ = CHR$(27) THEN CALL Stops IF z$ = "N" OR z$ = "n" THEN 'Palettes everything black so viewer can't see FOR i = 0 TO 15 PALETTE i, 0 NEXT i PALETTE 11, 63 COLOR 11 LOCATE 13, 35 PRINT "Loading" GOTO NewGame END IF IF z$ <> "" THEN RESTORE REDIM red(15), green(15), blue(15) FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i END IF 969 LOOP WHILE NumHapDone <> 768 BigLetter "You Win", 10, 2, 1, 160 PUT (0, 0), FinishFace%, PSET z$ = INKEY$ PALETTE 8, 0 blue = 21 green = 63 red = 63 blue1 = 0 green1 = 63 red1 = 0 DO pb = blue pg = green PR = red pb1 = blue1 pg1 = green1 pr1 = red1 blue = INT(RND * 64) green = INT(RND * 64) red = INT(RND * 64) blue1 = INT(RND * 64) green1 = INT(RND * 64) red1 = INT(RND * 64) B = pb g = pg r = PR b1 = pb1 g1 = pg1 r1 = pr1 sb = (blue - pb) / 21 sg = (green - pg) / 21 sr = (red - PR) / 21 sb1 = (blue1 - pb1) / 21 sg1 = (green1 - pg1) / 21 sr1 = (red1 - pr1) / 21 FOR i = 1 TO 21 B = B + sb g = g + sg r = r + sr b1 = b1 + sb1 g1 = g1 + sg1 r1 = r1 + sr1 PALETTE 14, 65536 * ABS(INT(B)) + 256 * ABS(INT(g)) + ABS(INT(r)) PALETTE 2, 65536 * ABS(INT(b1)) + 256 * ABS(INT(g1)) + ABS(INT(r1)) FOR t = 1 TO Pauses / 4 NEXT t NEXT i z$ = INKEY$ LOOP WHILE z$ = "" IF z$ = CHR$(27) THEN CALL Stops IF z$ = "N" OR z$ = "n" THEN 'Palettes everything black so viewer can't see FOR i = 0 TO 15 PALETTE i, 0 NEXT i PALETTE 11, 63 COLOR 11 LOCATE 13, 35 PRINT "Loading" GOTO NewGame END IF RESTORE REDIM red(15), green(15), blue(15) FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i GOTO 899 END NewGame: RESTORE REDIM A$(11), Row(11), red(15), green(15), blue(15) FOR i = 1 TO 15 READ red(i), green(i), blue(i) NEXT i FOR i = 2 TO 11 READ A$(i), Row(i) NEXT i GOTO RestartHere 899 END SUB '---------------------------------------------------------------------------- SUB Stops CLS PALETTE LOCATE 27, 3 PRINT "Press any key to return to system" DO LOOP WHILE INKEY$ = "" STOP END SUB