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 >>>
    • Pete's Qbasic Site
Re: qb64 firedemo
« Reply #1 on: July 02, 2010, 11:26:25 am »
Nicely done!

QB64 WIKI: Main Page
Download Q-Basics Demo: Q-Basics.zip
Download QB64 BAT, IconAdder and VBS shortcuts: QB64BAT.zip
QB64 SDL

codeguy

  • Hero Member
  • *****
  • Posts: 4051
  • what the h3ll did i name that code?
    • stuff at dkm
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! ;D

Lucid

  • Full Member
  • ***
  • Posts: 157
  • 1 goto 1
    • Website
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! ;D

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. ;D

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 >>>
    • Pete's Qbasic Site
Re: qb64 firedemo
« Reply #5 on: July 03, 2010, 01:01:50 am »
WHAT?!

Is you DEF or what?!  ::)
QB64 WIKI: Main Page
Download Q-Basics Demo: Q-Basics.zip
Download QB64 BAT, IconAdder and VBS shortcuts: QB64BAT.zip
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
'------------| Draw Gradient Box
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
    • Cyperium
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

  • Administrator
  • 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!