Seamless Fog Generator (Source Included)

BlitzMax Forums/BlitzMax Programming/Seamless Fog Generator (Source Included)

dw817 (Posted 2016) [#1]

Years ago my Dad received a magazine that showed games and RPGs you could purchase for the commodore Amiga, which is the computer we had at the time. I remember looking over many screen shots and seeing that wood, marble, and other types of backgrounds were very popular for borders and fields that displayd messages. With a good deal of experimentation I managed to generate a program of sorts that used 4-colors to create an effect of appearing either as wood, marble, or smoke. Today, my brain can't really reach that far back but looking over some old QBasic code, I saw a program w no author listed as "EALAVA" that created a smeared effect and animated the background palette to make it look a bit like an amoeba or moving metal. I took that a step further, cut down on the blurriness, and made it so it would link from any side. So - what you have is a nice fog generator that builds an image that is seamless. That is, you can place a copy of it above, below, or to the sides and you cannot tell where the 'seams' in it begin. Useful for special effects in games, and of course if you don't want to take the time to create a new fog each run you can simply save off the image it generates and then use just that in your own game code when you want to have fog or mist in it. Enjoi ! ' _____________________________________ ' // // ' // Seamless Fog Generator // ' // Version, "Smoothing The Chaos" // ' // Written by David W - 02/24/16 // '//__________________________________// Strict SeedRnd MilliSecs() ' ensure random results each time Global foggx=512,foggy=512 ' size of fog to generate ' don't choose too small or it'll crash ! SetGraphicsDriver GLMax2DDriver(),0 ' zero forces front buffer Graphics 1024,768 Local i,j,k,m,n,c,x,y,s Global pic:TPixmap=CreatePixmap(foggx,foggy,pf_i8) ClearPixels pic Global img:TImage For i=0 Until foggy For j=0 Until foggx If fnr(3)=0 Then pst j,i,fnr(256) ' plot a random bright dot 33% of the time Next Next For i=9 To 1 Step -2 ' IMPORTANT ! You must scan large to small s=i/2+1 ' size of square to scan For j=0 To foggy For k=0 To foggx c=(pnt(k-i,j-i)+pnt(k,j-i)+pnt(k+i,j-i)+pnt(k-i,j)+pnt(k+i,j)+pnt(k-i,j+i)+pnt(k,j+i)+pnt(k+i,j+i))/8 ' ^ Get totals from all 8 areas outside pixel For m=-s To s For n=-s To s pst k+n,j+m,c ' since it's a pixmap, this is our draw square routine Next Next k:+i ' equivalent to STEP but you can't step a variable Next j:+i ' same here Next Next img=LoadImage(pic) ' make it an image so it can be tinted and tiled SetColor 192,128,255 ' violet-blue Repeat ' {* MAIN *} TileImage img,x,y ' tile it on screen, doesn't matter the size x:-2 ; y:-1 ' scroll it around so you can see it's seamless Flip 0 ' show our work Delay 10 ' bit of delay Until KeyDown(27) ' ESCAPE key exits ' {* END OF MAIN *} ' >> SIMPLE READ PIXEL, IF OUT OF BOUNDS THEN WRAP Function pnt(x,y) x=wrap(x,0,foggx) ; y=wrap(y,0,foggy) Return pic.pixels[x+y*foggx] EndFunction ' >> SIMPLE PLOT I8 (1-byte per pixel), IF OUT OF BOUNDS THEN WRAP Function pst(x,y,c) x=wrap(x,0,foggx) ; y=wrap(y,0,foggy) pic.pixels[x+y*foggx]=c EndFunction ' >> RETURN RANDOM NUMBER FROM 0 TO A-1 Function fnr(a) Return Rand(a)-1 EndFunction ' >> WRAP NUMBERS AROUND NO MATTER HOW BIG Function wrap(a,b,c) Local ok,n Repeat ok=1 If a<b Then a=a+c-b+1 ; ok=0 If a>c Then a=a-c+b-1 ; ok=0 n:+1 Until ok=1 Or n>1000 ' also exit if taking too long Return a EndFunction Here is the QBasic source code, I cleaned up the margins a bit: '*** DECLARE SUB NewColor () COMMON SHARED Color1, Color2, Color3, Color4, Color5, Color6, Color7, Color8 DECLARE SUB Pal (PN!, I!, C1!, C2!) DECLARE SUB MakePal () DECLARE SUB Ropal () SCREEN 13 RANDOMIZE TIMER NewColor DIM SHARED P(224, 7) FOR X = 1 TO 320 STEP 1 FOR Y = 1 TO 200 STEP 1 IF INT(RND * 5) + 1 = 1 THEN PSET (X, Y), INT(RND * 224) + 1 NEXT Y NEXT X FOR Sx = 4 TO 1 STEP -1 Z = INT(Sx / 2) FOR X = 1 TO 320 STEP Sx FOR Y = 1 TO 200 STEP Sx Redo: D1 = POINT(X - Sx, Y - Sx) + INT(RND * 2) + 1 D2 = POINT(X - Sx, Y) + INT(RND * 2) + 1 D3 = POINT(X + Sx, Y) + INT(RND * 2) + 1 D4 = POINT(X, Y - Sx) + INT(RND * 2) + 1 D5 = POINT(X + Sx, Y - Sx) + INT(RND * 2) + 1 D6 = POINT(X - Sx, Y - Sx) + INT(RND * 2) + 1 D7 = POINT(X - Sx, Y + Sx) + INT(RND * 2) + 1 D8 = POINT(X + Sx, Y + Sx) + INT(RND * 2) + 1 C = (D1 + D2 + D3 + D4 + D5 + D6 + D7 + D8) / 8 IF C < 1 THEN GOTO Redo LINE (X - Z, Y - Z)-(X + Z, Y + Z), C, BF NEXT Y NEXT X NEXT Sx Skip: DO IF INKEY$ = CHR$(13) THEN NewColor IF INKEY$ = CHR$(27) THEN EXIT DO Ropal LOOP SUB MakePal STATIC FOR X = 1 TO 28 Pal X, X * 2, Color2, Color1 P(X, 1) = INT(X * 2.25) P(X, 2) = Color2 P(X, 3) = Color1 NEXT X FOR X = 29 TO 56 Pal X, (X - 28) * 2, Color3, Color2 P(X, 1) = INT((X - 28) * 2.25) P(X, 2) = Color3 P(X, 3) = Color2 NEXT X FOR X = 57 TO 84 Pal X, (X - 56) * 2, Color4, Color3 P(X, 1) = INT((X - 56) * 2.25) P(X, 2) = Color4 P(X, 3) = Color3 NEXT X FOR X = 85 TO 112 Pal X, (X - 84) * 2, Color5, Color4 P(X, 1) = INT((X - 84) * 2.25) P(X, 2) = Color5 P(X, 3) = Color4 NEXT X FOR X = 113 TO 140 Pal X, (X - 112) * 2, Color6, Color5 P(X, 1) = INT((X - 112) * 2.25) P(X, 2) = Color6 P(X, 3) = Color5 NEXT X FOR X = 141 TO 168 Pal X, (X - 140) * 2, Color7, Color6 P(X, 1) = INT((X - 140) * 2.25) P(X, 2) = Color7 P(X, 3) = Color6 NEXT X FOR X = 169 TO 196 Pal X, (X - 168) * 2, Color8, Color7 P(X, 1) = INT((X - 168) * 2.25) P(X, 2) = Color8 P(X, 3) = Color7 NEXT X FOR X = 197 TO 224 Pal X, (X - 196) * 2, Color1, Color8 P(X, 1) = INT((X - 196) * 2.25) P(X, 2) = Color1 P(X, 3) = Color8 NEXT X '28,56,84,112,140,168,196,224,252 END SUB SUB NewColor STATIC Color1 = INT(RND * 8) + 1 Color2 = INT(RND * 8) + 1 Color3 = INT(RND * 8) + 1 Color4 = INT(RND * 8) + 1 Color5 = INT(RND * 8) + 1 Color6 = INT(RND * 8) + 1 Color7 = INT(RND * 8) + 1 Color8 = INT(RND * 8) + 1 MakePal END SUB SUB Pal (PN, I, C1, C2) STATIC Ri = 0 Gi = 0 Bi = 0 IF C1 = 1 THEN Bi = Bi + I IF C1 = 2 THEN Gi = Gi + I IF C1 = 3 THEN Bi = Bi + I: Gi = Gi + I IF C1 = 4 THEN Ri = Ri + I IF C1 = 5 THEN Bi = Bi + I: Ri = Ri + I IF C1 = 6 THEN Ri = Ri + I: Gi = Gi + I IF C1 = 7 THEN Ri = Ri + I: Gi = Gi + I: Bi = Bi + I IF C2 = 1 THEN Bi = Bi + 63 - I IF C2 = 2 THEN Gi = Gi + 63 - I IF C2 = 3 THEN Bi = Bi + 63 - I: Gi = Gi + 63 - I IF C2 = 4 THEN Ri = Ri + 63 - I IF C2 = 5 THEN Bi = Bi + 63 - I: Ri = Ri + 63 - I IF C2 = 6 THEN Ri = Ri + 63 - I: Gi = Gi + 63 - I IF C2 = 7 THEN Ri = Ri + 63 - I: Gi = Gi + 63 - I: Bi = Bi + 63 - I IF Ri > 63 THEN Ri = 63 IF Gi > 63 THEN Gi = 63 IF Gi > 63 THEN Bi = 63 OUT 968, PN OUT 969, Ri OUT 969, Gi OUT 969, Bi END SUB SUB Ropal STATIC D1 = P(1, 1) D2 = P(1, 2) D3 = P(1, 3) FOR A = 2 TO 224 SWAP P(A, 1), P(A - 1, 1) SWAP P(A, 2), P(A - 1, 2) SWAP P(A, 3), P(A - 1, 3) NEXT A P(224, 1) = D1 P(224, 2) = D2 P(224, 3) = D3 FOR A = 1 TO 224 Pal A, P(A, 1), P(A, 2), P(A, 3) NEXT A END SUB SUB TestPal STATIC FOR X = 1 TO 224 FOR Y = 1 TO 200 PSET (X, Y), X NEXT Y NEXT X END SUB

dw817 (Posted 2016) [#2]

Can't seem to edit the message above. Someone mentioned something about BlitzMAX forums having problems w this sometimes. Anyways, here is update I wanted to add: ' __________________________________ ' // // ' // Seamless Fog Generator // ' // Version, "Pixel Perfect" // ' // Written by David W - 02/24/16 // '//_______________________________// ' Using a method from EALAVA written in QBasic ' author unknown. ' ' What's up ?? ' made a few number changes, fixed some numeric errors, ' better range, less drawing overall. ' Added a few lines so you curious lot can see the building ' process of the fog. Strict SeedRnd MilliSecs() ' ensure random results each time Global foggx=512,foggy=512 ' size of fog to generate ' don't choose too small or it'll crash ! SetGraphicsDriver GLMax2DDriver(),0 ' zero forces front buffer Graphics 1024,768 Local i,j,k,m,n,c,x,y,s Global pic:TPixmap=CreatePixmap(foggx,foggy,pf_i8) ClearPixels pic Global img:TImage For i=0 Until foggy For j=0 Until foggx If fnr(2)=0 Then pst j,i,fnr(256) ' plot a random bright dot 50% of the time Next Next For i=7 To 1 Step -2 ' IMPORTANT ! You must scan large to small s=i/2+1 ' size of square to scan DrawPixmap pic,0,0 Flip 0 WaitKey For j=0 To foggy+i For k=0 To foggx+i c=(pnt(k-i,j-i)+pnt(k,j-i)+pnt(k+i,j-i)+pnt(k-i,j)+pnt(k+i,j)+pnt(k-i,j+i)+pnt(k,j+i)+pnt(k+i,j+i))/8 ' ^ Get totals from all 8 areas outside pixel For m=-s+1 To s For n=-s+1 To s pst k+n,j+m,c ' since it's a pixmap, this is our draw square routine Next Next k:+i ' equivalent to STEP but you can't step a variable Next j:+i ' same here Next Next DrawPixmap pic,0,0 Flip 0 WaitKey img=LoadImage(pic) ' make it an image so it can be tinted and tiled SetColor 192,128,255 ' violet-blue Repeat ' {* MAIN *} TileImage img,x,y ' tile it on screen, doesn't matter the size x:-2 ; y:-1 ' scroll it around so you can see it's seamless Flip 0 ' show our work Delay 10 ' bit of delay Until KeyDown(27) ' ESCAPE key exits ' {* END OF MAIN *} ' >> SIMPLE READ PIXEL, IF OUT OF BOUNDS THEN WRAP Function pnt(x,y) x=wrap(x,0,foggx-1) ; y=wrap(y,0,foggy-1) Return pic.pixels[x+y*foggx] EndFunction ' >> SIMPLE PLOT I8 (1-byte per pixel), IF OUT OF BOUNDS THEN WRAP Function pst(x,y,c) x=wrap(x,0,foggx-1) ; y=wrap(y,0,foggy-1) pic.pixels[x+y*foggx]=c EndFunction ' >> RETURN RANDOM NUMBER FROM 0 TO A-1 Function fnr(a) Return Rand(a)-1 EndFunction ' >> WRAP NUMBERS AROUND NO MATTER HOW BIG Function wrap(a,b,c) Local ok,n Repeat ok=1 If a<b Then a=a+c-b+1 ; ok=0 If a>c Then a=a-c+b-1 ; ok=0 n:+1 Until ok=1 Or n>1000 ' also exit if taking too long Return a EndFunction

AdamStrange (Posted 2016) [#3]

nice to see it being constructed needed to have the setgraphicsdriver removed for a mac though

dw817 (Posted 2016) [#4]

Hi Adam. Glad you like it. And yes, I don't know what drivers are needed for Macintosh. Adjust the code so it works for you. :)