### Author Topic: fire routine  (Read 2450 times)

#### phaelax

• Mc. Print
• Posts: 36
##### fire routine
« on: 2010-Sep-08 »
My first GL program, a cool yet slow fire routine using a simple method I read about long ago.

Code: (glbasic) [Select]
`// --------------------------------- //// Project: untitled// Start: Wednesday, December 31, 1969// IDE Version: 8.078// c = (a*16777216)+(b*65536)+(g*256)+rSETSCREEN 640, 480, 0GLOBAL flame = 4.14GLOBAL fire[]DIM fire[320][240]LOCAL rREPEAT FOR y = 0 TO 239 FOR x = 0 TO 319 fire[x][y] = newValue(x, y) SETPIXEL x, y, fire[x][y] NEXT NEXT FOR x = 0 TO 319 r = RND(255) fire[x][238] = RGB(r,0,r) SETPIXEL x, 238, fire[x][238] NEXT SHOWSCREENUNTIL KEY(28) = 1ENDFUNCTION newValue:x, y LOCAL r,g,b,c,c1,c2,c3,c4,r1,g1,b1,r2,g2,b2,r3,g3,b3,r4,g4,b4 c1 = getColor(x, y+1) r1 = GetRValue(c1) g1 = GetGValue(c1) b1 = GetBValue(c1) c2 = getColor(x-1, y+1) r2 = GetRValue(c2) g2 = GetGValue(c2) b2 = GetBValue(c2) c3 = getColor(x+1, y+1) r3 = GetRValue(c3) g3 = GetGValue(c3) b3 = GetBValue(c3) c4 = getColor(x, y+2) r4 = GetRValue(c4) g4 = GetGValue(c4) b4 = GetBValue(c4) r = (r1+r2+r3+r4)/4.14 g = (g1+g2+g3+g4)/4.14 b = (b1+b2+b3+b4)/4.14 c = RGB(r, g, b) RETURN cENDFUNCTIONFUNCTION getColor:x, y IF x >= 0 AND x < 320 AND y >= 0 AND y < 239 THEN RETURN fire[x][y] RETURN 0ENDFUNCTIONFUNCTION GetRValue: Color RETURN bAND(Color,255)ENDFUNCTIONFUNCTION GetGValue: Color RETURN (Color - (INTEGER(Color / 65536)*65536+bAND(Color,255))) / 256ENDFUNCTIONFUNCTION GetBValue: Color RETURN INTEGER(Color / 65536)ENDFUNCTION`
I did notice the functions supplied with the GLBasic examples for retrieving color components were incorrect. It appeared they assumed RGB but I guess it's store as BGR.

#### Wampus

• Prof. Inline
• Posts: 1004
##### Re: fire routine
« Reply #1 on: 2010-Sep-09 »
Good going

#### Schranz0r

• Prof. Inline
• Posts: 5030
• O Rly?
##### Re: fire routine
« Reply #2 on: 2010-Sep-09 »
Heavy code man!
I DGArray's

PC:
AMD Ryzen 7 1700 @3.9GHz, 16GB HyperX Fury 3000MHz Ram, ASUS ROG GTX 1060 STRIX 6GB, Windows 10 Pro 64Bit, MSi Tomahawk B350 Mainboard

#### BumbleBee

• Global Moderator
• Prof. Inline
• Posts: 891
##### Re: fire routine
« Reply #3 on: 2010-Sep-09 »
More than 40 years for this Project??

Code: (glbasic) [Select]
`   Start: Wednesday, December 31, 1969 `
Yes, it's a funny bug since V.8.x. Each project starts in 1970.  Btw, it looks good.

Cheers
The day will come...

CPU Intel(R) Core(TM) i5-3570k, 3.4GHz, AMD Radeon 7800 , 8 GB RAM, Windows 10 Home 64Bit

#### kaotiklabs

• Dr. Type
• Posts: 313
• Spain is diferent
##### Re: fire routine
« Reply #4 on: 2010-Sep-11 »
wooow.
This old graphic tricks are really awesome.
Vote Cthulhu! Because the stars are right!!!!
Ia Ia Cthulhu F' tang!

#### Minion

• Mr. Polyvector
• Posts: 229
##### Re: fire routine
« Reply #5 on: 2010-Sep-23 »
Got this hanging around and thought I`d post it. Although not a fire routine, its using the same principles, may be of some use to you.

Sorry the code is sloppy, this was the first thing I knocked up since not using GLB for a fair few years.

Just run it and waggle the mouse around a bit

Code: (glbasic) [Select]
`// --------------------------------- //// Project: plasma// Start: Tuesday, August 03, 2010// IDE Version: 8.054 // SETCURRENTDIR("Media") // seperate media and binaries?LIMITFPS -1SETSCREEN 800,480,0//SETSCREEN 1280,1024,1GLOBAL plas[]siz=99DIM plas[2][5][siz+2][siz+2]GETSCREENSIZE scrx,scrya=0b=1REPEATsx=scrx/sizsy=scry/sizALPHAMODE 1//0.25FOR m=0 TO sizFOR n=0 TO sizmm=m*sxmm2=(m+1)*sxnn=n*synn2=(n+1)*syDIM rrr[4]k0=0FOR k1=0 TO 1FOR k2=0 TO 1rr=plas[a][1][m+k1][n+k2]*5IF rr>255 THEN rr=255gg=plas[a][2][m+k1][n+k2]*5IF gg>255 THEN gg=255bb=plas[a][3][m+k1][n+k2]*5IF bb>255 THEN bb=255rrr[k0]=RGB(rr,gg,bb)k0=k0+1NEXTNEXT//r1=RGB(plas[a][1][m][n],     plas[a][2][m][n],     plas[a][3][m][n])//r2=RGB(plas[a][1][m+1][n],   plas[a][2][m+1][n],   plas[a][3][m+1][n])//r3=RGB(plas[a][1][m+1][n+1], plas[a][2][m+1][n+1], plas[a][3][m+1][n+1])//r4=RGB(plas[a][1][m][n+1],   plas[a][2][m][n+1],   plas[a][3][m][n+1])//r1=r1*5////IF r1>255 THEN r1=255//r2=r2*5////IF r2>255 THEN r2=255//r3=r3*5////IF r3>255 THEN r3=255//r4=r4*5////IF r4>255 THEN r4=255IF b1r1=RGB(255/2,255/2,255/2)ENDIFSTARTPOLY 0,0POLYVECTOR mm,nn,0,0,rrr[0]POLYVECTOR mm2,nn,0,0,rrr[2]POLYVECTOR mm2,nn2,0,0,rrr[3]POLYVECTOR mm,nn2,0,0,rrr[1]ENDPOLYNEXTNEXTIF b1FOR j=1 TO 3FOR m=1 TO 5rx=RND(siz)ry=RND(siz)//plas[a][j][rx][ry]=plas[a][j][rx][ry]+25//plas[a][j][rx][ry]=255//plas[a][1][rx][ry]=256*256//plas[a][2][rx][ry]=256plas[a][3][rx][ry]=64NEXTNEXTENDIFFOR mm=0 TO sizFOR nn=0 TO sizm=mmn=nn//IF mm=0 THEN m=siz//IF mm=siz THEN m=0//IF nn=0 THEN n=siz//IF nn=siz THEN n=0FOR j=1 TO 3a1=plas[a][j][m][n]a2=plas[a][j][MOD(m+1,siz)][n]a3=plas[a][j][MOD(m+siz-1,siz)][n]a4=plas[a][j][m][MOD(n+1,siz)]a5=plas[a][j][m][MOD(n+siz-1,siz)]aa=(a1+a2+a3+a4+a5)/5.075IF aa>255 THEN aa=255//aa=plas[a][j][m][n]plas[b][j][m][n]=aaNEXTNEXTNEXTREPEATmxo=mxmyo=myMOUSESTATE mx,my,b1,b2//ln(100,100,200,200)ln(mx,my,mxo,myo,b,sx,sy)//sx=scrx/siz//sy=scry/siz//plas[b][2][mx/sx][my/sy]=256*256//plas[b][1][mx/sx][my/sy]=256//plas[b][3][mx/sx][my/sy]=64//plas[b][2][mx/sx][my/sy]=255PRINT "<",mx,myUNTIL 0=0//USESCREEN -1//DRAWSPRITE 30,0,0SHOWSCREENa=1-ab=1-aUNTIL b2FUNCTION setplas: b,mx,my,sx,sy,tIF t=1 t1=1 t2=2 t3=3ENDIFIF t=2 t1=2 t2=3 t3=1ENDIFIF t=3 t1=3 t2=1 t3=2ENDIFIF t=4 t1=2 t2=1 t3=3ENDIFplas[b][t2][mx/sx][my/sy]=256*256*256//plas[b][t2][mx/sx][my/sy]=256plas[b][t3][mx/sx][my/sy]=64ENDFUNCTIONFUNCTION ln: x1,y1,x2,y2,b,sx,syxdiff=(x2-x1)ydiff=(y2-y1)xa=ABS(xdiff)ya=ABS(ydiff)IF xa>ya   stps=xaELSE   stps=yaENDIF//`stps=MAX(xa,ya)IF xa<yaz=1bal=yaELSEz=0bal=xaENDIFIF x1<x2xd=1ELSExd=-1ENDIFIF y1<y2yd=1ELSEyd=-1ENDIFad=0xp=0yp=0FOR j=1 TO stps//dot x1+xp,y1+yp//SETPIXEL x1+xp,y1+yp,RGB(255,255,255)setplas(b,x1+xp,y1+yp,sx,sy,1)setplas(b,scrx-(x1+xp),y1+yp,sx,sy,2)setplas(b,scrx-(x1+xp),scry-(y1+yp),sx,sy,3)setplas(b,(x1+xp),scry-(y1+yp),sx,sy,4)IF z=1yp=yp+ydad=ad+(xa*2)IF ad>balad=ad-(bal*2)xp=xp+xdENDIFELSExp=xp+xdad=ad+(ya*2)IF ad>balad=ad-(bal*2)yp=yp+ydENDIFENDIFNEXT//SETPIXEL x1+xp,y1+yp,RGB(255,255,255)setplas(b,x1+xp,y1+yp,sx,sy,1)setplas(b,scrx-(x1+xp),y1+yp,sx,sy,2)setplas(b,scrx-(x1+xp),scry-(y1+yp),sx,sy,3)setplas(b,(x1+xp),scry-(y1+yp),sx,sy,4)ENDFUNCTIONFUNCTION line: x0, x1, y0, y1     IF ABS(y1 - y0) > ABS(x1 - x0)         swap(x0, y0)         swap(x1, y1)         steep=0     ELSE      steep =1     ENDIF     IF x0 > x1 THEN         swap(x0, x1)         swap(y0, y1)      deltax = x1 - x0      deltay = ABS(y1 - y0)      error = deltax / 2      ystep = 0      y = y0     IF y0 < y1      ystep = 1     ELSE      ystep = -1     ENDIF     FOR x = x0 TO x1         IF steep          SETPIXEL y,x,RGB(255,255,255)          ELSE            SETPIXEL x,y,RGB(255,255,255)         ENDIF         error = error - deltay         IF error < 0             y = y + ystep             error = error + deltax ENDIF NEXTENDFUNCTIONFUNCTION swap: BYREF a, BYREF bLOCAL cc=aa=bb=cENDFUNCTION`