'=========================================================================== ' Subject: MOUSE DRIVEN BLACKJACK GAME Date: 07-25-99 (12:02) ' Author: Marc Santa Code: QB, QBasic, PDS ' Origin: santa@tir.com Packet: GAMES.ABC '=========================================================================== DECLARE SUB PlayWav (wavefile$) DECLARE SUB ValidWavHeader (FILE$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%) DECLARE SUB WriteToDSP (v%) DECLARE SUB PlayBack (buffer$, size%, freq&, BytesPerSec&, chans%, num%) DECLARE SUB delay (tdelay!) DECLARE FUNCTION GetBlasterAddr% () DECLARE FUNCTION SBreset% () DECLARE SUB MOUSEHIDE () DECLARE SUB MouseStatus (LB%, RB%, xMouse%, yMouse%) DECLARE FUNCTION mouseInit% () DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) DECLARE SUB MOUSESHOW () DECLARE SUB EIGHT (x!, Y!, C!) DECLARE SUB FIVE (x!, Y!, C!) DECLARE SUB FOUR (x!, Y!, C!) DECLARE SUB ONE (x!, Y!, C!) DECLARE SUB SEVEN (x!, Y!, C!) DECLARE SUB SIX (x!, Y!, C!) DECLARE SUB THREE (x!, Y!, C!) DECLARE SUB TWO (x!, Y!, C!) DECLARE SUB ZERO (x!, Y!, C!) DECLARE SUB NINE (x!, Y!, C!) DECLARE SUB BIGUSDSPADE (x!, Y!) DECLARE SUB BIGSPADE (x!, Y!) DECLARE SUB BIGDIAMOND (x!, Y!) DECLARE SUB BIGCLUB (x!, Y!) DECLARE SUB BIGUSDCLUB (x!, Y!) DECLARE SUB BIGHEART (x!, Y!) DECLARE SUB BIGUSDHEART (x!, Y!) DECLARE SUB BLANKCARD (x!, Y!) DECLARE SUB NUMBER (N!, x!, Y!) DECLARE SUB CARDSUIT (CARD!, x!, Y!) DECLARE SUB TITLESCREEN () DECLARE SUB DRAWA (x!, Y!, C!) DECLARE SUB DRAW2 (x!, Y!, C!) DECLARE SUB DRAW3 (x!, Y!, C!) DECLARE SUB DRAW4 (x!, Y!, C!) DECLARE SUB DRAW5 (x!, Y!, C!) DECLARE SUB DRAW6 (x!, Y!, C!) DECLARE SUB DRAW7 (x!, Y!, C!) DECLARE SUB DRAW8 (x!, Y!, C!) DECLARE SUB DRAW9 (x!, Y!, C!) DECLARE SUB DRAW10 (x!, Y!, C!) DECLARE SUB DRAWJ (x!, Y!, C!) DECLARE SUB DRAWQ (x!, Y!, C!) DECLARE SUB DRAWK (x!, Y!, C!) DECLARE SUB DRAWCARD (x!, Y!) DECLARE SUB CLUB (x!, Y!) DECLARE SUB DIAMOND (x!, Y!) DECLARE SUB HEART (x!, Y!) DECLARE SUB SPADE (x!, Y!) DIM SHARED mouse$ '----------------------------------------- DIM CPUC(12), P1C(12) DIM CARD(52) DIM CASH$(8) COMMON SHARED BlasterAddr%, dma%, repeats% RANDOMIZE TIMER mouse$ = SPACE$(57) ' | FOR I% = 1 TO 57 ' | READ a$ ' | H$ = CHR$(VAL("&H" + a$)) ' | MID$(mouse$, I%, 1) = H$ ' | NEXT I% ' | DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 'this stuff is DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 'complicated you DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 'shouldn't worry DATA 8B,5E,06,89,17,5D,CA,08,00 'about in now ms% = mouseInit% '<--calls function to check and IF NOT ms% THEN 'see if mouse is installed PRINT "Mouse not found" '<--if none then end END IF '(you can take out END so it won't 'quit) MOUSESHOW '<--calls sub to show the mouse MouseStatus LB%, RB%, x%, Y% '<--calls sub MouseStatus to MOUSESHOW REM LOCATE 1, 1: PRINT X%, Y% 'get mouse status 'this prints the variables 'lb% - left mouse button value 'rb% - right mouse button value 'x% - the X location 'y% - the Y location FOR x = 1 TO 52: CARD(x) = x: NEXT x FOR x = 1 TO 11: CPUC(x) = 0: P1C(x) = 0: NEXT x TBNUM = 1: TEMPBURN = 1 TEMPP = 0: TEMPC = 0 CASH = 10000 10 CLS : SCREEN 12 CALL TITLESCREEN GOSUB PRESSANYKEY CLS C = 1 PC = 1 11 REM *** START OF LOOP *** FOR x = 1 TO 11: CPUC(x) = 0: P1C(x) = 0: NEXT x TEMPP = 0: TEMPC = 0 GOSUB PLAYSCREEN GOSUB SETUP GOSUB SHUFFLE CURRENT = 1 DO GOSUB PLAYSCREEN GOSUB SETUP GOSUB PLACEBET REM * FIRST TWO CARDS FOR PLAYER * IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 GOSUB ADDPLAYERCARD CURRENT = CURRENT + 1 PC = PC + 1 GOSUB ADDPLAYERCARD IF P1C(1) = 1 AND P1C(2) = 10 THEN P1C(1) = 11: TEMPP = 21 IF P1C(1) = 10 AND P1C(2) = 1 THEN P1C(2) = 11: TEMPP = 21 CURRENT = CURRENT + 1 PC = PC + 1 REM * FIRST TWO CARDS FOR COMPUTER IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 GOSUB ADDCPUCARD CURRENT = CURRENT + 1 C = C + 1 IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 CALL BLANKCARD(210, 220) C2S = CARD(CURRENT) IF CARD(CURRENT) < 14 THEN CPUC(C) = CARD(CURRENT) IF CARD(CURRENT) > 13 AND CARD(CURRENT) < 27 THEN CPUC(C) = CARD(CURRENT) - 13 IF CARD(CURRENT) > 26 AND CARD(CURRENT) < 40 THEN CPUC(C) = CARD(CURRENT) - 26 IF CARD(CURRENT) > 39 THEN CPUC(C) = CARD(CURRENT) - 39 IF CPUC(C) > 10 THEN CPUC(C) = 10 TEMPC = TEMPC + CPUC(C) IF CPUC(1) = 1 AND CPUC(2) = 10 THEN CPUC(1) = 11: TEMPC = 21 IF CPUC(2) = 1 AND CPUC(1) = 10 THEN CPUC(2) = 11: TEMPC = 21 CURRENT = CURRENT + 1 C = C + 1 IF TEMPP = 21 THEN GOSUB BLACKJACK: BJ = 1 IF BJ = 0 THEN GOSUB HITSTAYFOLD BJ = 0: TEMPP = 0: TEMPC = 0 C = 1: PC = 1 FOR x = 1 TO 11: P1C(x) = 0: CPUC(x) = 0: NEXT x LOOP UNTIL (CURRENT > 45 OR CASH = 0) IF CASH = 0 THEN END GOTO 11 END SHUFFLE: FOR x = 1 TO 52: CARD(x) = x: NEXT x LOCATE 27, 20: PRINT "SHUFFLING "; 'PlayWav "c:\QBASIC\SHUFFLE.wav" FOR TIMES = 1 TO 3 FOR x = 1 TO 52 N = INT(RND * 52) + 1 IF x / 3 = INT(x / 3) THEN LOCATE 27, (x / 3) + 29: PRINT "."; FOR Y = 1 TO 52 IF CARD(Y) = N THEN CARD(Y) = CARD(x): Y = 52 NEXT Y CARD(x) = N NEXT x LOCATE 27, 29: PRINT " " NEXT TIMES GOSUB BURNCARD RETURN PRESSANYKEY: DO IN$ = INKEY$ GOSUB mousey LOOP UNTIL (IN$ <> "" OR LB% = -1) IF LB% = -1 THEN IN$ = " " MOUSEHIDE RETURN SETUP: LINE (1, 1)-(167, 225), 2, BF LOCATE 4, 1: PRINT " " LOCATE 12, 1: PRINT " " LOCATE 4, 1: PRINT "CASH " LOCATE 12, 1: PRINT "BET " CASH$ = MID$(STR$(CASH), 1) BET$ = STR$(BET) MOUSEHIDE x = -3: Y = 54: GOSUB DOLLAR FOR x = 1 TO LEN(CASH$) IF MID$(CASH$, x, 1) = "0" THEN CALL ZERO(12 + (15 * x) - 35, 57, 6): CALL ZERO(13 + (15 * x) - 35, 58, 14) IF MID$(CASH$, x, 1) = "1" THEN CALL ONE(2 + (15 * x) - 35, 55, 6): CALL ONE(3 + (15 * x) - 35, 56, 14) IF MID$(CASH$, x, 1) = "2" THEN CALL TWO(12 + (x * 15) - 35, 56, 6): CALL TWO(13 + (x * 15) - 35, 57, 14) IF MID$(CASH$, x, 1) = "3" THEN CALL THREE(12 + (x * 15) - 35, 61, 6): CALL THREE(13 + (x * 15) - 35, 62, 14) IF MID$(CASH$, x, 1) = "4" THEN CALL FOUR(11 + (x * 15) - 35, 55, 6): CALL FOUR(12 + (x * 15) - 35, 56, 14) IF MID$(CASH$, x, 1) = "5" THEN CALL FIVE(7 + (x * 15) - 35, 69, 6): CALL FIVE(8 + (x * 15) - 35, 70, 14) IF MID$(CASH$, x, 1) = "6" THEN CALL SIX(11 + (x * 15) - 35, 55, 6): CALL SIX(12 + (x * 15) - 35, 56, 14) IF MID$(CASH$, x, 1) = "7" THEN CALL SEVEN(12 + (x * 15) - 35, 55, 6): CALL SEVEN(13 + (x * 15) - 35, 56, 14) IF MID$(CASH$, x, 1) = "8" THEN CALL EIGHT(12 + (x * 15) - 35, 55, 6): CALL EIGHT(13 + (x * 15) - 35, 56, 14) IF MID$(CASH$, x, 1) = "9" THEN CALL NINE(12 + (x * 15) - 35, 57, 6): CALL NINE(13 + (x * 15) - 35, 58, 14) NEXT x x = LEN(CASH$) + 1 CIRCLE ((LEN(CASH$) * 15) - 4, 73), 2, 0 PAINT ((LEN(CASH$) * 15) - 4, 73), 0, 0 CALL ZERO(17 + (x * 15) - 35, 57, 6): CALL ZERO(18 + (x * 15) - 35, 58, 14) CALL ZERO((x * 15) - 3, 57, 6): CALL ZERO((x * 15) - 2, 58, 14) IF x > 4 THEN CIRCLE (((LEN(CASH$) - 3) * 15) - 6, 74), 1, 0 CIRCLE (((LEN(CASH$) - 3) * 15) - 6, 76), 2, 0, 4.8, .3, .8 PAINT (((LEN(CASH$) - 3) * 15) - 6, 73), 0, 0 END IF x = -3: Y = 187: GOSUB DOLLAR FOR x = 1 TO LEN(BET$) IF MID$(BET$, x, 1) = "0" THEN CALL ZERO(14 + (15 * x) - 35, 191, 6): CALL ZERO(15 + (15 * x) - 35, 192, 14) IF MID$(BET$, x, 1) = "1" THEN CALL ONE(4 + (15 * x) - 35, 189, 6): CALL ONE(5 + (15 * x) - 35, 190, 14) IF MID$(BET$, x, 1) = "2" THEN CALL TWO(14 + (x * 15) - 35, 190, 6): CALL TWO(15 + (x * 15) - 35, 191, 14) IF MID$(BET$, x, 1) = "3" THEN CALL THREE(14 + (x * 15) - 35, 195, 6): CALL THREE(15 + (x * 15) - 35, 196, 14) IF MID$(BET$, x, 1) = "4" THEN CALL FOUR(13 + (x * 15) - 35, 189, 6): CALL FOUR(14 + (x * 15) - 35, 190, 14) IF MID$(BET$, x, 1) = "5" THEN CALL FIVE(9 + (x * 15) - 35, 203, 6): CALL FIVE(10 + (x * 15) - 35, 204, 14) IF MID$(BET$, x, 1) = "6" THEN CALL SIX(13 + (x * 15) - 35, 189, 6): CALL SIX(14 + (x * 15) - 35, 190, 14) IF MID$(BET$, x, 1) = "7" THEN CALL SEVEN(14 + (x * 15) - 35, 189, 6): CALL SEVEN(15 + (x * 15) - 35, 190, 14) IF MID$(BET$, x, 1) = "8" THEN CALL EIGHT(14 + (x * 15) - 35, 189, 6): CALL EIGHT(15 + (x * 15) - 35, 190, 14) IF MID$(BET$, x, 1) = "9" THEN CALL NINE(14 + (x * 15) - 35, 191, 6): CALL NINE(15 + (x * 15) - 35, 192, 14) NEXT x x = LEN(BET$) + 1 CIRCLE ((LEN(BET$) * 15) - 2, 207), 2, 0 PAINT ((LEN(BET$) * 15) - 2, 207), 0, 0 CALL ZERO(17 + (x * 15) - 33, 191, 6): CALL ZERO(18 + (x * 15) - 33, 192, 14) CALL ZERO(32 + (x * 15) - 33, 191, 6): CALL ZERO(33 + (x * 15) - 33, 192, 14) IF x > 5 THEN CIRCLE (((LEN(BET$) - 3) * 15) - 4, 208), 1, 0 CIRCLE (((LEN(BET$) - 3) * 15) - 4, 210), 2, 0, 4.8, .3, .8 PAINT (((LEN(BET$) - 3) * 15) - 4, 208), 0, 0 END IF MOUSESHOW RETURN PLACEBET: G = 0 DO LOCATE 24, 30: PRINT "PLACE YOUR BET" FOR tm = 1 TO 10000: NEXT tm GOSUB MOUSEBET LINE (150, 350)-(400, 385), 2, BF IF BT$ = "" THEN R = 1 IF R <> 1 THEN BET = VAL(BT$) IF BET <= CASH AND BET <> 0 AND INT(BET) = BET THEN G = 1 LOOP UNTIL G = 1 R = 0 FOR tm = 1 TO 10000: NEXT tm GOSUB SETUP RETURN PLAYSCREEN: LINE (1, 37)-(599, 499), 2, BF PAINT (1, 1), 2, 15 RETURN HITSTAYFOLD: GOSUB HSF COLOR 2 LOCATE 27, 21: PRINT "(H)IT" LOCATE 27, 35: PRINT "(S)TAY" LOCATE 27, 50: PRINT "(F)OLD" DO GOSUB PRESSANYKEY GOSUB mousey IF IN$ = "H" OR IN$ = "h" OR (x% > 143 AND x% < 215 AND Y% > 409 AND Y% < 436 AND LB% = -1) THEN MOUSEHIDE IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 GOSUB ADDPLAYERCARD PC = PC + 1 CURRENT = CURRENT + 1 TEMPP = TEMPP + P1C(PC) IF TEMPP > 21 THEN IN$ = "L" FOR tm = 1 TO 10000: NEXT tm END IF GOSUB mousey IF IN$ = "S" OR IN$ = "s" OR (x% > 259 AND x% < 331 AND Y% > 409 AND Y% < 436 AND LB% = -1) THEN GOSUB COMPHAND IF IN$ = "F" OR IN$ = "f" OR (x% > 380 AND x% < 452 AND Y% > 409 AND Y% < 436 AND LB% = -1) THEN GOSUB LOSTHAND IF IN$ = "Q" OR IN$ = "q" THEN GOSUB SUREYN LOOP UNTIL (IN$ = "L" OR IN$ = "W" OR IN$ = "S" OR IN$ = "s" OR IN$ = "F" OR IN$ = "f" OR IN$ = "Q" OR IN$ = "q") IF IN$ = "F" THEN RETURN TEMPP = 0: TEMPC = 0 FOR x = 1 TO 11: TEMPP = TEMPP + P1C(x): TEMPC = TEMPC + CPUC(x): NEXT x FOR LP = 1 TO 11 IF P1C(LP) = 1 AND TEMPP < 12 THEN TEMPP = TEMPP + 10 IF CPUC(LP) = 1 AND TEMPC < 12 THEN TEMPC = TEMPC + 10 NEXT LP IF TEMPP = TEMPC THEN GOSUB PUSH IF (TEMPC > TEMPP AND TEMPC < 22) OR TEMPP > 21 THEN GOSUB LOSTHAND IF TEMPC > 21 OR (TEMPC < TEMPP AND TEMPP < 22) THEN GOSUB WINHAND RETURN HSF: REM HIT LINE (144, 410)-(214, 435), 8, BF LINE (151, 417)-(207, 428), 0, BF REM STAY LINE (260, 410)-(330, 435), 8, BF LINE (267, 417)-(323, 428), 0, BF REM FOLD LINE (381, 410)-(451, 435), 8, BF LINE (388, 417)-(444, 428), 0, BF RETURN CLEARPANEL: LINE (71, 398)-(512, 470), 2, BF COLOR 12 RETURN COMPHAND: MOUSEHIDE GOSUB CLEARPANEL FOR tm = 1 TO 10000: NEXT tm TEMPP = 0 CALL DRAWCARD(210, 220) CALL CARDSUIT(C2S, 210, 220) CALL NUMBER(C2S, 210, 220) FOR tm = 1 TO 10000: NEXT tm FOR x = 1 TO 11: TEMPP = TEMPP + P1C(x): NEXT x FOR LP = 1 TO 11 IF P1C(LP) = 1 AND TEMPP < 12 THEN TEMPP = TEMPP + 10 IF CPUC(LP) = 1 AND TEMPC < 12 THEN TEMPC = TEMPC + 10 NEXT LP DO TEMPC = 0 FOR x = 1 TO 11 TEMPC = TEMPC + CPUC(x) NEXT x FOR LP = 1 TO 11 IF CPUC(LP) = 1 AND TEMPC < 12 THEN TEMPC = TEMPC + 10 NEXT LP IF TEMPC > TEMPP THEN DUN = 1 IF TEMPC = TEMPP THEN DUN = 1 IF TEMPC >= 21 THEN DUN = 1 IF TEMPP > 22 THEN DUN = 1 IF DUN = 0 THEN IF CARD(CURRENT) = 0 AND CURRENT < 52 THEN CURRENT = CURRENT + 1 IF CARD(CURRENT) = 0 AND CURRENT = 52 THEN GOSUB PUSH: GOSUB SHUFFLE: CURRENT = 1 GOSUB ADDCPUCARD C = C + 1 CURRENT = CURRENT + 1 FOR tm = 1 TO 10000: NEXT tm END IF LOOP UNTIL (C = 11 OR DUN = 1) DUN = 0 IN$ = "S" FOR tm = 1 TO 10000: NEXT tm RETURN LOSTHAND: MOUSEHIDE FOR tm = 1 TO 10000: NEXT tm GOSUB CLEARPANEL LOCATE 27, 20: PRINT "YOU LOST...PRESS ANY KEY TO CONTINUE" CASH = CASH - BET GOSUB SETUP DO GOSUB PRESSANYKEY LOOP UNTIL IN$ <> "" IN$ = "F" FOR tm = 1 TO 10000: NEXT tm RETURN WINHAND: FOR tm = 1 TO 10000: NEXT tm GOSUB CLEARPANEL LOCATE 27, 20: PRINT "YOU WON! PRESS ANY KEY TO CONTINUE" CASH = CASH + BET GOSUB SETUP DO GOSUB PRESSANYKEY LOOP UNTIL IN$ <> "" IN$ = "W" FOR tm = 1 TO 10000: NEXT tm RETURN PUSH: GOSUB CLEARPANEL LOCATE 27, 20: PRINT "PUSH.... PRESS ANY KEY TO CONTINUE" FOR tm = 1 TO 10000: NEXT tm GOSUB SETUP DO GOSUB PRESSANYKEY LOOP UNTIL IN$ <> "" IN$ = "W" FOR tm = 1 TO 10000: NEXT tm RETURN SUREYN: LOCATE 27, 50: PRINT "ARE YOU SURE(Y/N)?" GOSUB PRESSANYKEY IF IN$ = "Y" OR IN$ = "y" THEN CLS : PRINT "BYE!": END IF IN$ = "N" OR IN$ = "n" THEN LOCATE 27, 50: PRINT " ": RETURN ADDPLAYERCARD: IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 CALL DRAWCARD(130 + (PC * 40), 40) CALL CARDSUIT(CARD(CURRENT), 130 + (PC * 40), 40) CALL NUMBER(CARD(CURRENT), 130 + (PC * 40), 40) IF CARD(CURRENT) < 14 THEN P1C(PC) = CARD(CURRENT) IF CARD(CURRENT) > 13 AND CARD(CURRENT) < 27 THEN P1C(PC) = CARD(CURRENT) - 13 IF CARD(CURRENT) > 26 AND CARD(CURRENT) < 40 THEN P1C(PC) = CARD(CURRENT) - 26 IF CARD(CURRENT) > 39 THEN P1C(PC) = CARD(CURRENT) - 39 IF P1C(PC) > 10 THEN P1C(PC) = 10 TEMPP = TEMPP + P1C(PC) FOR tm = 1 TO 30000: NEXT tm RETURN ADDCPUCARD: IF CARD(CURRENT) = 0 THEN CURRENT = CURRENT + 1 CALL DRAWCARD(130 + (C * 40), 220) CALL CARDSUIT(CARD(CURRENT), 130 + (C * 40), 220) CALL NUMBER(CARD(CURRENT), 130 + (C * 40), 220) IF CARD(CURRENT) < 14 THEN CPUC(C) = CARD(CURRENT) IF CARD(CURRENT) > 13 AND CARD(CURRENT) < 27 THEN CPUC(C) = CARD(CURRENT) - 13 IF CARD(CURRENT) > 26 AND CARD(CURRENT) < 40 THEN CPUC(C) = CARD(CURRENT) - 26 IF CARD(CURRENT) > 39 THEN CPUC(C) = CARD(CURRENT) - 39 IF CPUC(C) > 10 THEN CPUC(C) = 10 TEMPC = TEMPC + CPUC(C) RETURN BLACKJACK: LOCATE 27, 20: PRINT "BLACKJACK PAYS DOUBLE! PRESS ANY KEY" FOR tm = 1 TO 10000: NEXT tm GOSUB PRESSANYKEY CASH = CASH + (BET * 2) GOSUB SETUP RETURN BURNCARD: IX = 1 DO OX = CARD(IX) CALL DRAWCARD(250, 150) CALL CARDSUIT(OX, 250, 150) CALL NUMBER(OX, 250, 150) LOCATE 27, 20: PRINT " BURN THIS CARD (Y/N) " FOR tm = 1 TO 10000: NEXT tm DO GOSUB PRESSANYKEY LOOP UNTIL (IN$ = "Y" OR IN$ = "y" OR IN$ = "n" OR IN$ = "N") IF (IN$ = "Y" OR IN$ = "y") THEN CARD(IX) = 0: IX = 52 IX = IX + 1: IF IX = 52 THEN IX = 1 LOOP UNTIL IX = 53 RETURN mousey: MOUSESHOW '<--calls sub to show the mouse MouseStatus LB%, RB%, x%, Y% '<--calls sub MouseStatus to MOUSESHOW RETURN DOLLAR: LINE (x + 6, Y + 5)-(x + 6, Y + 26), 14, BF LINE (x + 12, Y + 5)-(x + 12, Y + 26), 14, BF LINE (x + 7, Y + 5)-(x + 7, Y + 26), 6, BF LINE (x + 13, Y + 5)-(x + 13, Y + 26), 6, BF CIRCLE (x + 9, Y + 12), 5, 8, .5, 3.4 CIRCLE (x + 9, Y + 13), 5, 14, .5, 3.4 CIRCLE (x + 9, Y + 19), 5, 8, 3.7, .6 CIRCLE (x + 9, Y + 18), 5, 14, 3.7, .6 LINE (x + 14, Y + 17)-(x + 7, Y + 15), 8 LINE (x + 14, Y + 16)-(x + 7, Y + 14), 14 RETURN MOUSEBET: REM 5 LINE (73, 409)-(145, 436), 8, BF LINE (80, 416)-(138, 429), 1, BF CALL FIVE(96, 422, 4) REM 10 LINE (189, 409)-(261, 436), 8, BF LINE (196, 416)-(254, 429), 1, BF CALL ONE(198, 408, 4) CALL ZERO(222, 410, 4) REM 100 LINE (310, 409)-(382, 436), 8, BF LINE (317, 416)-(375, 429), 1, BF CALL ONE(311, 408, 4) CALL ZERO(335, 410, 4) CALL ZERO(349, 410, 4) REM 1000 LINE (426, 409)-(498, 436), 8, BF LINE (433, 416)-(491, 429), 1, BF CALL ONE(419, 408, 4) CALL ZERO(443, 410, 4) CALL ZERO(457, 410, 4) CALL ZERO(471, 410, 4) REM 5000 LINE (129, 442)-(201, 469), 8, BF LINE (136, 449)-(194, 462), 1, BF CALL FIVE(130, 455, 4) CALL ZERO(149, 443, 4) CALL ZERO(163, 443, 4) CALL ZERO(177, 443, 4) REM CLEAR LINE (249, 442)-(321, 469), 8, BF LINE (256, 449)-(314, 462), 1, BF CALL ZERO(276, 443, 4) REM ALL LINE (369, 442)-(441, 469), 8, BF LINE (376, 449)-(434, 462), 1, BF LINE (381, 460)-(388, 451), 4 LINE (382, 460)-(389, 451), 4 LINE (388, 451)-(395, 460), 4 LINE (389, 451)-(396, 460), 4 LINE (384, 457)-(392, 457), 4 LINE (385, 456)-(392, 456), 4 LINE (402, 451)-(402, 460), 4 LINE (403, 451)-(403, 460), 4 LINE (402, 460)-(411, 460), 4 LINE (402, 459)-(411, 459), 4 LINE (418, 451)-(418, 460), 4 LINE (419, 451)-(419, 460), 4 LINE (418, 460)-(427, 460), 4 LINE (418, 459)-(427, 459), 4 DN = 0 IF BET > CASH THEN BET = CASH: GOSUB SETUP DO FOR tm = 1 TO 2500: NEXT tm GOSUB mousey IF (LB% = -1 AND x% > 72 AND x% < 146 AND Y% > 408 AND Y% < 437 AND (BET + 5) <= CASH) THEN BET = BET + 5 GOSUB SETUP END IF IF (LB% = -1 AND x% > 188 AND x% < 262 AND Y% > 408 AND Y% < 437 AND (BET + 10) <= CASH) THEN BET = BET + 10 GOSUB SETUP END IF IF (LB% = -1 AND x% > 309 AND x% < 383 AND Y% > 408 AND Y% < 437 AND (BET + 100) <= CASH) THEN BET = BET + 100 GOSUB SETUP END IF IF (LB% = -1 AND x% > 425 AND x% < 499 AND Y% > 408 AND Y% < 437 AND (BET + 1000) <= CASH) THEN BET = BET + 1000 GOSUB SETUP END IF IF (LB% = -1 AND x% > 128 AND x% < 202 AND Y% > 441 AND Y% < 463 AND (BET + 5000) <= CASH) THEN BET = BET + 5000 GOSUB SETUP END IF IF (LB% = -1 AND x% > 248 AND x% < 322 AND Y% > 441 AND Y% < 470 AND BET > 0) THEN BET = 0 GOSUB SETUP END IF IF (LB% = -1 AND x% > 368 AND x% < 442 AND Y% > 441 AND Y% < 470 AND BET <> CASH) THEN BET = CASH GOSUB SETUP END IF IF (RB% = -1 AND BET > 0) THEN DN = 1 ELSE RB% = 0 FOR tm = 1 TO 2500: NEXT tm LOOP UNTIL (DN = 1 AND BET > 0) DN = 0 MOUSEHIDE GOSUB CLEARPANEL RETURN DEFINT A-Z ' DEFSNG A-Z SUB BIGCLUB (x, Y) CIRCLE (x + 13, Y + 58), 6, 0, .4, 5.8, .9 CIRCLE (x + 22, Y + 50), 6, 0, , , 1 CIRCLE (x + 31, Y + 58), 6, 0, 3, 2.6, .9 LINE (x + 16, Y + 70)-(x + 29, Y + 71), 0, BF LINE (x + 28, Y + 70)-(x + 24, Y + 60), 0 LINE (x + 16, Y + 70)-(x + 20, Y + 60), 0 PAINT (x + 22, Y + 50), 0, 0 PAINT (x + 22, Y + 60), 0, 0 PAINT (x + 12, Y + 60), 0, 0 PAINT (x + 31, Y + 58), 0, 0 PSET (x + 16, Y + 56), 0 PSET (x + 18, Y + 56), 0 END SUB SUB BIGDIAMOND (x, Y) LINE (x + 10, Y + 56)-(x + 22, Y + 44), 4 LINE (x + 10, Y + 56)-(x + 22, Y + 68), 4 LINE (x + 22, Y + 44)-(x + 34, Y + 56), 4 LINE (x + 22, Y + 68)-(x + 34, Y + 56), 4 PAINT (x + 22, Y + 56), 4, 4 END SUB SUB BIGHEART (x, Y) CIRCLE (x + 16, Y + 52), 6, 4 CIRCLE (x + 28, Y + 52), 6, 4 LINE (x + 12, Y + 57)-(x + 20, Y + 68), 4 LINE (x + 32, Y + 56)-(x + 24, Y + 68), 4 LINE (x + 20, Y + 68)-(x + 22, Y + 72), 4 LINE (x + 24, Y + 68)-(x + 22, Y + 72), 4 PAINT (x + 16, Y + 52), 4, 4 PAINT (x + 28, Y + 52), 4, 4 PAINT (x + 22, Y + 56), 4, 4 END SUB SUB BIGSPADE (x, Y) CIRCLE (x + 16, Y + 62), 6, 0 CIRCLE (x + 28, Y + 62), 6, 0 LINE (x + 10, Y + 60)-(x + 19, Y + 48), 0 LINE (x + 33, Y + 59)-(x + 24, Y + 48), 0 LINE (x + 19, Y + 48)-(x + 22, Y + 43), 0 LINE (x + 24, Y + 48)-(x + 22, Y + 44), 0 PAINT (x + 16, Y + 62), 0, 0 PAINT (x + 28, Y + 62), 0, 0 PAINT (x + 22, Y + 48), 0, 0 LINE (x + 22, Y + 67)-(x + 16, Y + 73), 0 LINE (x + 22, Y + 67)-(x + 28, Y + 73), 0 LINE (x + 16, Y + 73)-(x + 28, Y + 73), 0 LINE (x + 21, Y + 67)-(x + 22, Y + 64), 0, BF LINE (x + 23, Y + 67)-(x + 22, Y + 64), 0 PAINT (x + 22, Y + 70), 0, 0 END SUB SUB BIGUSDCLUB (x, Y) CIRCLE (x + 15, Y + 57), 6, 0, .8, 5.6, .9 CIRCLE (x + 22, Y + 66), 6, 0, 1.7, 1.1, .8 CIRCLE (x + 29, Y + 57), 6, 0, 3.7, 2.2, .9 LINE (x + 16, Y + 45)-(x + 28, Y + 45), 0, BF LINE (x + 16, Y + 46)-(x + 20, Y + 53), 0 LINE (x + 23, Y + 53)-(x + 28, Y + 46), 0 PSET (x + 28, Y + 47), 0: PSET (x + 26, Y + 49), 0: PSET (x + 24, Y + 51), 0 REM PAINT (X + 14, Y + 57), 0, 0 PAINT (x + 22, Y + 67), 0, 0 REM PAINT (X + 22, Y + 51), 0, 0 PSET (x + 26, Y + 51), 15 END SUB SUB BIGUSDHEART (x, Y) CIRCLE (x + 16, Y + 65), 6, 4 CIRCLE (x + 28, Y + 65), 6, 4 LINE (x + 12, Y + 60)-(x + 20, Y + 49), 4 LINE (x + 32, Y + 61)-(x + 24, Y + 49), 4 LINE (x + 20, Y + 49)-(x + 22, Y + 45), 4 LINE (x + 24, Y + 49)-(x + 22, Y + 45), 4 REM PSET (X + 22, Y + 47), 4 REM PSET (X + 24, Y + 47), 4 REM PSET (X + 22, Y + 45), 4 PAINT (x + 16, Y + 65), 4, 4 PAINT (x + 28, Y + 65), 4, 4 PAINT (x + 22, Y + 51), 4, 4 END SUB SUB BIGUSDSPADE (x, Y) CIRCLE (x + 16, Y + 55), 6, 0 CIRCLE (x + 28, Y + 55), 6, 0 LINE (x + 12, Y + 60)-(x + 20, Y + 71), 0 LINE (x + 31, Y + 60)-(x + 23, Y + 71), 0 LINE (x + 20, Y + 71)-(x + 22, Y + 74), 0 LINE (x + 24, Y + 71)-(x + 22, Y + 73), 0 PAINT (x + 16, Y + 55), 0, 0 PAINT (x + 28, Y + 55), 0, 0 PAINT (x + 22, Y + 59), 0, 0 LINE (x + 22, Y + 50)-(x + 16, Y + 44), 0 LINE (x + 22, Y + 50)-(x + 28, Y + 44), 0 LINE (x + 16, Y + 44)-(x + 28, Y + 44), 0 PAINT (x + 22, Y + 46), 0, 0 LINE (x + 21, Y + 50)-(x + 22, Y + 52), 0, BF LINE (x + 23, Y + 50)-(x + 22, Y + 52), 0 END SUB SUB BLANKCARD (x, Y) LINE (x, Y)-(x + 160, Y + 160), 15, BF FOR EX = 1 TO 5 LINE (x - 1, Y + EX)-(x + 1 + EX, Y - 1), 0 LINE (x + 160 - EX, Y - 1)-(x + 161, Y + EX), 2 LINE (x - 1, Y + 160 - EX)-(x + 1 + EX, Y + 161), 0 LINE (x + 160 - EX, Y + 161)-(x + 161, Y + 160 - EX), 2 NEXT EX LINE (x - 1, Y + 6)-(x - 1, Y + 154), 0 PSET (x, Y + 5), 0 PSET (x + 5, Y), 0 PSET (x + 155, Y), 0 PSET (x + 160, Y + 5), 0 PSET (x, Y + 155), 0 PSET (x + 5, Y + 160), 0 PSET (x + 160, Y + 155), 0 PSET (x + 155, Y + 160), 0 LINE (x + 7, Y + 7)-(x + 153, Y + 153), 0, BF LINE (x + 35, Y + 28)-(x + 125, Y + 132), 6, B LINE (x + 36, Y + 29)-(x + 124, Y + 131), 14, B LINE (x + 37, Y + 30)-(x + 123, Y + 130), 6, B REM TOP CIRCLE CIRCLE (x + 79, Y + 48), 10, 6 CIRCLE (x + 79, Y + 48), 9, 14 CIRCLE (x + 79, Y + 48), 8, 6 LINE (x + 70, Y + 47)-(x + 88, Y + 47), 6 LINE (x + 70, Y + 48)-(x + 88, Y + 48), 14 LINE (x + 70, Y + 49)-(x + 88, Y + 49), 6 LINE (x + 79, Y + 40)-(x + 79, Y + 56), 14 LINE (x + 78, Y + 40)-(x + 78, Y + 56), 6 LINE (x + 80, Y + 40)-(x + 80, Y + 56), 6 REM BOTTOM CIRCLE CIRCLE (x + 79, Y + 110), 10, 6 CIRCLE (x + 79, Y + 110), 9, 14 CIRCLE (x + 79, Y + 110), 8, 6 LINE (x + 70, Y + 109)-(x + 88, Y + 109), 6 LINE (x + 70, Y + 110)-(x + 88, Y + 110), 14 LINE (x + 70, Y + 111)-(x + 88, Y + 111), 6 LINE (x + 78, Y + 102)-(x + 78, Y + 118), 6 LINE (x + 79, Y + 102)-(x + 79, Y + 118), 14 LINE (x + 80, Y + 102)-(x + 80, Y + 118), 6 END SUB SUB CARDSUIT (CARD, x, Y) ' IF CARD < 14 THEN CALL HEART(x, Y) IF (CARD = 2 OR CARD = 3) THEN CALL BIGHEART(x + 58, Y - 30) CALL BIGUSDHEART(x + 58, Y + 75) END IF IF (CARD = 3 OR CARD = 9) THEN CALL BIGUSDHEART(x + 58, Y + 25) IF (CARD = 1 OR CARD = 5) THEN CALL BIGHEART(x + 58, Y + 25) IF (CARD > 3 AND CARD < 11) THEN CALL BIGHEART(x + 12, Y - 30) CALL BIGHEART(x + 104, Y - 30) CALL BIGUSDHEART(x + 12, Y + 75) CALL BIGUSDHEART(x + 104, Y + 75) END IF IF (CARD > 10 AND CARD < 14) THEN CALL BIGHEART(x + 12, Y - 30) CALL BIGUSDHEART(x + 104, Y + 75) END IF IF CARD = 6 THEN CALL BIGHEART(x + 12, Y + 25) CALL BIGHEART(x + 104, Y + 25) END IF IF (CARD = 7 OR CARD = 8) THEN CALL BIGUSDHEART(x + 12, Y + 25) CALL BIGUSDHEART(x + 104, Y + 25) END IF IF (CARD = 7 OR CARD = 8 OR CARD = 10) THEN CALL BIGUSDHEART(x + 58, Y + 50) IF (CARD = 8 OR CARD = 10) THEN CALL BIGHEART(x + 58, Y - 3) IF (CARD = 9 OR CARD = 10) THEN CALL BIGHEART(x + 12, Y + 5) CALL BIGHEART(x + 104, Y + 5) CALL BIGUSDHEART(x + 12, Y + 40) CALL BIGUSDHEART(x + 104, Y + 40) END IF END IF IF CARD > 13 AND CARD < 27 THEN CALL SPADE(x, Y) IF (CARD = 15 OR CARD = 16) THEN CALL BIGSPADE(x + 58, Y - 30) CALL BIGUSDSPADE(x + 58, Y + 75) END IF IF (CARD = 16 OR CARD = 22) THEN CALL BIGUSDSPADE(x + 58, Y + 25) IF (CARD = 14 OR CARD = 18) THEN CALL BIGSPADE(x + 58, Y + 25) IF (CARD > 16 AND CARD < 24) THEN CALL BIGSPADE(x + 12, Y - 30) CALL BIGSPADE(x + 104, Y - 30) CALL BIGUSDSPADE(x + 12, Y + 75) CALL BIGUSDSPADE(x + 104, Y + 75) END IF IF (CARD > 23 AND CARD < 27) THEN CALL BIGSPADE(x + 12, Y - 30) CALL BIGUSDSPADE(x + 104, Y + 75) END IF IF CARD = 19 THEN CALL BIGSPADE(x + 12, Y + 25) CALL BIGSPADE(x + 104, Y + 25) END IF IF (CARD = 20 OR CARD = 21) THEN CALL BIGUSDSPADE(x + 12, Y + 25) CALL BIGUSDSPADE(x + 104, Y + 25) END IF IF (CARD = 20 OR CARD = 21 OR CARD = 23) THEN CALL BIGUSDSPADE(x + 58, Y + 50) IF (CARD = 21 OR CARD = 23) THEN CALL BIGSPADE(x + 58, Y - 3) IF (CARD = 22 OR CARD = 23) THEN CALL BIGSPADE(x + 12, Y + 5) CALL BIGSPADE(x + 104, Y + 5) CALL BIGUSDSPADE(x + 12, Y + 40) CALL BIGUSDSPADE(x + 104, Y + 40) END IF END IF IF CARD > 26 AND CARD < 40 THEN CALL CLUB(x, Y) IF (CARD = 28 OR CARD = 29) THEN CALL BIGCLUB(x + 58, Y - 30) CALL BIGUSDCLUB(x + 58, Y + 75) END IF IF (CARD = 29 OR CARD = 35) THEN CALL BIGUSDCLUB(x + 58, Y + 25) IF (CARD = 27 OR CARD = 31) THEN CALL BIGCLUB(x + 58, Y + 25) IF (CARD > 29 AND CARD < 37) THEN CALL BIGCLUB(x + 12, Y - 30) CALL BIGCLUB(x + 104, Y - 30) CALL BIGUSDCLUB(x + 12, Y + 75) CALL BIGUSDCLUB(x + 104, Y + 75) END IF IF (CARD > 36 AND CARD < 40) THEN CALL BIGCLUB(x + 12, Y - 30) CALL BIGUSDCLUB(x + 104, Y + 75) END IF IF CARD = 32 THEN CALL BIGCLUB(x + 12, Y + 25) CALL BIGCLUB(x + 104, Y + 25) END IF IF (CARD = 33 OR CARD = 34) THEN CALL BIGUSDCLUB(x + 12, Y + 25) CALL BIGUSDCLUB(x + 104, Y + 25) END IF IF (CARD = 33 OR CARD = 34 OR CARD = 36) THEN CALL BIGUSDCLUB(x + 58, Y + 50) IF (CARD = 34 OR CARD = 36) THEN CALL BIGCLUB(x + 58, Y - 3) IF (CARD = 35 OR CARD = 36) THEN CALL BIGCLUB(x + 12, Y + 5) CALL BIGCLUB(x + 104, Y + 5) CALL BIGUSDCLUB(x + 12, Y + 40) CALL BIGUSDCLUB(x + 104, Y + 40) END IF END IF IF CARD > 39 THEN CALL DIAMOND(x, Y) IF (CARD = 41 OR CARD = 42) THEN CALL BIGDIAMOND(x + 58, Y - 30) CALL BIGDIAMOND(x + 58, Y + 75) END IF IF (CARD = 42 OR CARD = 48) THEN CALL BIGDIAMOND(x + 58, Y + 25) IF (CARD = 40 OR CARD = 44) THEN CALL BIGDIAMOND(x + 58, Y + 25) IF (CARD > 42 AND CARD < 50) THEN CALL BIGDIAMOND(x + 12, Y - 30) CALL BIGDIAMOND(x + 104, Y - 30) CALL BIGDIAMOND(x + 12, Y + 75) CALL BIGDIAMOND(x + 104, Y + 75) END IF IF CARD > 49 THEN CALL BIGDIAMOND(x + 12, Y - 30) CALL BIGDIAMOND(x + 104, Y + 75) END IF IF CARD = 45 THEN CALL BIGDIAMOND(x + 12, Y + 25) CALL BIGDIAMOND(x + 104, Y + 25) END IF IF (CARD = 46 OR CARD = 47) THEN CALL BIGDIAMOND(x + 12, Y + 25) CALL BIGDIAMOND(x + 104, Y + 25) END IF IF (CARD = 46 OR CARD = 47 OR CARD = 49) THEN CALL BIGDIAMOND(x + 58, Y + 50) IF (CARD = 47 OR CARD = 49) THEN CALL BIGDIAMOND(x + 58, Y - 3) IF (CARD = 48 OR CARD = 49) THEN CALL BIGDIAMOND(x + 12, Y + 5) CALL BIGDIAMOND(x + 104, Y + 5) CALL BIGDIAMOND(x + 12, Y + 40) CALL BIGDIAMOND(x + 104, Y + 40) END IF END IF END SUB SUB CLUB (x, Y) REM TOP LEFT CIRCLE (x + 6, Y + 30), 3, 0, .4, 5.8, 1.1 CIRCLE (x + 11, Y + 25), 3, 0, , , 1.1 CIRCLE (x + 16, Y + 30), 3, 0, 3, 2.6, .9 LINE (x + 7, Y + 36)-(x + 15, Y + 37), 0, BF LINE (x + 14, Y + 35)-(x + 12, Y + 31), 0 LINE (x + 8, Y + 35)-(x + 10, Y + 30), 0 PAINT (x + 11, Y + 25), 0, 0 PAINT (x + 11, Y + 30), 0, 0 PAINT (x + 6, Y + 30), 0, 0 PSET (x + 8, Y + 28), 0 PSET (x + 9, Y + 28), 0 REM BOTTOM RIGHT CIRCLE (x + 145, Y + 130), 3, 0, .9, 5.6, 1.1 CIRCLE (x + 149, Y + 136), 3, 0, 1.7, 1.1, 1.1 CIRCLE (x + 153, Y + 130), 3, 0, 3.8, 1.9, .9 LINE (x + 145, Y + 124)-(x + 152, Y + 123), 0, BF PSET (x + 153, Y + 123), 0 LINE (x + 146, Y + 125)-(x + 149, Y + 128), 0 PSET (x + 152, Y + 125), 0: PSET (x + 151, Y + 126), 0: PSET (x + 150, Y + 127), 0 PAINT (x + 145, Y + 130), 0, 0 PAINT (x + 149, Y + 135), 0, 0 PAINT (x + 149, Y + 127), 0, 0 PSET (x + 151, Y + 127), 15 END SUB DEFINT A-Z '------------------------------------------------------------------------------ SUB delay (tdelay!) time1! = TIMER DO LOOP WHILE (TIMER - time1! < tdelay!) OR (time1! > TIMER) END SUB DEFSNG A-Z SUB DIAMOND (x, Y) ' TOP LEFT LINE (x + 5, Y + 28)-(x + 11, Y + 22), 4 LINE (x + 5, Y + 28)-(x + 11, Y + 34), 4 LINE (x + 11, Y + 22)-(x + 17, Y + 28), 4 LINE (x + 11, Y + 34)-(x + 17, Y + 28), 4 PAINT (x + 11, Y + 28), 4, 4 ' BOTTOM RIGHT LINE (x + 155, Y + 132)-(x + 149, Y + 126), 4 LINE (x + 149, Y + 126)-(x + 143, Y + 132), 4 LINE (x + 143, Y + 132)-(x + 149, Y + 138), 4 LINE (x + 149, Y + 138)-(x + 155, Y + 132), 4 PAINT (x + 149, Y + 132), 4, 4 END SUB SUB DRAW10 (x, Y, C) REM TOP LEFT LINE (x + 7, Y + 7)-(x + 8, Y + 19), C, BF CIRCLE (x + 14, Y + 13), 6, C, , , 1.8 CIRCLE (x + 15, Y + 13), 6, C, , , 1.8 REM BOTTOM RIGHT LINE (x + 153, Y + 140)-(x + 152, Y + 152), C, BF CIRCLE (x + 146, Y + 146), 6, C, , , 1.8 CIRCLE (x + 145, Y + 146), 6, C, , , 1.8 CIRCLE (x + 144, Y + 146), 6, C, , , 1.8 END SUB SUB DRAW2 (x, Y, C) REM TOP LEFT CIRCLE (x + 11, Y + 10), 5, C, 5.2, 3.3, .5 CIRCLE (x + 12, Y + 10), 5, C, 5.2, 3.3, .5 LINE (x + 12, Y + 14)-(x + 6, Y + 17), C LINE (x + 13, Y + 14)-(x + 7, Y + 17), C LINE (x + 7, Y + 18)-(x + 6, Y + 19), C, BF PSET (x + 6, Y + 20), C LINE (x + 7, Y + 19)-(x + 17, Y + 20), C, BF REM BOTTOM RIGHT CIRCLE (x + 148, Y + 150), 5, C, 2.9, .2, .5 CIRCLE (x + 149, Y + 150), 5, C, 2.9, .2, .5 LINE (x + 144, Y + 148)-(x + 153, Y + 143), C LINE (x + 145, Y + 148)-(x + 154, Y + 143), C LINE (x + 153, Y + 141)-(x + 154, Y + 142), C, BF LINE (x + 154, Y + 141)-(x + 143, Y + 142), C, BF END SUB SUB DRAW3 (x, Y, C) REM TOP LEFT LINE (x + 5, Y + 5)-(x + 18, Y + 6), C, BF LINE (x + 5, Y + 5)-(x + 6, Y + 8), C, BF LINE (x + 16, Y + 7)-(x + 7, Y + 12), C LINE (x + 17, Y + 7)-(x + 8, Y + 12), C CIRCLE (x + 11, Y + 15), 6, C, 3.3, 1.9, .7 CIRCLE (x + 12, Y + 15), 6, C, 3.3, 1.9, .7 REM BOTTOM RIGHT LINE (x + 141, Y + 154)-(x + 154, Y + 155), C, BF LINE (x + 153, Y + 154)-(x + 154, Y + 152), C, BF LINE (x + 143, Y + 153)-(x + 152, Y + 148), C LINE (x + 142, Y + 153)-(x + 151, Y + 148), C CIRCLE (x + 148, Y + 144), 6, C, .4, 5.1, .7 CIRCLE (x + 147, Y + 144), 6, C, .4, 5.1, .7 END SUB SUB DRAW4 (x, Y, C) REM TOP LEFT LINE (x + 9, Y + 19)-(x + 14, Y + 20), C, BF LINE (x + 11, Y + 18)-(x + 12, Y + 7), C, BF LINE (x + 11, Y + 7)-(x + 4, Y + 16), C LINE (x + 12, Y + 7)-(x + 5, Y + 16), C LINE (x + 6, Y + 15)-(x + 15, Y + 16), C, BF PSET (x + 4, Y + 15), 15 PSET (x + 4, Y + 16), 15 PSET (x + 9, Y + 8), 15 PSET (x + 10, Y + 8), 15 PSET (x + 11, Y + 7), 15 PSET (x + 8, Y + 13), 15 PSET (x + 6, Y + 13), C PSET (x + 7, Y + 14), 15 PSET (x + 6, Y + 14), C PSET (x + 5, Y + 14), C PSET (x + 4, Y + 15), C PSET (x + 4, Y + 16), C REM BOTTOM RIGHT LINE (x + 149, Y + 141)-(x + 144, Y + 142), C, BF LINE (x + 146, Y + 143)-(x + 147, Y + 154), C, BF LINE (x + 147, Y + 154)-(x + 155, Y + 146), C LINE (x + 148, Y + 154)-(x + 156, Y + 146), C LINE (x + 154, Y + 146)-(x + 142, Y + 145), C, BF PSET (x + 156, Y + 145), C PSET (x + 155, Y + 145), C END SUB SUB DRAW5 (x, Y, C) REM TOP LEFT LINE (x + 5, Y + 5)-(x + 17, Y + 6), C, BF LINE (x + 5, Y + 7)-(x + 6, Y + 11), C, BF CIRCLE (x + 11, Y + 14), 7, C, 3.6, 2.5, .7 CIRCLE (x + 11, Y + 15), 7, C, 3.6, 2.5, .7 REM BOTTOM RIGHT LINE (x + 141, Y + 154)-(x + 153, Y + 155), C, BF LINE (x + 153, Y + 153)-(x + 152, Y + 149), C, BF CIRCLE (x + 147, Y + 146), 7, C, .6, 5.6, .7 CIRCLE (x + 147, Y + 145), 7, C, .6, 5.6, .7 END SUB SUB DRAW6 (x, Y, C) REM TOP LEFT CIRCLE (x + 10, Y + 15), 5, C, , , .8 CIRCLE (x + 11, Y + 15), 5, C, , , .8 CIRCLE (x + 11, Y + 12), 6, C, .7, 3.7, .9 CIRCLE (x + 12, Y + 12), 6, C, .7, 3.4, .9 PSET (x + 15, Y + 9), C PSET (x + 16, Y + 8), C REM BOTTOM RIGHT CIRCLE (x + 148, Y + 145), 5, C, , , .8 CIRCLE (x + 149, Y + 145), 5, C, , , .8 CIRCLE (x + 147, Y + 148), 6, C, 3.8, 6.2, .9 CIRCLE (x + 148, Y + 148), 6, C, 3.8, .1, .9 END SUB SUB DRAW7 (x, Y, C) REM TOP LEFT LINE (x + 5, Y + 7)-(x + 6, Y + 10), C, BF LINE (x + 5, Y + 7)-(x + 16, Y + 8), C, BF LINE (x + 15, Y + 9)-(x + 16, Y + 10), C, BF REM CIRCLE (X + 24, Y + 16), 13, C, 2.4, 3.2, .5 CIRCLE (x + 21, Y + 18), 13, C, 2.1, 3.3, .6 CIRCLE (x + 22, Y + 18), 13, C, 2.1, 3.3, .6 REM BOTTOM LEFT CIRCLE (x + 143, Y + 138), 13, C, 4.8, 6!, 1.5 CIRCLE (x + 144, Y + 138), 13, C, 4.8, 6!, 1.5 LINE (x + 143, Y + 151)-(x + 144, Y + 154), C, BF LINE (x + 143, Y + 153)-(x + 154, Y + 154), C, BF LINE (x + 153, Y + 154)-(x + 154, Y + 151), C, BF END SUB SUB DRAW8 (x, Y, C) REM TOP LEFT CIRCLE (x + 10, Y + 10), 5, C, , , .52 CIRCLE (x + 11, Y + 10), 5, C, , , .52 CIRCLE (x + 10, Y + 17), 6, C, , , .55 CIRCLE (x + 11, Y + 17), 6, C, , , .55 REM BOTTOM RIGHT CIRCLE (x + 149, Y + 149), 5, C, , , .52 CIRCLE (x + 150, Y + 149), 5, C, , , .52 CIRCLE (x + 149, Y + 142), 6, C, , , .55 CIRCLE (x + 150, Y + 142), 6, C, , , .55 END SUB SUB DRAW9 (x, Y, C) REM TOP LEFT CIRCLE (x + 148, Y + 152), 5, C, , , .8 CIRCLE (x + 149, Y + 152), 5, C, , , .8 CIRCLE (x + 149, Y + 149), 6, C, .7, 3.7, .9 CIRCLE (x + 150, Y + 149), 6, C, .7, 3.4, .9 PSET (x + 153, Y + 146), C PSET (x + 154, Y + 145), C REM BOTTOM RIGHT CIRCLE (x + 10, Y + 10), 5, C, , , .8 CIRCLE (x + 11, Y + 10), 5, C, , , .8 CIRCLE (x + 9, Y + 13), 6, C, 3.8, 6.2, .9 CIRCLE (x + 10, Y + 13), 6, C, 3.8, .1, .9 END SUB SUB DRAWA (x, Y, C) REM TOP LEFT LINE (x + 5, Y + 18)-(x + 8, Y + 20), C, BF LINE (x + 13, Y + 18)-(x + 16, Y + 20), C, BF LINE (x + 7, Y + 17)-(x + 10, Y + 7), C LINE (x + 6, Y + 17)-(x + 9, Y + 7), C LINE (x + 11, Y + 7)-(x + 14, Y + 20), C LINE (x + 12, Y + 7)-(x + 15, Y + 20), C LINE (x + 7, Y + 15)-(x + 14, Y + 15), C PSET (x + 11, Y + 7), C PSET (x + 11, Y + 9), C PSET (x + 13, Y + 9), 15 REM BOTTOM RIGHT LINE (x + 143, Y + 141)-(x + 146, Y + 143), C, BF LINE (x + 150, Y + 141)-(x + 153, Y + 143), C, BF LINE (x + 144, Y + 143)-(x + 147, Y + 153), C LINE (x + 143, Y + 143)-(x + 146, Y + 153), C LINE (x + 151, Y + 143)-(x + 148, Y + 153), C LINE (x + 152, Y + 143)-(x + 149, Y + 153), C LINE (x + 148, Y + 145)-(x + 151, Y + 148), 15, BF LINE (x + 151, Y + 145)-(x + 152, Y + 147), C, BF LINE (x + 150, Y + 148)-(x + 151, Y + 150), C, BF LINE (x + 149, Y + 148)-(x + 149, Y + 150), 15 LINE (x + 147, Y + 153)-(x + 149, Y + 154), C, BF PSET (x + 146, Y + 153), 15 LINE (x + 145, Y + 147)-(x + 152, Y + 147), C PSET (x + 145, Y + 147), C PSET (x + 144, Y + 147), 15 PSET (x + 152, Y + 147), 15 PSET (x + 146, Y + 148), C PSET (x + 146, Y + 147), C END SUB SUB DRAWCARD (x, Y) LINE (x, Y)-(x + 160, Y + 160), 15, BF FOR EX = 1 TO 5 LINE (x - 1, Y + EX)-(x + 1 + EX, Y - 1), 0 LINE (x + 160 - EX, Y - 1)-(x + 161, Y + EX), 2 LINE (x - 1, Y + 160 - EX)-(x + 1 + EX, Y + 161), 0 LINE (x + 160 - EX, Y + 161)-(x + 161, Y + 160 - EX), 2 NEXT EX LINE (x - 1, Y + 6)-(x - 1, Y + 154), 0 PSET (x, Y + 5), 0 PSET (x + 5, Y), 0 PSET (x + 155, Y), 0 PSET (x + 160, Y + 5), 0 PSET (x, Y + 155), 0 PSET (x + 5, Y + 160), 0 PSET (x + 160, Y + 155), 0 PSET (x + 155, Y + 160), 0 END SUB SUB DRAWJ (x, Y, C) REM TOP LEFT LINE (x + 14, Y + 6)-(x + 19, Y + 7), C, BF CIRCLE (x + 11, Y + 13), 7, C, 3.6, .5, 1.3 CIRCLE (x + 12, Y + 13), 7, C, 3.6, .5, 1.3 LINE (x + 16, Y + 8)-(x + 17, Y + 10), C, BF REM BOTTOM RIGHT LINE (x + 141, Y + 153)-(x + 146, Y + 154), C, BF CIRCLE (x + 148, Y + 148), 7, C, .4, 3.6, 1.3 CIRCLE (x + 149, Y + 148), 7, C, .4, 3.6, 1.3 LINE (x + 143, Y + 151)-(x + 144, Y + 152), C, BF END SUB SUB DRAWK (x, Y, C) REM TOP LEFT LINE (x + 5, Y + 18)-(x + 8, Y + 20), C, BF LINE (x + 13, Y + 18)-(x + 16, Y + 20), C, BF LINE (x + 6, Y + 17)-(x + 7, Y + 8), C, BF LINE (x + 5, Y + 7)-(x + 8, Y + 8), C, BF LINE (x + 13, Y + 7)-(x + 16, Y + 8), C, BF LINE (x + 15, Y + 9)-(x + 8, Y + 15), C LINE (x + 14, Y + 9)-(x + 8, Y + 14), C LINE (x + 14, Y + 17)-(x + 10, Y + 13), C LINE (x + 15, Y + 17)-(x + 11, Y + 13), C PSET (x + 12, Y + 10), 15 PSET (x + 12, Y + 11), C PSET (x + 11, Y + 12), C PSET (x + 12, Y + 10), C PSET (x + 14, Y + 10), C PSET (x + 14, Y + 11), 15 REM BOTTOM RIGHT LINE (x + 144, Y + 152)-(x + 147, Y + 153), C, BF LINE (x + 152, Y + 152)-(x + 155, Y + 153), C, BF LINE (x + 153, Y + 142)-(x + 154, Y + 151), C, BF LINE (x + 144, Y + 141)-(x + 147, Y + 142), C, BF LINE (x + 152, Y + 141)-(x + 155, Y + 142), C, BF LINE (x + 145, Y + 142)-(x + 149, Y + 147), C LINE (x + 146, Y + 142)-(x + 149, Y + 148), C LINE (x + 145, Y + 151)-(x + 152, Y + 145), C LINE (x + 146, Y + 151)-(x + 152, Y + 146), C END SUB SUB DRAWQ (x, Y, C) REM TOP LEFT CIRCLE (x + 11, Y + 13), 7, C, , , 1.3 CIRCLE (x + 12, Y + 13), 7, C, , , 1.3 CIRCLE (x, Y + 26), 20, C, .5, 1.3, .6 CIRCLE (x, Y + 27), 20, C, .5, 1.3, .6 LINE (x + 4, Y + 15)-(x + 5, Y + 16), C, BF LINE (x + 18, Y + 19)-(x + 19, Y + 20), C, BF REM BOTTOM RIGHT CIRCLE (x + 149, Y + 147), 7, C, , , 1.3 CIRCLE (x + 150, Y + 147), 7, C, , , 1.3 CIRCLE (x + 160, Y + 133), 20, C, 3.7, 4.5, .6 CIRCLE (x + 160, Y + 134), 20, C, 3.7, 4.5, .6 LINE (x + 156, Y + 144)-(x + 157, Y + 145), C, BF LINE (x + 142, Y + 140)-(x + 143, Y + 141), C, BF END SUB SUB EIGHT (x, Y, C) CIRCLE (x + 10, Y + 11), 5, C, , , .52 CIRCLE (x + 11, Y + 11), 5, C, , , .52 CIRCLE (x + 10, Y + 17), 6, C, , , .55 CIRCLE (x + 11, Y + 17), 6, C, , , .55 END SUB SUB FIVE (x, Y, C) LINE (x - 12 + (27 * .8), Y - 14 + (10 * .8))-(x - 12 + (39 * .8), Y - 14 + (11 * .8)), C, BF LINE (x - 12 + (27 * .8), Y - 14 + (12 * .8))-(x - 12 + (28 * .8), Y - 14 + (16 * .8)), C, BF CIRCLE (x - 12 + (33 * .8), Y - 14 + (19 * .8)), 6, C, 3.6, 2.5, .7 CIRCLE (x - 12 + (33 * .8), Y - 14 + (20 * .8)), 6, C, 3.6, 2.5, .7 END SUB SUB FOUR (x, Y, C) LINE (x + 12, Y + 19)-(x + 16, Y + 20), C, BF LINE (x + 14, Y + 18)-(x + 14, Y + 7), C, BF LINE (x + 14, Y + 7)-(x + 5, Y + 16), C LINE (x + 15, Y + 7)-(x + 6, Y + 16), C LINE (x + 6, Y + 15)-(x + 16, Y + 16), C, BF LINE (x + 13, Y + 6)-(x + 14, Y + 6), 2, BF LINE (x + 15, Y + 6)-(x + 15, Y + 8), 2, BF REM PSET (X + 7, Y + 15), 2 REM PSET (X + 7, Y + 16), 2 REM PSET (X + 12, Y + 8), 2 REM PSET (X + 13, Y + 8), 2 REM PSET (X + 14, Y + 7), 2 REM PSET (X + 11, Y + 13), 2 REM PSET (X + 9, Y + 13), C REM PSET (X + 10, Y + 14), 2 REM PSET (X + 9, Y + 14), C REM PSET (X + 8, Y + 14), C REM PSET (X + 7, Y + 15), C REM PSET (X + 7, Y + 16), C END SUB DEFINT A-Z '------------------------------------------------------------------------------ FUNCTION GetBlasterAddr% 'Get Blaster Address and DMA channel from Environment Variable tmp% = 0 'No Environment Variable Set...default blast$ = UCASE$(ENVIRON$("BLASTER")) IF LEN(blast$) THEN tmp% = INSTR(blast$, "A") tmp1$ = MID$(blast$, tmp% + 1, 3) tmp% = VAL("&H" + tmp1$) IF tmp% = 203 THEN tmp% = -1 'If there is no value assigned IF tmp% > 0 THEN tmp2% = INSTR(blast$, "D") dma% = VAL(MID$(blast$, tmp2% + 1)) 'dma% is a global variable IF dma% < 0 OR dma% > 7 THEN tmp% = -2 END IF END IF GetBlasterAddr% = tmp% END FUNCTION DEFSNG A-Z SUB HEART (x, Y) REM TOP LEFT CIRCLE (x + 8, Y + 25), 3, 4 CIRCLE (x + 14, Y + 25), 3, 4 LINE (x + 7, Y + 29)-(x + 10, Y + 33), 4 LINE (x + 15, Y + 28)-(x + 12, Y + 33), 4 LINE (x + 11, Y + 34)-(x + 11, Y + 35), 4 PAINT (x + 8, Y + 25), 4, 4 PAINT (x + 14, Y + 25), 4, 4 PAINT (x + 11, Y + 27), 4, 4 REM BOTTOM RIGHT CIRCLE (x + 146, Y + 136), 3, 4 CIRCLE (x + 152, Y + 136), 3, 4 LINE (x + 145, Y + 132)-(x + 148, Y + 128), 4 LINE (x + 153, Y + 133)-(x + 150, Y + 128), 4 REM LINE (X + 150, Y + 127)-(X + 150, Y + 126), 4 PSET (x + 149, Y + 127), 4 PSET (x + 150, Y + 127), 4 PSET (x + 149, Y + 126), 4 PAINT (x + 146, Y + 136), 4, 4 PAINT (x + 152, Y + 136), 4, 4 PAINT (x + 149, Y + 129), 4, 4 END SUB SUB MouseDriver (ax%, bx%, cx%, dx%) DEF SEG = VARSEG(mouse$) mouse% = SADD(mouse$) CALL Absolute(ax%, bx%, cx%, dx%, mouse%) END SUB SUB MOUSEHIDE ax% = 2 MouseDriver ax%, 0, 0, 0 END SUB FUNCTION mouseInit% ax% = 0 MouseDriver ax%, 0, 0, 0 mouseInit% = ax% END FUNCTION SUB MOUSESHOW ax% = 1 MouseDriver ax%, 0, 0, 0 END SUB SUB MouseStatus (LB%, RB%, xMouse%, yMouse%) ax% = 3 MouseDriver ax%, bx%, cx%, dx% LB% = ((bx% AND 1) <> 0) RB% = ((bx% AND 2) <> 0) xMouse% = cx% yMouse% = dx% END SUB SUB NINE (x, Y, C) CIRCLE (x + 10, Y + 10), 5, C, , , .8 CIRCLE (x + 11, Y + 10), 5, C, , , .8 CIRCLE (x + 9, Y + 13), 6, C, 3.8, 6.2, .9 CIRCLE (x + 10, Y + 13), 6, C, 3.8, .1, .9 END SUB SUB NUMBER (N, x, Y) IF N < 14 OR N > 39 THEN C = 4 IF N > 13 AND N < 40 THEN C = 0 IF N > 13 THEN N = N - 13 IF N > 13 THEN N = N - 13 IF N > 13 THEN N = N - 13 IF N = 1 THEN CALL DRAWA(x, Y, C) IF N = 2 THEN CALL DRAW2(x, Y, C) IF N = 3 THEN CALL DRAW3(x, Y, C) IF N = 4 THEN CALL DRAW4(x, Y, C) IF N = 5 THEN CALL DRAW5(x, Y, C) IF N = 6 THEN CALL DRAW6(x, Y, C) IF N = 7 THEN CALL DRAW7(x, Y, C) IF N = 8 THEN CALL DRAW8(x, Y, C) IF N = 9 THEN CALL DRAW9(x, Y, C) IF N = 10 THEN CALL DRAW10(x, Y, C) IF N = 11 THEN CALL DRAWJ(x, Y, C) IF N = 12 THEN CALL DRAWQ(x, Y, C) IF N = 13 THEN CALL DRAWK(x, Y, C) END SUB SUB ONE (x, Y, C) LINE (x + 18, Y + 12)-(x + 22, Y + 8), C LINE (x + 18, Y + 13)-(x + 23, Y + 7), C LINE (x + 22, Y + 8)-(x + 22, Y + 20), C LINE (x + 23, Y + 9)-(x + 23, Y + 20), C LINE (x + 17, Y + 20)-(x + 27, Y + 20), C END SUB DEFINT A-Z '------------------------------------------------------------------------------ SUB PlayBack (buffer$, size%, freq&, BytesPerSec&, chans%, num%) size% = size% - 1 segment& = VARSEG(buffer$) offset& = SADD(buffer$) IF segment& < 0 THEN segment& = segment& + 65536 IF offset& < 0 THEN offset& = offset& + 65536 baseaddr& = segment& * 16 + offset& look1% = VARPTR(baseaddr&) look2% = VARPTR(size%) SELECT CASE dma% CASE 0 dmapage% = &H87 '135 decimal dmaaddr% = 0 dmalen% = 1 CASE 1 dmapage% = &H83 '131 decimal dmaaddr% = 2 dmalen% = 3 CASE 2 dmapage% = &H81 dmaaddr% = 4 dmalen% = 5 CASE 3 dmapage% = &H82 dmaaddr% = 6 dmalen% = 7 CASE 4 dmapage% = &H8F dmaaddr% = &HC0 dmalen% = &HC2 CASE 5 dmapage% = &H8B dmaaddr% = &HC4 dmalen% = &HC6 CASE 6 dmapage% = &H89 dmaaddr% = &HC8 dmalen% = &HCA CASE 7 dmapage% = &H8A dmaaddr% = &HCC dmalen% = &HCE END SELECT SELECT CASE dma% CASE 0 TO 3 dmamask% = &HA dmamode% = &HB dmaclear% = &HC dmastatus% = &H8 CASE 4 TO 7 dmamask% = &HD4 dmamode% = &HD6 dmaclear% = &HD8 dmastatus% = &HD0 END SELECT SELECT CASE dma% CASE 0, 4 dmaterminal% = 1 'bit 0 of status register (&H08 or &HD0) CASE 1, 5 dmaterminal% = 2 'bit 1 CASE 2, 6 dmaterminal% = 4 'bit 2 CASE 3, 7 dmaterminal% = 8 'bit 3 END SELECT OUT dmamask%, dma% + 4 'mask the dma channel OUT dmaclear%, &H0 '(clear the internal DMA flip/flop) OUT dmamode%, 72 + dma% ' 72=010010XX where XX=dmachannel% OUT dmaaddr%, PEEK(look1%) 'bits 0-7 of the 20bit address OUT dmaaddr%, PEEK(look1% + 1) 'bits 8-15 of the 20bit address OUT dmapage%, PEEK(look1% + 2) 'bits 16-19 of the 20 bit address OUT dmalen%, PEEK(look2%) 'bits 0-7 of size% OUT dmalen%, PEEK(look2% + 1) 'bits 8-15 of size% OUT dmamask%, dma% 'enable channel IF num% = 1 THEN 'only need to Write out time constant once timeconst% = 256 - 1000000 / (freq& * chans%) CALL WriteToDSP(&H40) CALL WriteToDSP(timeconst%) 'Reset Mixer DSPmixeraddress = Blasteraddr% + &H4 OUT BlasterAddr% + &H4, &H0 OUT BlasterAddr% + &H4 + 1, 0 'Set Volume to Maximum...255 OUT BlasterAddr% + &H4, &H22 OUT BlasterAddr% + &H4 + 1, 255 IF chans% = 2 THEN 'Set mixer to Stereo Output OUT BlasterAddr% + &H4, &HE OUT BlasterAddr% + &H4 + 1, 34 '34=2^5+2^1 END IF END IF IF BytesPerSec& > 22000 THEN CALL WriteToDSP(&H48) 'Set Block Size ELSE CALL WriteToDSP(&H14) 'DMA Mode 8-bit DAC END IF CALL WriteToDSP(PEEK(look2%)) 'Lo byte of address CALL WriteToDSP(PEEK(look2% + 1)) 'High byte of address IF BytesPerSec& > 22000 THEN CALL WriteToDSP(&H91) 'High Speed DMA mode 8-bit dummy% = INP(dmastatus%) 'Read status byte once to make sure DMA is going. WAIT dmastatus%, dmaterminal% 'Loop until terminal count bit set in DMA status register 'DMA Transfer is Now Complete 'Acknowledge the DSP interrupt by reading the DATA AVAILABLE port once dummy% = INP(BlasterAddr% + &HE) 'DSP Available address END SUB DEFSNG A-Z SUB PlayWav (wavefile$) repeats% = 1 BlasterAddr% = GetBlasterAddr% SELECT CASE BlasterAddr% CASE -2 PRINT "Bad DMA Channel specified!" END CASE -1 PRINT "No Port Base Address Given!" END CASE 0 PRINT "No BLASTER Environment Variable Set!" END CASE ELSE 'Assume a valid Address Exists ' PRINT "Blaster Address = "; HEX$(BlasterAddr%) END SELECT IF NOT SBreset% THEN PRINT "SoundBlaster Card Would Not Reset!" END END IF sp% = INSTR(Spec$, " ") IF sp% THEN wavefile$ = LEFT$(Spec$, sp% - 1) repeats% = VAL(RIGHT$(Spec$, LEN(Spec$) - sp%)) IF repeats% = 0 THEN repeats% = 1 ELSE IF LEN(Spec$) THEN wavefile$ = Spec$ repeats% = 1 END IF END IF IF LEN(wavefile$) = 0 THEN END IF 'wavefile$ = "C:\QBASIC\THEME.WAV" CALL ValidWavHeader(wavefile$, LenHeader%, WavLen&, Channels%, Sampling&, bytes&, ok%) IF NOT ok% THEN PRINT "Bad Wave File Format" END END IF MaxBuffer% = 7053 CALL WriteToDSP(&HD1) 'Speaker ON FOR repeat% = 1 TO repeats% 'This can loop to play the file ii% times] filenum% = FREEFILE OPEN wavefile$ FOR BINARY AS filenum% num% = 0 SEEK filenum%, LenHeader% + 1 Remaining& = WavLen& DO num% = num% + 1 IF Remaining& > MaxBuffer% THEN BufferLen% = MaxBuffer% ELSE BufferLen% = Remaining& END IF Remaining& = Remaining& - BufferLen% buffer$ = SPACE$(BufferLen%) GET filenum%, , buffer$ CALL PlayBack(buffer$, BufferLen%, Sampling&, bytes&, Channels%, num%) LOOP WHILE Remaining& > 0 OUT &H20, &H20 'Reset Normal Interrupt Service CLOSE filenum% NEXT repeat% CALL WriteToDSP(&HD3) 'Speaker OFF END SUB DEFINT A-Z '------------------------------------------------------------------------------ FUNCTION SBreset% 'DSPreset% = address% + &H6 'DSPread% = address% + &HA 'DSPwrite% = address% + &HC 'DSPavail% = address% + &HE 'DSPmixer% = address% + &H4 OUT BlasterAddr% + &H6, 1 'Reset address delay .1 OUT BlasterAddr% + &H6, 0 time1! = TIMER: noreset% = 0 DO 'Read Data Available port until bit 7 is set 'This should take about 100 micro seconds...give it 1 full second IF TIMER - time1! > 1! THEN noreset% = -1 LOOP UNTIL ((INP(BlasterAddr% + &HE) AND 128) = 128) OR noreset% IF NOT noreset% THEN IF INP(BlasterAddr% + &HA) = &HAA THEN SBreset% = -1 ELSE SBreset% = 0 END IF ELSE SBreset% = 0 END IF END FUNCTION DEFSNG A-Z SUB SEVEN (x, Y, C) LINE (x + 5, Y + 8)-(x + 6, Y + 11), C, BF LINE (x + 5, Y + 8)-(x + 16, Y + 9), C, BF LINE (x + 15, Y + 10)-(x + 16, Y + 11), C, BF REM CIRCLE (X + 24, Y + 16), 13, C, 2.4, 3.2, .5 CIRCLE (x + 21, Y + 19), 13, C, 2.1, 3.3, .6 CIRCLE (x + 22, Y + 19), 13, C, 2.1, 3.3, .6 END SUB SUB SIX (x, Y, C) CIRCLE (x + 10, Y + 16), 5, C, , , .8 CIRCLE (x + 11, Y + 16), 5, C, , , .8 CIRCLE (x + 11, Y + 13), 6, C, .7, 3.7, .9 CIRCLE (x + 12, Y + 13), 6, C, .7, 3.4, .9 PSET (x + 15, Y + 10), C PSET (x + 16, Y + 9), C END SUB SUB SPADE (x, Y) REM TOP LEFT CIRCLE (x + 8, Y + 33), 3, 0 CIRCLE (x + 14, Y + 33), 3, 0 LINE (x + 7, Y + 29)-(x + 10, Y + 25), 0 LINE (x + 15, Y + 30)-(x + 12, Y + 25), 0 REM LINE (X +12, Y +24)-(X + 12, Y +23), 0 PSET (x + 11, Y + 24), 0 PSET (x + 12, Y + 24), 0 PSET (x + 11, Y + 23), 0 PAINT (x + 8, Y + 33), 0, 0 PAINT (x + 14, Y + 33), 0, 0 PAINT (x + 11, Y + 26), 0, 0 LINE (x + 11, Y + 36)-(x + 8, Y + 39), 0 LINE (x + 11, Y + 36)-(x + 14, Y + 39), 0 LINE (x + 8, Y + 39)-(x + 12, Y + 39), 0 PSET (x + 11, Y + 35), 0 PAINT (x + 11, Y + 37), 0, 0 REM BOTTOM RIGHT CIRCLE (x + 147, Y + 128), 3, 0 CIRCLE (x + 153, Y + 128), 3, 0 LINE (x + 146, Y + 132)-(x + 149, Y + 136), 0 LINE (x + 154, Y + 131)-(x + 151, Y + 136), 0 LINE (x + 150, Y + 137)-(x + 150, Y + 138), 0 PAINT (x + 147, Y + 128), 0, 0 PAINT (x + 153, Y + 128), 0, 0 PAINT (x + 150, Y + 130), 0, 0 LINE (x + 149, Y + 125)-(x + 147, Y + 122), 0 LINE (x + 150, Y + 125)-(x + 152, Y + 122), 0 LINE (x + 147, Y + 122)-(x + 152, Y + 122), 0 PSET (x + 151, Y + 126), 0 PSET (x + 151, Y + 128), 0 PAINT (x + 151, Y + 123), 0, 0 END SUB SUB THREE (x, Y, C) LINE (x - 6 + (12 * .9), Y - 5 + (8 * .9))-(x - 6 + (25 * .9), Y - 5 + (9 * .9)), C, BF LINE (x - 6 + (12 * .9), Y - 5 + (8 * .9))-(x - 6 + (13 * .9), Y - 5 + (11 * .9)), C, BF LINE (x - 6 + (23 * .9), Y - 5 + (10 * .9))-(x - 6 + (14 * .9), Y - 5 + (15 * .9)), C LINE (x - 6 + (24 * .9), Y - 5 + (10 * .9))-(x - 6 + (15 * .9), Y - 5 + (15 * .9)), C CIRCLE (x - 6 + (18 * .9), Y - 5 + (18 * .9)), 5, C, 3.3, 1.9, .7 CIRCLE (x - 6 + (19 * .9), Y - 5 + (18 * .9)), 5, C, 3.3, 1.9, .7 END SUB SUB TITLESCREEN CLS : SCREEN 12 COLOR 12 LOCATE 9, 17: PRINT "B L A C K" LOCATE 15, 35: PRINT "J A C K !" LOCATE 24, 30: PRINT "PRESS ANY KEY TO PLAY" PAINT (1, 1), 15, 12 FOR x = 1 TO 25 STEP 4 CALL SPADE(x * 15, 85) CALL SPADE(x * 15, 120) CALL HEART(x * 15 + 15, 85) CALL HEART(x * 15 + 15, 120) CALL CLUB(x * 15 + 30, 85) CALL CLUB(x * 15 + 30, 120) CALL DIAMOND(x * 15 + 45, 85) CALL DIAMOND(x * 15 + 45, 120) NEXT x END SUB SUB TWO (x, Y, C) CIRCLE (x + 11, Y + 10), 5, C, 5.2, 3.3, .5 CIRCLE (x + 12, Y + 10), 5, C, 5.2, 3.3, .5 LINE (x + 12, Y + 14)-(x + 6, Y + 17), C LINE (x + 13, Y + 14)-(x + 7, Y + 17), C LINE (x + 7, Y + 18)-(x + 6, Y + 19), C, BF PSET (x + 6, Y + 20), C LINE (x + 7, Y + 19)-(x + 17, Y + 19), C, BF END SUB DEFINT A-Z '------------------------------------------------------------------------------ SUB ValidWavHeader (FILE$, LenHeader%, dataLen&, nChannels%, nSamplesPerSec&, nAvgBytesPerSec&, ok%) rID$ = SPACE$(4) wID$ = SPACE$(4) fID$ = SPACE$(4) dat$ = SPACE$(4) dummy$ = SPACE$(1) filenum% = FREEFILE OPEN FILE$ FOR BINARY AS filenum% GET filenum%, , rID$ GET filenum%, , rLen& GET filenum%, , wID$ GET filenum%, , fID$ GET filenum%, , fLen& GET filenum%, , wFormatTag% '2 bytes GET filenum%, , nChannels% '2 bytes GET filenum%, , nSamplesPerSec& '4 bytes GET filenum%, , nAvgBytesPerSec& '4 bytes GET filenum%, , nBlockAlign% '2 bytes GET filenum%, , FormatSpecific% '2 bytes 'Read bytes until have read fLen& total bytes. 'I have no idea what these next bytes are used for (if they even exist). FOR I% = 1 TO fLen& - 16 '16 bytes is what we have read in so far GET filenum%, , dummy$ 'read in 1 byte at a time NEXT I% GET filenum%, , dat$ IF UCASE$(dat$) = "FACT" THEN 'funny format... GET filenum%, , dummy& GET filenum%, , dummy& GET filenum%, , dat$ END IF GET filenum%, , dataLen& LenHeader% = LOC(1) CLOSE filenum% ' PRINT rID$; ' PRINT rLen&; ' PRINT wID$; ' PRINT fID$; ' PRINT fLen&; ' PRINT wFormatTag%; '2 bytes ' PRINT nChannels%; '2 bytes ' PRINT nSamplesPerSec&; '4 bytes ' PRINT nAvgBytesPerSec&; '4 bytes ' PRINT nBlockAlign%; '2 bytes ' PRINT FormatSpecific%; '2 bytes ' PRINT dat$; ' PRINT dataLen&; ' PRINT LenHeader% IF UCASE$(rID$) = "RIFF" THEN IF UCASE$(wID$) = "WAVE" THEN IF UCASE$(dat$) = "DATA" THEN IF UCASE$(fID$) = "FMT " THEN IF FormatSpecific% = 8 THEN ok% = -1 END IF END IF END IF END IF END SUB '------------------------------------------------------------------------------ SUB WriteToDSP (v%) DO LOOP UNTIL (INP(BlasterAddr% + &HC) AND 128) = 0 OUT BlasterAddr% + &HC, v% END SUB DEFSNG A-Z SUB ZERO (x, Y, C) CIRCLE (x + 9, Y + 12), 6, C, , , 1.1 CIRCLE (x + 10, Y + 12), 6, C, , , 1.1 LINE (x + 12, Y + 9)-(x + 6, Y + 15), C END SUB