fire routine

Previous topic - Next topic

phaelax

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)+r

SETSCREEN 640, 480, 0

GLOBAL flame = 4.14
GLOBAL fire[]

DIM fire[320][240]

LOCAL r


REPEAT

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


SHOWSCREEN

UNTIL KEY(28) = 1
END




FUNCTION 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 c
ENDFUNCTION


FUNCTION getColor:x, y
IF x >= 0 AND x < 320 AND y >= 0 AND y < 239 THEN RETURN fire[x][y]
RETURN 0
ENDFUNCTION



FUNCTION GetRValue: Color
RETURN bAND(Color,255)
ENDFUNCTION

FUNCTION GetGValue: Color
RETURN (Color - (INTEGER(Color / 65536)*65536+bAND(Color,255))) / 256
ENDFUNCTION

FUNCTION 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

Good going  :)

Schranz0r

not bad!
Heavy code man! :D
I <3 DGArray's :D

PC:
AMD Ryzen 7 3800X 16@4.5GHz, 16GB Corsair Vengeance LPX DDR4-3200 RAM, ASUS Dual GeForce RTX™ 3060 OC Edition 12GB GDDR6, Windows 11 Pro 64Bit, MSi Tomahawk B350 Mainboard

BumbleBee

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.  :booze: 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

wooow.
This old graphic tricks are really awesome.
I would like to read more about them :)
Vote Cthulhu! Because the stars are right!!!!
Ia Ia Cthulhu F' tang!

Minion

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 -1
SETSCREEN 800,480,0
//SETSCREEN 1280,1024,1
GLOBAL plas[]






siz=99
DIM plas[2][5][siz+2][siz+2]

GETSCREENSIZE scrx,scry

a=0
b=1
REPEAT

sx=scrx/siz
sy=scry/siz

ALPHAMODE 1//0.25


FOR m=0 TO siz
FOR n=0 TO siz

mm=m*sx
mm2=(m+1)*sx

nn=n*sy
nn2=(n+1)*sy

DIM rrr[4]
k0=0
FOR k1=0 TO 1
FOR k2=0 TO 1

rr=plas[a][1][m+k1][n+k2]*5
IF rr>255 THEN rr=255

gg=plas[a][2][m+k1][n+k2]*5
IF gg>255 THEN gg=255

bb=plas[a][3][m+k1][n+k2]*5
IF bb>255 THEN bb=255

rrr[k0]=RGB(rr,gg,bb)
k0=k0+1
NEXT
NEXT

//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=255
IF b1
r1=RGB(255/2,255/2,255/2)
ENDIF

STARTPOLY 0,0

POLYVECTOR 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]

ENDPOLY

NEXT
NEXT



IF b1
FOR j=1 TO 3
FOR m=1 TO 5
rx=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]=256
plas[a][3][rx][ry]=64
NEXT
NEXT
ENDIF


FOR mm=0 TO siz
FOR nn=0 TO siz
m=mm
n=nn
//IF mm=0 THEN m=siz
//IF mm=siz THEN m=0
//IF nn=0 THEN n=siz
//IF nn=siz THEN n=0

FOR j=1 TO 3
a1=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.075
IF aa>255 THEN aa=255

//aa=plas[a][j][m][n]
plas[b][j][m][n]=aa
NEXT

NEXT
NEXT

REPEAT

mxo=mx
myo=my

MOUSESTATE 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]=255



PRINT "<",mx,my

UNTIL 0=0
//USESCREEN -1
//DRAWSPRITE 30,0,0
SHOWSCREEN
a=1-a
b=1-a
UNTIL b2




FUNCTION setplas: b,mx,my,sx,sy,t

IF t=1
t1=1
t2=2
t3=3
ENDIF
IF t=2
t1=2
t2=3
t3=1
ENDIF
IF t=3
t1=3
t2=1
t3=2
ENDIF
IF t=4
t1=2
t2=1
t3=3
ENDIF

plas[b][t2][mx/sx][my/sy]=256*256*256
//plas[b][t2][mx/sx][my/sy]=256
plas[b][t3][mx/sx][my/sy]=64
ENDFUNCTION


FUNCTION ln: x1,y1,x2,y2,b,sx,sy
xdiff=(x2-x1)
ydiff=(y2-y1)
xa=ABS(xdiff)
ya=ABS(ydiff)
IF xa>ya
   stps=xa
ELSE
   stps=ya
ENDIF
//`stps=MAX(xa,ya)

IF xa<ya
z=1
bal=ya
ELSE
z=0
bal=xa
ENDIF

IF x1<x2
xd=1
ELSE
xd=-1
ENDIF

IF y1<y2
yd=1
ELSE
yd=-1
ENDIF

ad=0
xp=0
yp=0

FOR 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=1
yp=yp+yd
ad=ad+(xa*2)
IF ad>bal
ad=ad-(bal*2)
xp=xp+xd
ENDIF
ELSE
xp=xp+xd
ad=ad+(ya*2)
IF ad>bal
ad=ad-(bal*2)
yp=yp+yd
ENDIF
ENDIF

NEXT

//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)

ENDFUNCTION



FUNCTION 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
NEXT
ENDFUNCTION


FUNCTION swap: BYREF a, BYREF b
LOCAL c
c=a
a=b
b=c
ENDFUNCTION