Code:
DECLARE SUB AddSpecificHeat (x%, dist%, hvalue%)
DECLARE SUB CoolRoot (value%)
DECLARE SUB DrawFire (x%, y%, scale%)
DECLARE SUB MoreFire ()
DECLARE SUB UpdateFire (cooldown%)
DECLARE SUB CreateNewFire ()
DECLARE SUB SpawnFires (p%)
DECLARE SUB anykey ()
'Fire test
DEFINT A-Z
CONST firex% = 30
CONST firey% = 30
RANDOMIZE VAL(MID$(TIME$, 7, 2))
DIM SHARED fire(1 TO firey%, 1 TO firex%)
FOR i% = 1 TO firex%
FOR j% = 1 TO firey%
fire%(j%, i%) = 0
NEXT
NEXT
SCREEN 7
TYPE firespot
x AS INTEGER
y AS INTEGER
END TYPE
CONST maxfires% = 400
DIM SHARED fires(maxfires%) AS firespot
DIM SHARED numfires%
CONST YELLOW = 1
CONST ORANGE = 2
CONST RED = 3
CONST WHITE = 4
CALL AddSpecificHeat(25, 20, 190)
PALETTE 1, 4
PALETTE 2, 12
PALETTE 3, 14
PALETTE 4, 15
DIM SHARED curtim AS SINGLE
curtim = TIMER
DO
'IF TIMER - curtim > .02 THEN
SCREEN 7, 0, 1, 0: CLS
LINE (0, 0)-(319, 100), 11, BF
LINE (0, 100)-(319, 200), 10, BF
FOR i% = 1 TO numfires% STEP 1
x% = fires(i%).x
y% = fires(i%).y
CALL DrawFire(x%, y%, 1)
'x% = x% + 4
'IF x% > 320 THEN x% = x% - 320
'fires(i%).x = x%
NEXT
'PCOPY 1, 0
'END
CALL UpdateFire(120)
CALL CoolRoot(2)
CALL MoreFire
CALL SpawnFires(70)
PCOPY 1, 0
curtim = TIMER
'END IF
'CALL anykey
LOOP
DEFSNG A-Z
SUB AddHeat (value)
FOR i = 1 TO firex%
fire%(20, i) = fire%(20, i) + INT(RND(1) * value) + 1
NEXT
END SUB
SUB AddSpecificHeat (x%, dist%, hvalue%)
sx% = x% - (dist% / 2)
sx2% = sx% + dist%
dx% = -(dist% / 2)
IF sx% < 1 THEN sx% = sx% + (firex% - 1)
DO
coef# = ABS(dx% / dist%)
heat% = hvalue% * (1 - coef#)
curheat% = fire%(firey% - 1, sx%)
curheat% = curheat% + heat%
IF curheat% > 320 THEN curheat% = 320
fire%(firey% - 1, sx%) = curheat%
sx% = sx% + 1
dx% = dx% + 1
IF sx% > (firex% - 1) THEN sx% = sx% - (firex% - 1)
LOOP UNTIL dx% >= (dist% / 2)
END SUB
SUB anykey
DO
a$ = INKEY$
LOOP UNTIL LEN(a$) > 0
END SUB
SUB CoolRoot (value%)
FOR i% = 1 TO firex%
h% = 2.5
h% = fire%(firey% - 1, i%)
v% = INT(RND(1) * value%)
h% = h% - v%
IF h% < 0 THEN h% = 0
fire%(firey% - 1, i%) = h%
NEXT
END SUB
SUB CreateNewFire
IF (numfires% < maxfires%) THEN
numfires% = numfires% + 1
fires(numfires%).x = INT(RND(1) * 320) + 1
fires(numfires%).y = 100 + INT(RND(1) * 100) + 1
END IF
END SUB
SUB DrawFire (x%, y%, scale%)
sx% = x% - ((firex% / 2) * scale%)
sy% = y%
a% = firey% - 2
b% = 1
l% = 0
DO
FOR i% = sx% TO sx% + firex% - 1 STEP 1
posa% = a% + 1
posb% = b% + 1
nega% = a% - 1
negb% = b% - 1
IF posa% >= firey% THEN posa% = firey%
IF posb% >= firex% THEN posb% = posb% - (firex% - 1)
IF nega% <= 1 THEN nega% = 1
IF negb% <= 1 THEN negb% = negb% + (firex% - 1)
h1% = fire%(nega%, negb%)
h2% = fire%(nega%, b%)
h4% = fire%(a%, negb%)
h% = fire%(a%, b%)
h6% = fire%(a%, posb%)
h8% = fire%(posa%, b%)
fh6% = (h1% + h4% + h6% + h2% + h8% + h%) / 6
'fh4% = (h2% + h4% + h6% + h8%)
fh% = fh6%
SELECT CASE fh%
CASE 0 TO 11
c% = -1
CASE 11 TO 80
c% = 1
CASE 71 TO 170
c% = 2
CASE 161 TO 260
c% = 3
CASE IS > 250
c% = 4
END SELECT
IF c% <> -1 THEN PSET (i%, sy%), c%
b% = b% + 1
NEXT
sy% = sy% - 1
a% = a% - 1
b% = 1
LOOP UNTIL a% < 1
END SUB
SUB MoreFire
mf% = INT(RND(1) * 100) + 1
IF mf% > 90 THEN
flx% = INT(RND(1) * firex%)
dist% = INT(RND(1) * 10) + 1
hv% = 100 + INT(RND(1) * 220) + 1
CALL AddSpecificHeat(flx%, dist%, hv%)
END IF
END SUB
DEFINT A-Z
SUB SpawnFires (p%)
n% = INT(RND(1) * 100) + 1
IF n% > p% THEN CALL CreateNewFire
END SUB
DEFSNG A-Z
SUB UpdateFire (cooldown%)
t = -1
belowheat% = 0
FOR i% = 1 TO firey% - 2 STEP 1
FOR j% = 1 TO firex% - 1
d% = INT(RND(1) * 4)
negj% = j% - d%
posj% = j% + d%
IF negj% <= 1 THEN negj% = negj% + (firex% - 1)
IF posj% >= (firex%) THEN posj% = posj% - (firex% - 1)
r% = INT(RND(1) * 100) + 1
SELECT CASE r%
CASE 0 TO 35
belowheat% = fire%(i% + 1, negj%)
p% = negj%
t = 1
CASE 36 TO 70
belowheat% = fire%(i% + 1, j%)
p% = j%
t = 2
CASE IS > 70
'PRINT posj%: PCOPY 1, 0
belowheat% = fire%(i% + 1, posj%)
p% = posj%
t = 3
END SELECT
IF belowheat% > 10 THEN
v% = INT(RND(1) * cooldown%)
belowheat% = belowheat% - v%
ELSE
cd% = INT(RND(1) * 50) + 1
IF cd% > 35 THEN belowheat% = belowheat% - INT(RND(1) * 6)
END IF
IF belowheat% < 0 THEN belowheat% = 0
IF p% = 0 THEN
PRINT p%; t: PCOPY 1, 0: END
END IF
fire%(i%, j%) = belowheat%
NEXT
NEXT
END SUB