'=========================================================================== ' Subject: COMETS FALLING AND EXPLODING Date: 05-23-97 (00:00) ' Author: Lior Zur Code: QB, QBasic, PDS ' Origin: zur@inter.net.il Packet: GRAPHICS.ABC '=========================================================================== '+---------------+------------------------------+-----------+ '| Lior's Stars | Lior Zur | 23/5/1997 | '+---------------+------------------------------+-----------+ '| This is program is amazing: it shows comets falling of | '| the sky, and exploding on the ground. Try to change the | '| constants for great effects. My favorite is to change | '| NumLeft to 50. Or change WindPower to 0, also nice | '| effect of raining. If you don't know what to change and | '| how much, I've added examples with explanations. | '+----------------------------------------------------------+ '| For more excellent QB graphic demos, stuff and goodies | '| please visit my homepage at: | '| | '| http://www.geocities.com/SiliconValley/Heights/9246 | '+----------------------------------------------------------+--+ '| !!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT: !!!!!!!!!!!!!!!!!!!!!!! | '| | '| You can publish this file anywhere, as long as you haven't | '| made any change in this file. If you use any of this code | '| in your own program, please make sure to give me a credit. | '| Also: I don't allow to publish this file on a CD without | '| my permission. | '+-------------------------------------------------------------+ DECLARE SUB NewLeft (num!) DECLARE FUNCTION INT1! (number AS SINGLE) DECLARE SUB DrawPart (action, num) DECLARE SUB CreateNew (num) '---------------------------------------------------- ' change the following arguments for diffrent effect: '---------------------------------------------------- '================================== 'these are to do with the little stars that remain when the main 'comet has crashed into the ground: '================================== CONST ExLevels = 50'Explosion levels: the bigger, the longer each explosion(50) ' TRY THIS: change to 200, and change Pulse to 0.04 CONST Grav = .2 'gravitation to pull leftovers to the ground...(0.2) ' TRY THIS: change to 6 for interesting effect CONST Pulse = .025 'energy pulse for leftovers when the comet hit.(0.02) ' TRY THIS: change to .06 for interesting effect CONST FloorJump = 1 'will the leftovers jump on the floor? 0-no 1-yes ' TRY THIS: change to 0... CONST LWind = .01 'what's the wind for leftovers? (0.01) ' TRY THIS: change to .07 to see explosives all over the ' screen! CONST NumLeft = 20 'number of leftovers. put here 10 for greater speed.(20) ' TRY THIS: change to 40 or 50 for bigger collisions! ' * Changing this to 50 is my favorite! do it now! '================================== 'these are to do with the main comets: '================================== CONST WindPower = .1 'wind power (can be negetive too.)(0.1) 'TRY THIS: change to -.3 for larger and stronger ' comets! 'OR: change to 0, for raining effect!!! CONST JumpWalls = 0 'if you wanna the comets to jump from the walls, 'change to 1. it's good only in strong wind. CONST NumParts = 70 'number of comets(70) 'TRY THIS: if demo speed is too slow, dicrease. 'you'de better not mess with the following: CONST StartCols = 23 'start of comets colors. better not change...(23) 'TRY THIS: change to 78 or 63 for rainbow effect CONST NumCols = 8 'don't change this! number of colors effect speed. '---------------------------------------------------- CLS SCREEN 13 CLEAR RANDOMIZE TIMER TYPE LeftOver x AS SINGLE y AS SINGLE Col AS INTEGER wind AS SINGLE d AS SINGLE END TYPE TYPE CometType active AS INTEGER level AS INTEGER lx1 AS SINGLE ly1 AS SINGLE lx2 AS SINGLE ly2 AS SINGLE lx3 AS SINGLE ly3 AS SINGLE lx4 AS SINGLE ly4 AS SINGLE lx5 AS SINGLE ly5 AS SINGLE lx6 AS SINGLE ly6 AS SINGLE lx7 AS SINGLE ly7 AS SINGLE swind AS SINGLE wind AS SINGLE x AS SINGLE y AS SINGLE Col AS INTEGER power AS SINGLE loops AS INTEGER END TYPE DIM SHARED s(NumParts) AS CometType DIM SHARED l(NumParts * NumLeft + NumLeft) AS LeftOver FOR i = 1 TO NumParts CreateNew i NEXT i DO FOR i = 1 TO NumParts s(i).loops = s(i).loops + 1 StartLoop: IF s(i).loops >= s(i).power THEN IF s(i).active = 0 THEN FOR nn = i * NumLeft TO i * NumLeft + NumLeft PSET (l(nn).x, l(nn).y), 0 NEXT nn s(i).level = s(i).level + 1 IF s(i).level = ExLevels THEN CreateNew i s(i).y = 0 s(i).ly7 = 0 s(i).ly6 = 0 s(i).ly5 = 0 s(i).ly4 = 0 s(i).ly3 = 0 s(i).ly2 = 0 s(i).ly1 = 0 GOTO StartLoop END IF FOR nn = i * NumLeft TO i * NumLeft + NumLeft l(nn).d = l(nn).d + Grav l(nn).x = l(nn).x + l(nn).wind l(nn).y = l(nn).y + l(nn).d IF FloorJump THEN IF l(nn).y > 199 THEN l(nn).y = 199: l(nn).d = -l(nn).d PSET (l(nn).x, l(nn).y), l(nn).Col gg = INT(RND * 2) + 1 IF gg = 1 THEN IF l(nn).Col > 20 THEN l(nn).Col = l(nn).Col - 1 NEXT nn END IF 'active 0 IF s(i).active = 1 THEN DrawPart 0, i s(i).loops = -1 s(i).y = s(i).y + 1 IF s(i).y > 199 THEN s(i).active = 0 NewLeft (i) GOTO StartLoop END IF s(i).x = s(i).x + s(i).wind IF s(i).x > 319 THEN IF JumpWalls = 0 THEN s(i).lx7 = 0 s(i).lx6 = 0 s(i).lx5 = 0 s(i).lx4 = 0 s(i).lx3 = 0 s(i).lx2 = 0 s(i).lx1 = 0 s(i).x = 0 ELSE s(i).wind = -s(i).wind END IF END IF IF s(i).x < 0 THEN IF JumpWalls = 0 THEN s(i).lx7 = 319 s(i).lx6 = 319 s(i).lx5 = 319 s(i).lx4 = 319 s(i).lx3 = 319 s(i).lx2 = 319 s(i).lx1 = 319 s(i).x = 319 ELSE s(i).wind = -s(i).wind END IF END IF s(i).lx7 = s(i).lx6 s(i).lx6 = s(i).lx5 s(i).lx5 = s(i).lx4 s(i).lx4 = s(i).lx3 s(i).lx3 = s(i).lx2 s(i).lx2 = s(i).lx1 s(i).lx1 = s(i).x s(i).ly7 = s(i).ly6 s(i).ly6 = s(i).ly5 s(i).ly5 = s(i).ly4 s(i).ly4 = s(i).ly3 s(i).ly3 = s(i).ly2 s(i).ly2 = s(i).ly1 s(i).ly1 = s(i).y DrawPart 1, i END IF 'active END IF 'star's turn NEXT i LOOP UNTIL INKEY$ <> "" SUB CreateNew (num) RANDOMIZE TIMER s(num).active = 1 s(num).level = 0 s(num).wind = (INT(RND * 13) + 7) * WindPower s(num).swind = s(num).wind s(num).loops = -1 s(num).Col = INT(RND * NumCols) + StartCols + 1 s(num).power = NumCols + 1 - (s(num).Col - StartCols) s(num).y = INT(RND * 200) s(num).x = INT(RND * 320) s(num).lx7 = s(num).x s(num).lx6 = s(num).x s(num).lx5 = s(num).x s(num).lx4 = s(num).x s(num).lx3 = s(num).x s(num).lx2 = s(num).x s(num).lx1 = s(num).x s(num).ly7 = s(num).y s(num).ly6 = s(num).y s(num).ly5 = s(num).y s(num).ly4 = s(num).y s(num).ly3 = s(num).y s(num).ly2 = s(num).y s(num).ly1 = s(num).y END SUB SUB DrawPart (action, num) SELECT CASE action CASE 0 'erase PSET (s(num).x, s(num).y), 0 LINE -(s(num).lx1, s(num).ly1), 0 LINE -(s(num).lx2, s(num).ly2), 0 LINE -(s(num).lx3, s(num).ly3), 0 LINE -(s(num).lx4, s(num).ly4), 0 LINE -(s(num).lx5, s(num).ly5), 0 LINE -(s(num).lx6, s(num).ly6), 0 LINE -(s(num).lx7, s(num).ly7), 0 CASE 1 'draw PSET (s(num).x, s(num).y), s(num).Col LINE -(s(num).lx1, s(num).ly1), s(num).Col - 1 LINE -(s(num).lx2, s(num).ly2), s(num).Col - 2 LINE -(s(num).lx3, s(num).ly3), s(num).Col - 3 LINE -(s(num).lx4, s(num).ly4), s(num).Col - 4 LINE -(s(num).lx5, s(num).ly5), s(num).Col - 5 LINE -(s(num).lx6, s(num).ly6), s(num).Col - 6 LINE -(s(num).lx7, s(num).ly7), s(num).Col - 6 PSET (s(num).x, s(num).y), s(num).Col END SELECT END SUB FUNCTION INT1 (number AS SINGLE) she = number - INT(number) IF she >= .5 THEN sh = 1 ELSE sh = 0 INT1 = INT(number) + sh END FUNCTION SUB NewLeft (num) FOR ii = 1 TO NumLeft l(num * NumLeft + ii).Col = s(num).Col l(num * NumLeft + ii).d = -(INT(RND * 100)) * Pulse l(num * NumLeft + ii).wind = INT(RND * 100) * LWind gg = INT(RND * 2) + 1 IF gg = 1 THEN l(num * NumLeft + ii).wind = -l(num * NumLeft + ii).wind gg = INT(RND * 10) + 1 IF gg > 2 THEN l(num * NumLeft + ii).wind = l(num * NumLeft + ii).wind - s(num).wind * 1.5 l(num * NumLeft + ii).x = s(num).x l(num * NumLeft + ii).y = s(num).y '- 70 NEXT ii END SUB