'Thanks to Ken for inspiring mod fun!
'Thanks to Bplus on the QB64.org forum for the trail code.
'Made on Aug. 30, 2019 by Ken G. mod by B+
'2019-09-01 mod of Fireflies #2 taking fly paths from Bugs on fire and adding Frames array
' for layering partially faded screens to get trails effect WITH a background display!
' 2 experiments have failed to produce desired trails do to my erroneous way of thinking.
' Time to pull out the heavy guns, cds Tools, and test an array like string of x, y locations.
' This might be a little complicated! We will be fading out old locations with transparencies
' rather than drawing over and over again with smoke layers.
' GLOBALS
CONST nFlies
= 25, xmax
= 800, ymax
= 600, cx
= 400, cy
= 300
rr
AS SINGLE 'random coeff = radius of flight path
' LOCALS for main code which is all this is!
_TITLE "Fireflies that glow, trails and background"
'prepare background image
drawLandscape
'setup trans
'setup flies
FOR i
= 1 TO nFlies
'bug maker f
(i
).rr
= RND * 200 + 250 f
(i
).red
= RND * 190 + 60 f
(i
).green
= RND * 190 + 60 f
(i
).blue
= RND * 190 + 60frameI = 0: a = 0
frameI = frameI + 1 'new image pointer for frame handler
IF frameI
>= 51 THEN frameI
= 1 ' frames to manage
a = a + .1
FOR i
= 1 TO nFlies
'move bug 'mod a to radius of flight path so they move approximately same rate
ma = a / f(i).rr
'calc new location
x
= cx
+ f
(i
).rr
* 2 * (COS(f
(i
).n
* (ma
+ f
(i
).a
)) / 2 + SIN(f
(i
).m
* (ma
+ f
(i
).a
)) / 3) y
= cy
+ f
(i
).rr
* 1.5 * (SIN(f
(i
).n
* (ma
+ f
(i
).a
)) / 2 + COS(f
(i
).m
* (ma
+ f
(i
).a
)) / 3)
'load new loacation to next frame
cdsI f
(i
).x
, frameI
, STR$(x
) cdsI f
(i
).y
, frameI
, STR$(y
)
'ok now draw all the 24 frames starting at oldest and coming to newest
'with newest frame updated draw then all starting with oldest
ic = 0 'image counter
j = frameI 'start at oldest frame
again:
x
= VAL(cdsI$
(f
(i
).x
, j
)) 'extract x(j) in f().x string y
= VAL(cdsI$
(f
(i
).y
, j
)) 'ectract y(j) in f().y string ic = ic + 1
IF j
<> 50 THEN 'glitched on top index have no idea why, do you? fcirc x
, y
, f
(i
).r
+ 3, _RGBA32(255, 255, 255, .5 * tr
(ic
)) fcirc x
, y
, f
(i
).r
, _RGBA32(f
(i
).red
, f
(i
).green
, f
(i
).blue
, tr
(ic
)) j = j + 1
'from Steve Gold standard
Radius
= ABS(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
'needs midInk, irnd
'the sky
midInk 0, 0, 48, 28, 0, 88, i / ymax
'the land
startH = ymax - 400
rr = 40: gg = 50: bb = 60
Xright = 0
y = startH
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown
= (RND * .8 - .35) * (mountain
* .5) range = Xright + irnd%(15, 25) * 2.5 / mountain
lastx = Xright - 1
y = y + upDown
LINE (lastx
, y
)-(X
, ymax
), , BF
'just lines weren't filling right lastx = X
Xright = range
rr = irnd%(rr - 15, rr): gg = irnd%(gg - 15, gg): bb = irnd%(bb - 25, bb)
startH = startH + irnd%(5, 20)
SUB midInk
(r1%
, g1%
, b1%
, r2%
, g2%
, b2%
, fr##
) COLOR _RGB32(r1%
+ (r2%
- r1%
) * fr##
, g1%
+ (g2%
- g1%
) * fr##
, b1%
+ (b2%
- b1%
) * fr##
)
FUNCTION irnd%
(n1
, n2
) 'return an integer between 2 numbers IF n1
> n2
THEN l%
= n2: h%
= n1
ELSE l%
= n1: h%
= n2
irnd%
= INT(RND * (h%
- l%
+ 1)) + l%
' ================================== cds Tools ( for Comma Delimited Strings ) 2019-08-29 B+
'modified Item$ for dedicated comma delimited strings
'cds$ is a comma delimited string to be used like an array
'ItemNumber starts at 1 and counts up
lastd
= 1: d
= INSTR(lastd
, cds$
, ",") c = c + 1
lastd
= d
+ 1: d
= INSTR(lastd
, cds$
, ",") c = c + 1
'Description: cdsI sub modifies cds$ (comma delimited string) with addOrEditItem$ at ItemNumber
'This sub uses 2 functions:
' FUNCTION CommaCount% (s$)
' FUNCTION LocateComma% (s$, N AS INTEGER)
'cds$ is a comma delimited string to be used like an array
'ItemNumber starts at 1 and counts up
items = CommaCount%(cds$) + 1
IF ItemNumber
<= items
+ 1 THEN 'replace cds$ = addOrEditItem$
cds$
= MID$(cds$
, 1, LocateComma%
(cds$
, ItemNumber
- 1)) + addOrEditItem$
+ MID$(cds$
, LocateComma
(cds$
, ItemNumber
)) cds$ = cds$ + "," + addOrEditItem$
i = items + 1
WHILE i
<= ItemNumber
- 1 cds$ = cds$ + ","
i = i + 1
cds$ = cds$ + "," + addOrEditItem$
'Description: this sub removes from a cds$ (comma delimited string) itemNumber given if it exists
' This sub needs:
' FUNCTION CommaCount% (s$)
' FUNCTION cdsI$ (cds$, ItemNumber AS INTEGER)
SUB cdsCut
(cds$
, ItemNumber
) items = CommaCount%(cds$) + 1
B$ = cdsI$(cds$, i)
B$ = B$ + "," + cdsI$(cds$, i)
cds$ = B$
'Description: return comma count in string in string
CommaCount% = c
'Description: return the loaction of the Nth comma in string if there is one.
