Help improve explosions...?

Blitz3D Forums/Blitz3D Beginners Area/Help improve explosions...?

BlackJumper (Posted 2004) [#1]

I was messing with an idea for generating explosions and it gave me a chance to try generating all resources in code (textures and meshes.) I came up with the following... ; Ruggedised sphere explosion ; BlackJumper Dec 2004 ; ; ; LeftMouse to destroy targets, RightMouse to Escape ; ; AppTitle "'Jiggly Hunt' by BlackJumper" ;------------------------------------------------------------------------------------------------------------------- ; .....Incorporating elements of .... Perlin Noise Heightmap Generator - Copyright 2003 - Shawn C. Swift ;.................................... Asteroid Maker - Rob Farley ; ------------------------------------------------------------------------------------------------------------------- ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Const MAX_HEIGHTMAP_SIZE = 1024 Dim HeightMap#(MAX_HEIGHTMAP_SIZE, MAX_HEIGHTMAP_SIZE) Dim NoiseMap#(MAX_HEIGHTMAP_SIZE+1, MAX_HEIGHTMAP_SIZE+1) Global mincolour = 0 Global maxcolour = 0 ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;------------------------------------------------------------------------------------------------ .Main_Game_Code Graphics3D 640,480,32 Global clouds = GenerateColourTerrain(90,255,100,0,128) Global blast = GenerateColourTerrain(70,255,255,0,128) Global marble = GenerateColourTerrain(5) Global dust = GenerateColourTerrain(150,255,255,255) Global divsoffset = 0 Const STATECREATED = 0 Const STATEEXPAND = 1 Const STATEFADE = 2 Const STATESPENT = 3 Global growth#=0.08 Global FlashDecay = 0 light = CreateLight(2):PositionEntity light,1000,1000,-500 Global camera = CreateCamera():PositionEntity camera,0,0,-20 Type block Field theblock End Type Repeat For n = 1 To 20 ablock.block = New block ablock\theblock = CreateCube() EntityTexture ablock\theblock, marble EntityAlpha ablock\theblock, 0.9 PositionEntity ablock\theblock, 0,0,0;Rnd(10)-5, Rnd(10)-5, Rnd(10)-5 EntityPickMode ablock\theblock, 2 Next maxframe = 0 While First block <> Last block old = MilliSecs() If MouseHit(1) Then CheckPicked() If FlashDecay > 0 Then SetGammaIntensity(FlashDecay*5) FlashDecay = FlashDecay-1 EndIf If KeyHit(1) Goto EscapeGame If MouseHit(2) Goto EscapeGame For move.block = Each block If Abs(EntityX(move\theblock))>10 Or Abs(EntityY(move\theblock))>10 Or Abs(EntityZ(move\theblock))>10 Then PositionEntity move\theblock, 0,0,0;Rnd(10)-5, Rnd(10)-5, Rnd(10)-5 Else MoveEntity move\theblock, Rnd(1)-0.5,Rnd(1)-0.5,Rnd(1)-0.5 EndIf Next UpdateCloud() RenderWorld Text MouseX(), MouseY(), "X",1,1 rendertime = MilliSecs()-old If rendertime > maxframe Then maxframe = rendertime Text 0,0, "frametime = " + rendertime + " .... max frametime = " + maxframe Flip Wend .EscapeGame ;WaitKey Until MouseDown(2) ;------------------------------------------------------------------------------------ Function CheckPicked() xmouse = MouseX() ymouse = MouseY() chosen = CameraPick(camera, xmouse, ymouse) If chosen <> 0 Then For possible.block = Each block If possible\theblock = chosen Then FlashDecay = 20 CreateCloud(4, EntityX(possible\theblock), EntityY(possible\theblock), EntityZ(possible\theblock)) FreeEntity possible\theblock Delete possible EndIf Next EndIf End Function ;------------------------------------------------------------------------------------ Function SetGammaIntensity( n ) For k=0 To 255 SetGamma k,k,k,k+n,k+n,k+n Next UpdateGamma End Function ;===================================================================================== Function CreateCloud(children,x#=0,y#=0,z#=0) aCloud.cloud = New cloud Select children Case 0 aCloud\theMesh = CreateSphere(12) RuggediseMesh(aCloud\theMesh, 1) ; EntityFX aCloud\theMesh, 32 EntityTexture aCloud\theMesh, dust aCloud\theChildren = -1 Case 4 aCloud.cloud = New cloud aCloud\theMesh = CreateSphere(8) ; EntityFX aCloud\theMesh, 32 ScaleMesh aCloud\theMesh, 1.3,1.3,1.3 EntityTexture aCloud\theMesh, blast aCloud\theChildren = children-1 Default aCloud.cloud = New cloud aCloud\theMesh = CreateSphere(8) ; EntityFX aCloud\theMesh, 32 EntityTexture aCloud\theMesh,clouds RuggediseMesh(aCloud\theMesh, 1) aCloud\theChildren = children-1 End Select PositionEntity aCloud\theMesh, x, y, z aCloud\theRadius = 1 aCloud\theDecay = 50 aCloud\theState = STATEEXPAND EntityAlpha aCloud\theMesh, 0.5 EntityFX aCloud\theMesh, 32 End Function ;------------------------------------------------------------------------------------- Function UpdateCloud() For checkCloud.cloud = Each cloud If checkCloud\theState = STATEFADE Then ScaleEntity checkCloud\theMesh, checkCloud\theRadius, checkCloud\theRadius, checkCloud\theRadius checkCloud\theRadius = checkCloud\theRadius + growth checkCloud\theDecay = checkCloud\theDecay - 1 EntityAlpha checkCloud\theMesh, checkCloud\theDecay/100.0 If checkCloud\theDecay = 0 Then checkCloud\theState = STATESPENT EndIf If checkCloud\theChildren = -1 Then RuggediseMesh(checkCloud\theMesh, (checkCloud\theDecay Mod 5)+1, 0.03) EndIf EndIf If checkCloud\theState = STATEEXPAND Then ScaleEntity checkCloud\theMesh, checkCloud\theRadius, checkCloud\theRadius, checkCloud\theRadius EntityAlpha checkCloud\theMesh, (checkCloud\theDecay+20)/100.0 checkCloud\theRadius = checkCloud\theRadius + growth checkCloud\theDecay = checkCloud\theDecay - 1 If checkCloud\theDecay = 38 And checkCloud\theChildren > -1 Then CreateCloud(checkCloud\theChildren,EntityX(checkCloud\theMesh), EntityY(checkCloud\theMesh), EntityZ(checkCloud\theMesh)) EndIf If checkCloud\theDecay = 0 Then checkCloud\theState = STATEFADE checkCloud\theDecay = 20 EndIf EndIf If checkCloud\theState = STATESPENT Then FreeEntity checkcloud\theMesh Delete checkCloud EndIf Next End Function ;===================================================================================== Function BoomCloud() FlushKeys checkCloud.cloud = First cloud If checkCloud <> Null Then If checkCloud\theState = STATECREATED Then checkCloud\theState = STATEEXPAND EndIf EndIf End Function ;===================================================================================== Function RuggediseMesh(themesh, thedivs, ruggedness#=0.1) itsSurf=GetSurface(themesh,1) For n=0 To CountVertices(itsSurf)-1 x_jiggle#= Rnd(-ruggedness,ruggedness) y_jiggle#= Rnd(-ruggedness,ruggedness) z_jiggle#= Rnd(-ruggedness,ruggedness) If (n+divsoffset) Mod (thedivs)=0 Then VertexCoords itsSurf,n,VertexX(itsSurf,n)+x_jiggle,VertexY(itsSurf,n)+y_jiggle,VertexZ(itsSurf,n)+z_jiggle ;VertexColor itsSurf, n, VertexRed(itsSurf, n)- children*20, VertexGreen(itsSurf, n)- children*20, VertexBlue(itsSurf, n)- children*20 EndIf Next divsoffset = divsoffset+1 End Function ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Type cloud Field theMesh Field theRadius# Field theState Field theDecay Field theChildren End Type ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;==================================================================================================================== Function GenerateColourTerrain( theholes=10, thered=64, thegreen=64, theblue=64,size=128 ) SeedRnd MilliSecs() HeightMapSize = size ; Set the size of the heightmap we want to generate. Generate_Heightmap(HeightMapSize, 0.25, 2) ; Generate the heightmap. DestImage = CreateTexture(HeightMapSize, HeightMapSize, 3) ; Create an image. SetBuffer TextureBuffer(DestImage) LockBuffer(DestBuffer) ; Write the data to the image. For LoopY = 0 To HeightMapSize-1 For LoopX = 0 To HeightMapSize-1 Pr = HeightMap#(LoopX, LoopY) ; Calculate the color for this pixel. If Pr < mincolour Then mincolour = Pr If Pr > maxcolour Then maxcolour = Pr NewPixel = Pb Or (Pg Shl 8) Or (Pr Shl 16) Or ($ff000000) ; Convert the color into a 'grey' longint. WritePixel LoopX, LoopY, NewPixel, DestBuffer ; Store the pixel in the image. Next Next scale# = 255.0/(maxcolour - mincolour) redscale# = thered/255.0 bluescale# = theblue/255.0 greenscale# = thegreen/255.0 For LoopY = 0 To HeightMapSize-1 For LoopX = 0 To HeightMapSize-1 Pbase = HeightMap#(LoopX, LoopY)*scale# Pr = Int(Pbase*redscale) - theholes;+thered If Pr < 0 Then Pr = 0 Pg = Int(Pbase*greenscale) - theholes If Pg < 0 Then Pg = 0 Pb = (Pbase*bluescale) - theholes If Pb < 0 Then Pb = 0 NewPixel = Pb Or (Pg Shl 8) Or ((Pr) Shl 16) Or ($ff000000) WritePixel LoopX, LoopY, NewPixel, DestBuffer Next Next UnlockBuffer(DestBuffer) SetBuffer BackBuffer() Return DestImage End Function ; ------------------------------------------------------------------------------------------------------------------- ; Perlin Noise Heightmap Generator - Copyright 2003 - Shawn C. Swift (Public Domain) ; HeightmapSize must ba a power of 2. ; Scale# is the maximum height of the most frequent and smallest bumps in the terrain. ; Multiplier# is how much each successive pass multiplies scale# by. ; ------------------------------------------------------------------------------------------------------------------- Function Generate_Heightmap(HeightMapSize, Scale#, Multiplier#) Max_Height# = Scale# ; Set the maximum height of the first noise pass. For Noise_Y = 0 To HeightMapSize ; Do the first pass seprately from the other passes since we can do it very cheaply. For Noise_X = 0 To HeightMapSize HeightMap#(Noise_X, Noise_Y) = Rnd#(0, Max_Height#) Next Next NoiseMapSize = HeightMapSize/2 ; Now start with the second highest frequency noise; ; The second largest noise map with slightly larger bumps than the first pass. Max_Height# = Max_Height# * Multiplier# ; Multiply the maximum height for the start of the second pass. Repeat For Noise_Y = 0 To NoiseMapSize ; Generate a noise map. For Noise_X = 0 To NoiseMapSize NoiseMap#(Noise_X, Noise_Y) = Rnd#(0, Max_Height#) Next Next ScaleDifference = HeightMapSize / NoiseMapSize ; Calculate the diffrence in scale between the noisemap and the heightmap. StepSize# = 1.0 / Float(ScaleDifference) ; Calculate how large of steps across the noise map we need to take for each pixel of the heightmap. For Noise_Y = 0 To NoiseMapSize-1 ; Stretch the noise map over the heightmap using bilinear filtering. For Noise_X = 0 To NoiseMapSize-1 N1# = NoiseMap#(Noise_X, Noise_Y) N2# = NoiseMap#(Noise_X+1, Noise_Y) N3# = NoiseMap#(Noise_X, Noise_Y+1) N4# = NoiseMap#(Noise_X+1, Noise_Y+1) Hx = Noise_X*ScaleDifference Hy = Noise_Y*ScaleDifference Iy# = 0 For Height_Y = 0 To ScaleDifference-1 ICy# = 1.0 - ((Cos(Iy#*180.0) + 1.0) / 2.0) ; Calculate cosine-weighted bilinear average. Ix# = 0 For Height_X = 0 To ScaleDifference-1 ICx# = 1.0 - ((Cos(Ix#*180.0) + 1.0) / 2.0) ; Calculate cosine-weighted bilinear average. Na# = N1#*(1.0-ICx#) Nb# = N2#*ICx# Nc# = N3#*(1.0-ICx#) Nd# = N4#*ICx# HeightMap#(Hx+Height_X, Hy+Height_Y) = HeightMap#(Hx+Height_X, Hy+Height_Y) + (Na#+Nb#)*(1.0-ICy#) + (Nc+Nd#)*ICy# Ix# = Ix# + StepSize# Next Iy# = Iy# + StepSize# Next Next Next NoiseMapSize = NoiseMapSize/2 ; Reduce the frequency of the noise by half. Max_Height# = Max_Height# * Multiplier# ; Increase the maximum height of the noise. Until NoiseMapSize <= 1 End Function ;========================================================================================================================= ... which was not really what i had hoped it might be. Does anyone have any suggestions on how to improve it, or should I really be looking at single surface particle systems with lots of spawned particles ???

Ross C (Posted 2004) [#2]

Particles are always cool for making explosions looking cool. Different types of particles, debris, fire, smoke..etc all mixed together :o)