Recent Posts1
To speed up, you can reduce screen size OR scale the pixel drawing up to boxes. Either way, there is less calculations.
Of course, you can also rotate the gears faster and slower as demo'd already. ;-))
Here is doing it with scaling, the smaller the scale the bigger the fire but the blurrier the picture. Try any scale >0 and <=1:
Of course, you can also rotate the gears faster and slower as demo'd already. ;-))
Here is doing it with scaling, the smaller the scale the bigger the fire but the blurrier the picture. Try any scale >0 and <=1:
Code: [Select]
_TITLE "Gears Afire! SCALED.bas for QB64 by B+ started 2018-05-25"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
CONST xmax = 800
CONST ymax = 600
DIM SHARED pi
pi = _PI
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM SHARED p&(300) 'pallette thanks harixxx
FOR i = 1 TO 100
fr = 240 * i / 100 + 15
p&(i) = _RGB(fr, 0, 0)
p&(i + 100) = _RGB(255, fr, 0)
p&(i + 200) = _RGB(255, 255, fr)
NEXT
WHILE 1
CLS
LOCATE 5, 23: PRINT "*** GEARS AFIRE! NOW SCALED TO YOUR SPECIFICATIONS ***"
LOCATE 10, 35: PRINT "Please enter a scale from 0 to 1,"
LOCATE 11, 10: PRINT "the lower the scale the less pixels used the bigger the fire and blurrier it gets. "
LOCATE 13, 20: INPUT "(0 or any number > 1 quits) Enter your scale choice now > "; scale
_DISPLAY
IF NOT (scale > 0 AND scale <= 1) THEN END
CLS
LOCATE 10, 18: PRINT "Please wait 30 seconds to watch the _LIMIT changes for graphics speed."
LOCATE 15, 41: PRINT "press any for show..."
_DISPLAY
'SLEEP 'WTF???
k$ = ""
WHILE LEN(k$) = 0: k$ = INKEY$: _LIMIT 500: WEND
rscale = 1 / scale
xxmax = scale * xmax
yymax = scale * ymax
REDIM SHARED f(xxmax, yymax) 'fire array tracks flames
'gear up
sq = 20
nt1 = 12
r1 = gearRadius(nt1, sq)
nt2 = nt1 * 2
r2 = gearRadius(nt2, sq)
iA2 = pi / nt2
acc = 1: d = 1
start = TIMER
WHILE TIMER - start < 30 'main show
CLS
PRINT "Scale, _LIMIT:"; scale; ","; acc
rao = rao + pi / 180
gear 600 * scale + 1, 300 * scale + 1, nt1, sq * scale, rao
gear (600 - r1 - r2 - sq - 6) * scale + 1, 300 * scale + 1, nt2, sq * scale, -.5 * rao - iA2
FOR y = 1 TO yymax - 2 'fire based literally on 4 pixels below it like cellular automata
FOR x = 1 TO xxmax - 1
v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
IF v > 294 THEN f(x, y) = 300
LINE (x * rscale, y * rscale)-STEP(rscale, rscale), p&(f(x, y)), BF
NEXT
NEXT
acc = acc + d
IF acc < 1 THEN acc = 1: d = d * -1
IF acc > 100 THEN acc = 100: d = d * -1
_DISPLAY
_LIMIT acc
WEND
WEND
FUNCTION gearRadius (nteeth, sqtooth)
gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
END FUNCTION
SUB gear (x, y, nteeth, sqtooth, raOffset)
radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
x2 = x + (radius + sqtooth) * COS(ra + raOffset)
y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
thic x, y, x2, y2, sqtooth - 4
NEXT
FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
x2 = x + radius * COS(ra + raOffset)
y2 = y + radius * SIN(ra + raOffset)
thic x, y, x2, y2, sqtooth + 4
NEXT
END SUB
SUB thic (x1, y1, x2, y2, thick)
t2 = thick / 2
IF t2 < 1 THEN t2 = 1
a = _ATAN2(y2 - y1, x2 - x1)
FOR i = 0 TO t2 STEP .5
x3 = x1 + i * COS(a + _PI(.5))
y3 = y1 + i * SIN(a + _PI(.5))
x4 = x1 + i * COS(a - _PI(.5))
y4 = y1 + i * SIN(a - _PI(.5))
x5 = x2 + i * COS(a + _PI(.5))
y5 = y2 + i * SIN(a + _PI(.5))
x6 = x2 + i * COS(a - _PI(.5))
y6 = y2 + i * SIN(a - _PI(.5))
'fireLine x3, y3, x4, y4
fireLine x4, y4, x6, y6
'fireLine x6, y6, x5, y5
fireLine x5, y5, x3, y3
NEXT
END SUB
SUB fireLine (x, y, x1, y1)
d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
a = _ATAN2(y1 - y, x1 - x)
FOR i = 0 TO d
xx = INT(x + i * COS(a) + .5)
yy = INT(y + i * SIN(a) + .5)
f(xx, yy) = rand(200, 300)
NEXT
END SUB
FUNCTION rand% (lo%, hi%)
rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION