1: 'The following program is the sole creation of David Grace 2: 'PRODIGY (CDRS62D). David Grace, like so many other good 3: 'programmers, has left PRODIGY. So if you wish to comment or 4: 'leave a reply about this DEMO, please address it to David 5: 'Gentry using the above I.D. number! 6: DECLARE SUB PUT2P (X%, Y%, AR%()) 7: DECLARE SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%) 8: ' This short demo for an action-shoot'em-up game was 9: ' posted because of several questions about animation. 10: ' In this code you will find examples of page-flipping 11: ' animation, including a new sprite-clipping routine that 12: ' allows you to place a GETted sprite past the boundaries 13: ' of the screen. Also, scrolling stars, explosions, 14: ' sprite movement/limitation on movement is shown. Using 15: ' ideas here, one could possibly build an entire game from 16: ' this concept. (BTW: Format of title screen was gotten 17: ' from a Genesis game.) Title: SHIPDEMO.BAS (1-6) 18: CLEAR , , 2000: DEFINT A-Z: SCREEN 7: CLS 19: DEF FNR (X) = INT(RND * X) + 1 20: DIM E1(150), E2(50), E3(15), S1(500) ' dim arrays 21: DIM S2(500), F1(70), F2(40), R1(200) 22: DIM CX(50), CY(50), CT(50) 23: DIM TEMP(500) 24: DIM SX(50), SY(50), ST(50) 25: 26: 27: SCREEN , , 0, 1 ' set paging mode 28: CIRCLE (50, 50), 10, 7 29: PAINT (50, 50), 7 30: LINE (40, 50)-(60, 51), 12, B 31: LINE (40, 50)-(60, 51), 9, B, &H5555 32: LINE (53, 43)-(54, 44), 15, B 33: PSET (57, 45), 15 34: LINE (45, 55)-(55, 55), 12 35: LINE (46, 56)-(54, 56), 4 36: PSET (45, 45), 1: PSET (44, 46), 1 37: PSET (46, 45), 11: PSET (45, 46), 11 38: LINE (43, 45)-(42, 46), 1 39: GET (40, 40)-(60, 60), E1 'draw & get enemy1 40: CLS 41: CIRCLE (50, 50), 5, 7: PAINT (50, 50), 7 42: LINE (45, 50)-(55, 50), 9 43: LINE (45, 50)-(55, 50), 12, , &H5555 44: LINE (48, 53)-(52, 53), 4 45: PSET (52, 47), 15: PSET (48, 47), 1 46: GET (45, 45)-(55, 55), E2 'draw & get enemy2 47: CLS 48: CIRCLE (50, 50), 2, 7 49: PAINT (50, 50), 7 50: LINE (48, 50)-(52, 50), 4 51: LINE (48, 50)-(52, 50), 1, , &H5555 52: PSET (51, 48), 15 53: GET (48, 48)-(52, 52), E3 'draw & get enemy3 54: CLS 55: LINE (50, 50)-(100, 50), 7 56: LINE (60, 45)-(100, 50), 7 57: LINE (60, 45)-(50, 45), 7 58: 59: LINE -(50, 50), 7 60: PAINT (51, 49), 15, 7 61: LINE (50, 54)-(100, 54), 7 62: LINE (100, 54)-(60, 59), 7 63: LINE (60, 59)-(50, 59), 7 64: LINE -(50, 54), 7: PAINT (51, 55), 15, 7 65: LINE (50, 51)-(95, 53), 3, BF 66: LINE (82, 51)-(80, 53), 1, BF: PSET (80, 51), 9 67: LINE (76, 50)-(79, 54), 1, BF: PSET (79, 50), 9 68: LINE (72, 49)-(75, 55), 1, BF: PSET (78, 50), 9 69: LINE (71, 49)-(71, 55), 11: PSET (76, 49), 9 70: LINE (60, 49)-(70, 55), 5, BF 71: LINE (60, 50)-(70, 54), 13, BF 72: LINE (59, 49)-(59, 55), 11 73: FOR I = 50 TO 58 STEP 2 74: LINE (I, 51)-(I, 53), 8 75: NEXT 76: LINE (90, 44)-(70, 40), 8 77: LINE (70, 40)-(50, 40), 8 78: LINE -(50, 37), 8 79: LINE -(76, 37), 8 80: LINE -(90, 44), 8 81: PAINT (51, 38), 7, 8 82: LINE (55, 41)-(56, 44), 11, B 83: LINE (75, 42)-(71, 46), 11 84: 85: LINE (90, 60)-(70, 64), 8 86: LINE (70, 64)-(50, 64), 8 87: LINE -(50, 67), 8 88: LINE -(76, 67), 8 89: LINE -(90, 60), 8 90: PAINT (51, 65), 7, 8 91: LINE (55, 63)-(56, 60), 11, B 92: LINE (75, 62)-(71, 58), 11 93: 94: LINE (49, 46)-(49, 58), 8 95: LINE (48, 47)-(48, 57), 8 96: LINE (47, 46)-(47, 58), 7 97: LINE (47, 46)-(47, 58), 8, , &H5555 98: GET (47, 37)-(100, 67), S1 'draw & get ship1 99: 100: 101: CLS 102: CIRCLE (50, 50), 7, 4: PAINT (50, 50), 4 103: CIRCLE (50, 50), 5, 12: PAINT (50, 50), 12 104: CIRCLE (50, 50), 3, 14: PAINT (50, 50), 14 105: LINE (51, 43)-(58, 57), 0, BF 106: GET (43, 43)-(50, 57), F1 'draw & get flame1 107: 108: 109: CLS 110: CIRCLE (50, 50), 4, 12: PAINT (50, 50), 12 111: CIRCLE (50, 50), 2, 14: PAINT (50, 50), 14 112: LINE (51, 46)-(54, 54), 0, BF 113: GET (46, 46)-(50, 54), F2 'draw & get flame2 114: 115: 116: CLS 117: PUT (50, 50), S1 118: GET (50, 50)-(100, 56), TEMP 119: PUT (50, 51), TEMP, PSET 120: LINE (50, 50)-(90, 50), 0 121: GET (50, 61)-(105, 90), TEMP 122: PUT (50, 59), TEMP, PSET 123: LINE (53, 79)-(79, 79), 8 124: LINE -(93, 71), 8 125: GET (50, 51)-(103, 79), S2 'alter & get ship2 126: 127: 128: CLS 129: LINE (50, 50)-(50, 100), 7 130: LINE (48, 51)-(49, 99), 7, B 131: LINE (46, 54)-(47, 96), 7, B 132: LINE (45, 56)-(45, 94), 7 133: LINE (50, 70)-(49, 80), 8, B 134: PSET (50, 69), 15: PSET (50, 81), 15 135: LINE (48, 57)-(49, 64), 3, B 136: LINE (48, 86)-(49, 93), 3, B 137: LINE (44, 60)-(44, 68), 8 138: LINE (44, 83)-(44, 91), 8 139: GET (44, 50)-(50, 100), R1 'draw & get rship 140: CLS : PCOPY 0, 2 'prepare our "background" page 141: FOR I = 1 TO 50 'sprinkle some stars 142: SX(I) = FNR(319): SY(I) = FNR(199) 143: ST(I) = FNR(2) 144: NEXT 145: 146: 147: ED = 0: ET = 0: TOG = 0 148: DO 149: PCOPY 2, 0 'copy background to template 150: FOR I = 1 TO 50 'move & display stars 151: IF ST(I) = 1 THEN C = 1 ELSE C = 9 152: PSET (SX(I), SY(I)), C 153: SX(I) = SX(I) - ST(I) * 5 154: IF SX(I) < 0 THEN 155: SX(I) = 319: SY(I) = FNR(199) 156: ST(I) = FNR(2) 157: END IF 158: IF ET > 550 THEN SY(I) = SY(I) - (550 - ET) 159: NEXT 160: IF ED = 1 AND EXD = 0 THEN 'short burst 161: PUT2P EX - 8, EY + 3, F1() 162: PUT2P EX - 28, EY - 17, F1() 163: PUT2P EX - 48, EY - 37, F1() 164: END IF 165: SELECT CASE ED 'display enemies 166: CASE IS = 1: 167: PUT2P EX, EY, E1() 168: PUT2P EX - 20, EY - 20, E1() 169: PUT2P EX - 40, EY - 40, E1() 170: CASE IS = 2: 171: PUT2P EX + 5, EY + 5, E2() 172: PUT2P EX - 15, EY - 15, E2() 173: PUT2P EX - 35, EY - 35, E2() 174: CASE IS = 3: 175: PUT2P EX + 7, EY + 7, E3() 176: PUT2P EX - 13, EY - 13, E3() 177: 178: 179: PUT2P EX - 33, EY - 33, E3() 180: END SELECT 181: IF Y <> 0 THEN 'display ship 182: IF YD <> 0 THEN 183: PUT2P X, Y + 2, S2() 184: ELSE 185: PUT2P X, Y, S1() 186: END IF 187: IF TOG = 0 THEN 'fire flame 188: TOG = 1: PUT2P X - 8, Y + 8, F1() 189: ELSE 190: TOG = 0: PUT2P X - 5, Y + 11, F2() 191: END IF 192: END IF 193: IF EXR <> 0 THEN 'put rship 194: PUT2P EXR, 70, R1() 195: IF TOG = 0 THEN 'give it some flames 196: PUT2P EXR - 8, 77, F1() 197: PUT2P EXR - 8, 99, F1() 198: ELSE 199: PUT2P EXR - 5, 80, F2() 200: PUT2P EXR - 5, 102, F2() 201: END IF 202: END IF 203: IF YD = 0 AND XD = 0 AND ET > 121 AND X <= 63 THEN 204: IF TOG = 0 THEN 'lasergun shots 205: LINE (X + 35, Y + 9)-(319, Y + 9), 9, , &HFF00 206: LINE (X + 35, Y + 9)-(319, Y + 9), 3, , &HCC00 207: LINE (X + 35, Y + 21)-(319, Y + 21), 9, , &HFF00 208: LINE (X + 35, Y + 21)-(319, Y + 21), 3, , &HCC00 209: ELSE 210: LINE (X + 35, Y + 9)-(319, Y + 9), 1, , &HFF 211: LINE (X + 35, Y + 9)-(319, Y + 9), 11, , &HCC 212: LINE (X + 35, Y + 21)-(319, Y + 21), 1, , &HFF 213: LINE (X + 35, Y + 21)-(319, Y + 21), 11, , &HCC 214: END IF 215: FOR I = 1 TO 5 '"puff" of damage 216: PSET (317 - FNR(10), FNR(18) + Y + 5), 15 217: NEXT 218: END IF 219: IF EX = 1 THEN 'random explosions 220: C = FNR(2) 221: IF C = 1 THEN C = 4 ELSE C = 12 222: a = FNR(30) + 299: B = FNR(50) + 75 223: CIRCLE (a, B), FNR(20) + 10, C 224: PAINT (a - 9, B), C 225: IF X > 62 THEN 226: EXR = EXR + 1: IF EXR > 330 THEN EXR = 330 227: END IF 228: END IF 229: IF EX = 2 THEN 'debris falling behind 230: FOR I = 1 TO 20 231: IF CX(I) > 0 THEN 232: PSET (CX(I), CY(I)), 15 233: CX(I) = CX(I) - CT(I) 234: IF CX(I) < 0 THEN CX(I) = 0 235: END IF 236: NEXT 237: END IF 238: IF X = 80 THEN 'large flame burst 239: CIRCLE (X - 5, Y + 20), 100, 15 240: PAINT (X - 5, Y + 20), 15 241: XD = 30: X = X + 1 242: END IF 243: IF ET < 20 THEN 'text 244: FONT "Coming soon...", 100, 95, 8, 0, 15, 0, 8 245: END IF 246: IF ET > 390 AND ET < 450 THEN 'text2 247: FONT "...to a computer near you...", 50, 95, 8, 0, 11, 0, 0 248: END IF 249: IF ET > 450 AND ET < 550 THEN 'text3 250: a$ = "* S T A R S H I P L E G E N D I I *" 251: FONT a$, 10, 85, 8, 0, 14, 0, 0 252: FONT "(don't miss it!)", 100, 100, 8, 0, 6, 0, 0 253: END IF 254: PCOPY 0, 1 'copy template to viewing screen 255: ET = ET + 1 'cycle timer (add delays if too fast) 256: IF ET = 30 THEN 'activate enemies 257: EX = 350: EY = 200: ED = 1: EXD = -23: EYD = -8 258: END IF 259: IF ED > 0 THEN 'enemy move parser 260: EX = EX + EXD: EY = EY + EYD 261: EXD = EXD + 1: IF EXD > 20 THEN EXD = 20 262: IF (EX MOD 2) = 0 THEN 263: 264: EYD = EYD + 1: IF EYD > 2 THEN EYD = 2 265: END IF 266: IF EXD > 1 AND (ET MOD 3) = 0 THEN 267: ED = ED + 1: IF ED > 3 THEN ED = 3 268: END IF 269: IF EX > 350 THEN ED = 0 270: END IF 271: IF ET = 120 THEN 'activate ship 272: X = 0: Y = 200: XD = 10: YD = -15: EX = 0: EXR = 340 273: END IF 274: IF ET > 121 THEN 'ship move parser 275: IF EX = 0 THEN 276: EXR = EXR - 1: IF EXR < 314 THEN EXR = 314 277: END IF 278: X = X + XD: Y = Y + YD 279: XD = XD - 1: IF XD < 0 THEN XD = 0 280: YD = YD + 1: IF YD > 0 THEN YD = 0 281: IF XD = 0 AND (ET MOD 7) = 0 THEN X = X + 1 282: END IF 283: IF X > 65 AND EX = 1 THEN 'explosion parser 284: EXR = 0 285: PALETTE 0, 15 286: EX = 2 287: FOR I = 1 TO 20 288: CX(I) = 319 + FNR(50): CY(I) = FNR(50) + 70 289: CT(I) = FNR(20) + 10 290: NEXT 291: PALETTE 0, 0 292: END IF 293: IF X > 60 AND EX = 0 THEN EX = 1 'switch expls 294: 295: 296: LOOP UNTIL INKEY$ <> "" OR ET > 570 'repeat 297: CLS : PCOPY 0, 1 'clear active page 298: END 299: 300: extX% = stepX%: extY% = stepY% 301: DEF SEG = &HFFA6 302: FOR I% = 1 TO LEN(a$) 303: addr% = 8 * ASC(MID$(a$, I%)) + 14 304: IF Background% THEN 305: IF Background% = 256 THEN BG% = FALSE ELSE BG% = Background% 306: 307: IF I% = LEN(a$) THEN extX% = FALSE: extY% = FALSE 308: LINE (X%, Y%)-(X% + 7 + extX%, Y% + 7 + extY%), BG%, BF 309: END IF 310: FOR j% = 0 TO 7 311: mask% = PEEK(addr% + j%) * 128 312: IF SHADOW% > 0 THEN 313: LINE (X% + 9, Y% + j% + 2)-(X% + 2, Y% + j% + 2), SHADOW%, , mask% 314: END IF 315: LINE (X% + 7, Y% + j%)-(X%, Y% + j%), CO%, , mask% 316: NEXT 317: X% = X% + extX% 318: Y% = Y% + extY% 319: NEXT 320: DEF SEG 321: 322: SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%) 323: 324: END SUB 325: 326: ' PUT2P - PUT Type II: 327: ' Clipping PUT routine. 328: ' 329: SUB PUT2P (X, Y, AR()) STATIC 330: IF X < 0 OR Y < 0 THEN EXIT SUB 'off screen 331: IF X + AR(0) < 320 AND Y + AR(1) < 200 THEN 332: PUT (X, Y), AR, PSET: EXIT SUB 333: END IF 'already on screen 334: IF X > (320 - AR(0)) THEN VL = 320 - X ELSE VL = AR(0) 335: IF VL < 1 THEN EXIT SUB 'no need 336: IF Y > (200 - AR(1)) THEN VL2 = 200 - Y ELSE VL2 = AR(1) 337: IF VL2 < 1 THEN EXIT SUB 'no need 338: SAR = AR(0): SAR1 = AR(1) 'hold copy 339: AR(0) = VL: AR(1) = VL2 340: PUT (X, Y), AR, PSET 'put modified array 341: AR(0) = SAR: AR(1) = SAR1 'restore altered bytes 342: END SUB 343: |