### Author Topic: qb64 firedemo  (Read 3186 times)

#### harixxx

• Guest
##### qb64 firedemo
« on: July 02, 2010, 05:44:33 am »
_TITLE "FIRE Demo v1.0"
'-----| by harixxx
'-----| 6-16-2010

const mx=108
const my=44
const sx=3
const sy=6
const ms\$="QB64 : FIRE Demo v1.0 - Created by harixxx"

sc = -Mx
lt = LEN(Ms\$) * 8
DIM ct(lt, 14), fl(Mx, My)

SCREEN _NEWIMAGE(640, 240, 256), , 1, 0

PRINT Ms\$
FOR i = 0 TO lt - 1
FOR j = 0 TO 13
IF POINT(i, j) > 0 THEN
ct(i, j) = 64
ct(i, j + 1) = -64
ct(i + 1, j + 1) = -64
END IF
NEXT j, i

SCREEN _NEWIMAGE(320, 240, 256), , 1, 0
FOR i = 0 TO 63
SetPal i, i, 0, 0
SetPal i + 64, 63, i, 0
SetPal i + 128, 63, 63, i
NEXT

'_FULLSCREEN
_LIMIT 10
DO
REDIM fm(Mx, My)
sc = sc + .5
IF sc > lt THEN sc = -Mx
FOR x = 0 TO Mx
FOR y = 0 TO 14
cx = INT(x + sc)
IF cx >= 0 AND cx <= lt THEN fm(x, y + 16) = ct(cx, y)
NEXT y, x
FOR x = 1 TO Mx - 1
fl(x, My) = RND * 2250 - 1000
FOR y = My - 1 TO 0 STEP -1
fl(x, y) = (fl(x - 1, y) + fl(x, y + 1) + fl(x + 1, y + 1)) \ 3 - 4
c = fl(x, y)
c = (c - 2) * -(c < 64) + c * -(c > 63) + fm(x, y)
c = 191 * -(c > 191) + c * -(c < 192)
IF y < My - 4 THEN LINE (x * Sx - Sx, y * Sy)-STEP(Sx, Sy), c * -(c > 0), BF
NEXT y, x
_DELAY .03
PCOPY 1, 0
LOOP UNTIL INKEY\$ > ""
SLEEP
SYSTEM

SUB SetPal (n, r, g, b)
OUT 968, n
OUT 969, r
OUT 969, g
OUT 969, b
END SUB

#### Clippy

• Hero Member
• Posts: 19407
• I LOVE π = 4 * ATN(1)    Use the QB64 WIKI >>>
##### Re: qb64 firedemo
« Reply #1 on: July 02, 2010, 11:26:25 am »
Nicely done!

QB64 WIKI: Main Page
QB64 SDL

#### codeguy

• Hero Member
• Posts: 4051
• what the h3ll did i name that code?
##### Re: qb64 firedemo
« Reply #2 on: July 02, 2010, 11:46:41 am »
at the risk of gettin' kicked off this here forum F*in' A. nice demo!

#### Lucid

• Full Member
• Posts: 157
• 1 goto 1
##### Re: qb64 firedemo
« Reply #3 on: July 02, 2010, 01:11:02 pm »
Great demo!

#### Pete

• Hero Member
• Posts: 7431
• Cuz I sez so varmint!
##### Re: qb64 firedemo
« Reply #4 on: July 02, 2010, 03:41:58 pm »
at the risk of gettin' kicked off this here forum F*in' A. nice demo!

You will need to leave this forum for writing that. Geeze, everyone here knows that QB64 doesn't support Fn statements! At least not until a future Fn update.

Pete
« Last Edit: July 02, 2010, 08:39:31 pm by Pete »
Give a man a program, and he does one thing for a day. Teach a man to program, and he does one thing for a lifetime.

#### Clippy

• Hero Member
• Posts: 19407
• I LOVE π = 4 * ATN(1)    Use the QB64 WIKI >>>
##### Re: qb64 firedemo
« Reply #5 on: July 03, 2010, 01:01:50 am »
WHAT?!

Is you DEF or what?!
QB64 WIKI: Main Page
QB64 SDL

#### harixxx

• Guest
##### Re: qb64 firedemo
« Reply #6 on: July 03, 2010, 05:59:34 am »
_TITLE "FIRE Demo v1.1"
'-----| by harixxx
'-----| 6-18-2010

'------------| mx,my Max Grid x,y
const mx = 110
const my = 38
'------------| sx,sy Grid Size x,y
const sx = 6
const sy = 15
'------------| Message
const ms\$ = "QB64 : FIRE Demo - Created by harixxx"

SCREEN _NEWIMAGE(640, 480, 256), , 1, 0

sc = -Mx
lt = LEN(Ms\$) * 8
DIM cm(lt, 14), fl(Mx, My)
'------------| Create Messages
PRINT Ms\$
FOR i = 0 TO lt - 1
FOR j = 0 TO 13
IF POINT(i, j) > 0 THEN
cm(i, j) = 64
cm(i, j + 1) = -64
cm(i + 1, j + 1) = -64
END IF
NEXT j, i
'------------| Change Palette 1 - 191
FOR i = 0 TO 63
SetPal i, i, 0, 0
SetPal i + 64, 63, i, 0
SetPal i + 128, 63, 63, i
NEXT

'------------| Main Process
'_FULLSCREEN
DO
REDIM fm(Mx, My)
sc = sc + 1
IF sc > lt THEN sc = -Mx
'------------| Fill Messages
FOR x = 0 TO Mx
FOR y = 0 TO 14
cx = INT(x + sc)
IF cx >= 0 AND cx <= lt THEN fm(x, y + 12) = cm(cx, y)
NEXT y, x
'------------| Generate Fires
FOR x = 1 TO Mx - 1
fl(x, My) = RND * 2250 - 1000
FOR y = My - 1 TO 0 STEP -1
fl(x, y) = (fl(x - 1, y) + fl(x, y + 1) + fl(x + 1, y + 1)) \ 3 - 4
IF y < My - 4 THEN
c = fl(x, y)
'------------| Merge Fire and Messages
c = (c - 2) * -(c < 64) + c * -(c > 63) + fm(x, y)
c = 191 * -(c > 191) + c * -(c < 192)
fm(x, y) = c * -(c > 0)
END IF
NEXT y, x
'------------| Draw Fires
FOR x = 0 TO Mx - 1
FOR y = 0 TO My - 1
GBox x - 1, y, Sx, Sy, fm(x, y), fm(x + 1, y), fm(x + 1, y + 1), fm(x, y + 1)
NEXT y, x
PCOPY 1, 0
LOOP UNTIL INKEY\$ > ""
SLEEP
SYSTEM
SUB GBox (x, y, w, h, c1, c2, c3, c4)
FOR j = 0 TO h - 1
c5 = c1 + (c4 - c1) / h * j
c6 = ((c2 + (c3 - c2) / h * j) - c5) / w
FOR i = 0 TO w - 1
PSET (x * w + i, y * h + j), c5 + c6 * i
NEXT i, j
END SUB
'------------| Palette Setting
SUB SetPal (n, r, g, b)
OUT 968, n
OUT 969, r
OUT 969, g
OUT 969, b
END SUB

#### harixxx

• Guest
##### Re: qb64 firedemo
« Reply #7 on: July 03, 2010, 06:58:21 am »

qb64 really amaze me..
cause standard command like 'pset' run with fullspeed result.

but anybody know, how to compile qb64 sourcecode with smaller size and without image libs like 'libtiff-3.dll' ?
thanks

#### Cyperium

• Hero Member
• Posts: 3660
• Knowledge is good, but understanding is better
##### Re: qb64 firedemo
« Reply #8 on: July 05, 2010, 01:35:14 pm »
Wow, that's the best fire I've seen (aside from real fire that is)! I really like the shadow effect, resembles heat somehow...

#### harixxx

• Guest
##### Re: qb64 firedemo
« Reply #9 on: July 07, 2010, 06:22:22 am »
thank's..

#### Galleon

• Hero Member
• Posts: 5490
• QB Forever
##### Re: qb64 firedemo
« Reply #10 on: July 07, 2010, 07:17:29 am »
Great fire demo. Try removing the paging settings in the SCREEN statement and replacing PCOPY 1,0 with _DISPLAY for a much smoother result.
Something old... Something new... Something borrowed... Something blue...

#### TerryRitchie

• Hero Member
• Posts: 2806
• Press any key to continue or any other key to quit
##### Re: qb64 firedemo
« Reply #11 on: July 07, 2010, 03:45:52 pm »
AWESOME!