'=========================================================================== ' Subject: FLICKER FREE SPRITES Date: 02-05-97 (20:20) ' Author: David Gentry Code: QB, QBasic, PDS ' Origin: comp.lang.basic.misc Packet: GRAPHICS.ABC '=========================================================================== '> I've been programming for a little over 3 years in Qbasic. I know the '> standard BASIC graphics statements, but I'm trying to get into more '> advanced techniques. The main things are sprites, flicker free tiles on '> modes greater than 9(page flipping), ect. If someone can direct me to '> any good books, sites, or tutorials I would be in your debt. 'If it is SPRITES you want, it is SPRITES you get. I have found the 'following code that demonstrates FAST, FLICKER FREE SPRITES. 'The following program is the sole creation of David Grace 'PRODIGY (CDRS62D). David Grace, like so many other good 'programmers, has left PRODIGY. So if you wish to comment or 'leave a reply about this DEMO, please address it to David 'Gentry using the above I.D. number! DECLARE SUB PUT2P (X%, Y%, AR%()) DECLARE SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%) ' This short demo for an action-shoot'em-up game was ' posted because of several questions about animation. ' In this code you will find examples of page-flipping ' animation, including a new sprite-clipping routine that ' allows you to place a GETted sprite past the boundaries ' of the screen. Also, scrolling stars, explosions, ' sprite movement/limitation on movement is shown. Using ' ideas here, one could possibly build an entire game from ' this concept. (BTW: Format of title screen was gotten ' from a Genesis game.) Title: SHIPDEMO.BAS (1-6) CLEAR , , 2000: DEFINT A-Z: SCREEN 7: CLS DEF FNR (X) = INT(RND * X) + 1 DIM E1(150), E2(50), E3(15), S1(500) ' dim arrays DIM S2(500), F1(70), F2(40), R1(200) DIM CX(50), CY(50), CT(50) DIM TEMP(500) DIM SX(50), SY(50), ST(50) SCREEN , , 0, 1 ' set paging mode CIRCLE (50, 50), 10, 7 PAINT (50, 50), 7 LINE (40, 50)-(60, 51), 12, B LINE (40, 50)-(60, 51), 9, B, &H5555 LINE (53, 43)-(54, 44), 15, B PSET (57, 45), 15 LINE (45, 55)-(55, 55), 12 LINE (46, 56)-(54, 56), 4 PSET (45, 45), 1: PSET (44, 46), 1 PSET (46, 45), 11: PSET (45, 46), 11 LINE (43, 45)-(42, 46), 1 GET (40, 40)-(60, 60), E1 'draw & get enemy1 CLS CIRCLE (50, 50), 5, 7: PAINT (50, 50), 7 LINE (45, 50)-(55, 50), 9 LINE (45, 50)-(55, 50), 12, , &H5555 LINE (48, 53)-(52, 53), 4 PSET (52, 47), 15: PSET (48, 47), 1 GET (45, 45)-(55, 55), E2 'draw & get enemy2 CLS CIRCLE (50, 50), 2, 7 PAINT (50, 50), 7 LINE (48, 50)-(52, 50), 4 LINE (48, 50)-(52, 50), 1, , &H5555 PSET (51, 48), 15 GET (48, 48)-(52, 52), E3 'draw & get enemy3 CLS LINE (50, 50)-(100, 50), 7 LINE (60, 45)-(100, 50), 7 LINE (60, 45)-(50, 45), 7 LINE -(50, 50), 7 PAINT (51, 49), 15, 7 LINE (50, 54)-(100, 54), 7 LINE (100, 54)-(60, 59), 7 LINE (60, 59)-(50, 59), 7 LINE -(50, 54), 7: PAINT (51, 55), 15, 7 LINE (50, 51)-(95, 53), 3, BF LINE (82, 51)-(80, 53), 1, BF: PSET (80, 51), 9 LINE (76, 50)-(79, 54), 1, BF: PSET (79, 50), 9 LINE (72, 49)-(75, 55), 1, BF: PSET (78, 50), 9 LINE (71, 49)-(71, 55), 11: PSET (76, 49), 9 LINE (60, 49)-(70, 55), 5, BF LINE (60, 50)-(70, 54), 13, BF LINE (59, 49)-(59, 55), 11 FOR I = 50 TO 58 STEP 2 LINE (I, 51)-(I, 53), 8 NEXT LINE (90, 44)-(70, 40), 8 LINE (70, 40)-(50, 40), 8 LINE -(50, 37), 8 LINE -(76, 37), 8 LINE -(90, 44), 8 PAINT (51, 38), 7, 8 LINE (55, 41)-(56, 44), 11, B LINE (75, 42)-(71, 46), 11 LINE (90, 60)-(70, 64), 8 LINE (70, 64)-(50, 64), 8 LINE -(50, 67), 8 LINE -(76, 67), 8 LINE -(90, 60), 8 PAINT (51, 65), 7, 8 LINE (55, 63)-(56, 60), 11, B LINE (75, 62)-(71, 58), 11 LINE (49, 46)-(49, 58), 8 LINE (48, 47)-(48, 57), 8 LINE (47, 46)-(47, 58), 7 LINE (47, 46)-(47, 58), 8, , &H5555 GET (47, 37)-(100, 67), S1 'draw & get ship1 CLS CIRCLE (50, 50), 7, 4: PAINT (50, 50), 4 CIRCLE (50, 50), 5, 12: PAINT (50, 50), 12 CIRCLE (50, 50), 3, 14: PAINT (50, 50), 14 LINE (51, 43)-(58, 57), 0, BF GET (43, 43)-(50, 57), F1 'draw & get flame1 CLS CIRCLE (50, 50), 4, 12: PAINT (50, 50), 12 CIRCLE (50, 50), 2, 14: PAINT (50, 50), 14 LINE (51, 46)-(54, 54), 0, BF GET (46, 46)-(50, 54), F2 'draw & get flame2 CLS PUT (50, 50), S1 GET (50, 50)-(100, 56), TEMP PUT (50, 51), TEMP, PSET LINE (50, 50)-(90, 50), 0 GET (50, 61)-(105, 90), TEMP PUT (50, 59), TEMP, PSET LINE (53, 79)-(79, 79), 8 LINE -(93, 71), 8 GET (50, 51)-(103, 79), S2 'alter & get ship2 CLS LINE (50, 50)-(50, 100), 7 LINE (48, 51)-(49, 99), 7, B LINE (46, 54)-(47, 96), 7, B LINE (45, 56)-(45, 94), 7 LINE (50, 70)-(49, 80), 8, B PSET (50, 69), 15: PSET (50, 81), 15 LINE (48, 57)-(49, 64), 3, B LINE (48, 86)-(49, 93), 3, B LINE (44, 60)-(44, 68), 8 LINE (44, 83)-(44, 91), 8 GET (44, 50)-(50, 100), R1 'draw & get rship CLS : PCOPY 0, 2 'prepare our "background" page FOR I = 1 TO 50 'sprinkle some stars SX(I) = FNR(319): SY(I) = FNR(199) ST(I) = FNR(2) NEXT ED = 0: ET = 0: TOG = 0 DO PCOPY 2, 0 'copy background to template FOR I = 1 TO 50 'move & display stars IF ST(I) = 1 THEN C = 1 ELSE C = 9 PSET (SX(I), SY(I)), C SX(I) = SX(I) - ST(I) * 5 IF SX(I) < 0 THEN SX(I) = 319: SY(I) = FNR(199) ST(I) = FNR(2) END IF IF ET > 550 THEN SY(I) = SY(I) - (550 - ET) NEXT IF ED = 1 AND EXD = 0 THEN 'short burst PUT2P EX - 8, EY + 3, F1() PUT2P EX - 28, EY - 17, F1() PUT2P EX - 48, EY - 37, F1() END IF SELECT CASE ED 'display enemies CASE IS = 1: PUT2P EX, EY, E1() PUT2P EX - 20, EY - 20, E1() PUT2P EX - 40, EY - 40, E1() CASE IS = 2: PUT2P EX + 5, EY + 5, E2() PUT2P EX - 15, EY - 15, E2() PUT2P EX - 35, EY - 35, E2() CASE IS = 3: PUT2P EX + 7, EY + 7, E3() PUT2P EX - 13, EY - 13, E3() PUT2P EX - 33, EY - 33, E3() END SELECT IF Y <> 0 THEN 'display ship IF YD <> 0 THEN PUT2P X, Y + 2, S2() ELSE PUT2P X, Y, S1() END IF IF TOG = 0 THEN 'fire flame TOG = 1: PUT2P X - 8, Y + 8, F1() ELSE TOG = 0: PUT2P X - 5, Y + 11, F2() END IF END IF IF EXR <> 0 THEN 'put rship PUT2P EXR, 70, R1() IF TOG = 0 THEN 'give it some flames PUT2P EXR - 8, 77, F1() PUT2P EXR - 8, 99, F1() ELSE PUT2P EXR - 5, 80, F2() PUT2P EXR - 5, 102, F2() END IF END IF IF YD = 0 AND XD = 0 AND ET > 121 AND X <= 63 THEN IF TOG = 0 THEN 'lasergun shots LINE (X + 35, Y + 9)-(319, Y + 9), 9, , &HFF00 LINE (X + 35, Y + 9)-(319, Y + 9), 3, , &HCC00 LINE (X + 35, Y + 21)-(319, Y + 21), 9, , &HFF00 LINE (X + 35, Y + 21)-(319, Y + 21), 3, , &HCC00 ELSE LINE (X + 35, Y + 9)-(319, Y + 9), 1, , &HFF LINE (X + 35, Y + 9)-(319, Y + 9), 11, , &HCC LINE (X + 35, Y + 21)-(319, Y + 21), 1, , &HFF LINE (X + 35, Y + 21)-(319, Y + 21), 11, , &HCC END IF FOR I = 1 TO 5 '"puff" of damage PSET (317 - FNR(10), FNR(18) + Y + 5), 15 NEXT END IF IF EX = 1 THEN 'random explosions C = FNR(2) IF C = 1 THEN C = 4 ELSE C = 12 a = FNR(30) + 299: B = FNR(50) + 75 CIRCLE (a, B), FNR(20) + 10, C PAINT (a - 9, B), C IF X > 62 THEN EXR = EXR + 1: IF EXR > 330 THEN EXR = 330 END IF END IF IF EX = 2 THEN 'debris falling behind FOR I = 1 TO 20 IF CX(I) > 0 THEN PSET (CX(I), CY(I)), 15 CX(I) = CX(I) - CT(I) IF CX(I) < 0 THEN CX(I) = 0 END IF NEXT END IF IF X = 80 THEN 'large flame burst CIRCLE (X - 5, Y + 20), 100, 15 PAINT (X - 5, Y + 20), 15 XD = 30: X = X + 1 END IF IF ET < 20 THEN 'text FONT "Coming soon...", 100, 95, 8, 0, 15, 0, 8 END IF IF ET > 390 AND ET < 450 THEN 'text2 FONT "...to a computer near you...", 50, 95, 8, 0, 11, 0, 0 END IF IF ET > 450 AND ET < 550 THEN 'text3 a$ = "* S T A R S H I P L E G E N D I I *" FONT a$, 10, 85, 8, 0, 14, 0, 0 FONT "(don't miss it!)", 100, 100, 8, 0, 6, 0, 0 END IF PCOPY 0, 1 'copy template to viewing screen ET = ET + 1 'cycle timer (add delays if too fast) IF ET = 30 THEN 'activate enemies EX = 350: EY = 200: ED = 1: EXD = -23: EYD = -8 END IF IF ED > 0 THEN 'enemy move parser EX = EX + EXD: EY = EY + EYD EXD = EXD + 1: IF EXD > 20 THEN EXD = 20 IF (EX MOD 2) = 0 THEN EYD = EYD + 1: IF EYD > 2 THEN EYD = 2 END IF IF EXD > 1 AND (ET MOD 3) = 0 THEN ED = ED + 1: IF ED > 3 THEN ED = 3 END IF IF EX > 350 THEN ED = 0 END IF IF ET = 120 THEN 'activate ship X = 0: Y = 200: XD = 10: YD = -15: EX = 0: EXR = 340 END IF IF ET > 121 THEN 'ship move parser IF EX = 0 THEN EXR = EXR - 1: IF EXR < 314 THEN EXR = 314 END IF X = X + XD: Y = Y + YD XD = XD - 1: IF XD < 0 THEN XD = 0 YD = YD + 1: IF YD > 0 THEN YD = 0 IF XD = 0 AND (ET MOD 7) = 0 THEN X = X + 1 END IF IF X > 65 AND EX = 1 THEN 'explosion parser EXR = 0 PALETTE 0, 15 EX = 2 FOR I = 1 TO 20 CX(I) = 319 + FNR(50): CY(I) = FNR(50) + 70 CT(I) = FNR(20) + 10 NEXT PALETTE 0, 0 END IF IF X > 60 AND EX = 0 THEN EX = 1 'switch expls LOOP UNTIL INKEY$ <> "" OR ET > 570 'repeat CLS : PCOPY 0, 1 'clear active page END extX% = stepX%: extY% = stepY% DEF SEG = &HFFA6 FOR I% = 1 TO LEN(a$) addr% = 8 * ASC(MID$(a$, I%)) + 14 IF Background% THEN IF Background% = 256 THEN BG% = FALSE ELSE BG% = Background% IF I% = LEN(a$) THEN extX% = FALSE: extY% = FALSE LINE (X%, Y%)-(X% + 7 + extX%, Y% + 7 + extY%), BG%, BF END IF FOR j% = 0 TO 7 mask% = PEEK(addr% + j%) * 128 IF SHADOW% > 0 THEN LINE (X% + 9, Y% + j% + 2)-(X% + 2, Y% + j% + 2), SHADOW%, , mask% END IF LINE (X% + 7, Y% + j%)-(X%, Y% + j%), CO%, , mask% NEXT X% = X% + extX% Y% = Y% + extY% NEXT DEF SEG SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%) END SUB ' PUT2P - PUT Type II: ' Clipping PUT routine. ' SUB PUT2P (X, Y, AR()) STATIC IF X < 0 OR Y < 0 THEN EXIT SUB 'off screen IF X + AR(0) < 320 AND Y + AR(1) < 200 THEN PUT (X, Y), AR, PSET: EXIT SUB END IF 'already on screen IF X > (320 - AR(0)) THEN VL = 320 - X ELSE VL = AR(0) IF VL < 1 THEN EXIT SUB 'no need IF Y > (200 - AR(1)) THEN VL2 = 200 - Y ELSE VL2 = AR(1) IF VL2 < 1 THEN EXIT SUB 'no need SAR = AR(0): SAR1 = AR(1) 'hold copy AR(0) = VL: AR(1) = VL2 PUT (X, Y), AR, PSET 'put modified array AR(0) = SAR: AR(1) = SAR1 'restore altered bytes END SUB