Aquarium with Swaying Kelp.bas

I was looking through sample programs in latest SB update and see that Aquarium needs an update as well!


' Aquarium with swaying kelp.bas SmallBASIC 0.12.9 [B+=MGA] 2017-04-16
'from
'aquarium with swaying kelp2.sdlbas [B+=MGA] 2016-10-14
'thanks to Andy Amaya for Kelp growing idea
'2016-10-15 kelp2 grows faster, mod or fix sway?

randomize timer
const x0 = int(xmax/4)
const y0 = int(ymax/4)
const xmx = x0 + int(xmax/2)
const ymx = y0 + int(ymax/2)
const nFish = int(.35 * xmax / 25)
const swayLimit = int(.009 * xmax/2)

dim kelp(xmx, ymx), f(nFish), r(nFish), g(nFish), b(nFish)

def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo

sub
growKelp()
local kelps, x, y, r
kelps = rand(10, 25)
for x = 1 to kelps
kelp(rand(x0, xmx), ymx) = rand(1, 15)
next
for y = ymx - 1 to y0 step -1
for x = x0 to xmx
if kelp(x, y + 1) then
r = rand(1, 23)
select case r
case 1, 2, 3, 18 '1 branch node
if x - 1 >= x0 then kelp(x - 1, y) = kelp(x, y + 1)
case 4, 5, 6, 7, 8, 9, 21 '1 branch node
kelp(x, y) = kelp(x, y + 1)
case 10, 11, 12, 20 '1 branch node
if x + 1 <= xmx then kelp(x + 1, y) = kelp(x, y + 1)
case 13, 14, 15, 16, 17, 19 '2 branch node
if x - 1 >= x0 then kelp(x - 1, y) = kelp(x, y + 1)
if x + 1 <= xmx then kelp(x + 1, y) = kelp(x, y + 1)
end select
fi
next
next
end

sub
showKelp(z)
local y, x, dy, xoff
for y = y0 to ymx
dy = ((y-y0) * (pi / 180) + z) * (.5*ymax - (y-y0)) / (.5*ymax)
xoff = swayLimit * sin(dy)
for x = x0 to xmx
if kelp(x, y) > 0 and kelp(x, y) < 16 then
pset x + xoff, y, rgb(0, kelp(x, y) * 16, 0)
fi
next
next
end

sub
setupFish()
local i, d
for i = 0 to nFish
f(i).x = rand(x0, xmx)
f(i).y = rand(y0+20, ymx-20)
d = rand(0, 1)
if d then f(i).dx = rand(4, 8) else f(i).dx = rand(-8, -4)
r(i) = rnd^2 : g(i) = rnd^2 : b(i) = rnd^2
next
end

sub
drawFish(i)
local ra
f(i).x = f(i).x + f(i).dx
if f(i).x < x0 - 25 or f(i).x > xmx + 25 then f(i).dx = -1 * f(i).dx
f(i).y = f(i).y + rand(-4, 4)
for ra = 1 to 20
color rgb(127+127*sin(r(i)*ra),127+127*sin(g(i)*ra),127+127*sin(b(i)*ra))
if f(i).dx < 0 then
line f(i).x+ra, f(i).y-ra, f(i).x+ra, f(i).y+ra
else
line f(i).x-ra, f(i).y-ra, f(i).x-ra, f(i).y+ra
fi
next
for ra = 3 to 8
color rgb(127+127*sin(r(i)*10*ra),127+127*sin(g(i)*10*ra),127+127*sin(b(i)*10*ra))
if f(i).dx < 0 then
line f(i).x+20+ra, f(i).y-ra, f(i).x+20+ra, f(i).y+ra
else
line f(i).x-20-ra, f(i).y-ra, f(i).x-20-ra, f(i).y+ra
fi
next
if f(i).dx < 0 then
color 0 : circle f(i).x+6, f(i).y, 3 filled
color 14 : circle f(i).x+6, f(i).y, 2
else
color 0 : circle f(i).x-6, f(i).y, 3 filled
color 14 : circle f(i).x-6, f(i).y, 2
fi
end

sub
aquarium()
local dz, z, i, hf
dz = .25 : z = 0 : hf = int(nFish/2)
while 1
for i = y0 to ymx
color rgb(0, 0, 255 - (i / ymx) * 255)
line x0, i, xmx, i
next
for i = 0 to hf 'draw some fish behind kelp
drawFish(i)
next
z += dz
if z > swayLimit or z < -1 * swayLimit then dz *= -1
showKelp(z)
for i = hf + 1 to nFish 'draw the rest of the fish
drawFish(i)
next
rect 0, 0, xmax, y0, 0 filled
rect 0, y0, x0, ymax, 0 filled
rect xmx, y0, xmax, ymax, 0 filled
rect x0, ymx, xmx, ymax, 0 filled
showpage
delay 1
wend
end

color 11
? "Please wait while kelp is growing..."
showpage
growKelp()
setupFish()
aquarium()


'faster kelp for aquarium.bas SmallBASIC 0.12.9 [B+=MGA] 2017-04-18 from
' Aquarium with swaying kelp.bas SmallBASIC 0.12.9 [B+=MGA] 2017-04-16 from
'aquarium with swaying kelp2.sdlbas [B+=MGA] 2016-10-14
'thanks to Andy Amaya for Kelp growing idea
'2016-10-15 kelp2 grows faster, mod or fix sway?
'2016-04-18 new kelp arrays speed up display, sway removed

randomize timer
const x0 = xmax \ 4
const y0 = ymax \ 4
const xmx = x0 + xmax \ 2
const ymx = y0 + ymax \ 2
const nFish = .35 * xmax \ 25

dim kelp(xmx, ymx), f(nFish), r(nFish), g(nFish), b(nFish)

def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo

sub
growKelp()
local kelps, x, y, i, r, c, kelp
dim kelp(xmx, ymx), kx(), ky(), kc()
kelps = rand(10, 25)
for i = 1 to kelps
x = rand(x0, xmx)
c = rand(1, 15)
kelp(x, ymx) = c
kx << x : ky << ymx : kc << c
next
for y = ymx - 1 to y0 step -1
for x = x0 to xmx
if kelp(x, y + 1) then
r = rand(1, 23)
select case r
case 1, 2, 3, 18 '1 branch node
if x - 1 >= x0 then
kelp(x - 1, y) = kelp(x, y + 1)
kx << x-1 : ky << y : kc << kelp(x, y + 1)
fi
case 4, 5, 6, 7, 8, 9, 21 '1 branch node
kelp(x, y) = kelp(x, y + 1)
kx << x : ky << y : kc << kelp(x, y + 1)
case 10, 11, 12, 20 '1 branch node
if x + 1 <= xmx then kelp(x + 1, y) = kelp(x, y + 1)
kx << x + 1 : ky << y : kc << kelp(x, y + 1)
case 13, 14, 15, 16, 17, 19 '2 branch node
if x - 1 >= x0 then
kelp(x - 1, y) = kelp(x, y + 1)
kx << x - 1 : ky << y : kc << kelp(x, y + 1)
fi
if x + 1 <= xmx then
kelp(x + 1, y) = kelp(x, y + 1)
kx << x + 1: ky << y : kc << kelp(x, y + 1)
fi
end select
fi
next
next
end

sub
showKelp()
local i, top
top = ubound(kx)
for i = 0 to top
pset kx(i), ky(i), rgb(0, kc(i) * 16, 0)
next
end

sub
setupFish()
local i, d
for i = 0 to nFish
f(i).x = rand(x0, xmx)
f(i).y = rand(y0 + 20, ymx - 20)
d = rand(0, 1)
if d then f(i).dx = rand(1, 5) else f(i).dx = rand(-5, -1)
r(i) = rnd ^ 2 : g(i) = rnd ^ 2 : b(i) = rnd ^ 2
next
end

sub
drawFish(i)
local ra
f(i).x = f(i).x + f(i).dx
if f(i).x < x0 - 25 or f(i).x > xmx + 25 then f(i).dx = -1 * f(i).dx
f(i).y = f(i).y + rand(-1, 1)
for ra = 1 to 20
color rgb(127+127*sin(r(i)*ra),127+127*sin(g(i)*ra),127+127*sin(b(i)*ra))
if f(i).dx < 0 then
line f(i).x+ra, f(i).y-ra, f(i).x+ra, f(i).y+ra
else
line f(i).x-ra, f(i).y-ra, f(i).x-ra, f(i).y+ra
fi
next
for ra = 3 to 8
color rgb(127+127*sin(r(i)*3*ra),127+127*sin(g(i)*3*ra),127+127*sin(b(i)*3*ra))
if f(i).dx < 0 then
line f(i).x+20+ra, f(i).y-ra, f(i).x+20+ra, f(i).y+ra
else
line f(i).x-20-ra, f(i).y-ra, f(i).x-20-ra, f(i).y+ra
fi
next
if f(i).dx < 0 then
color 0 : circle f(i).x+6, f(i).y, 3 filled
color 14 : circle f(i).x+6, f(i).y, 2
else
color 0 : circle f(i).x-6, f(i).y, 3 filled
color 14 : circle f(i).x-6, f(i).y, 2
fi
end

sub
aquarium()
local i, hf
hf = nFish \ 2
while 1
for i = y0 to ymx
color rgb(0, 0, 255 - (i-y0) / (ymax/2) * 255)
line x0, i, xmx, i
next
for i = 0 to hf 'draw some fish behind kelp
drawFish(i)
next
showKelp
for i = hf + 1 to nFish 'draw the rest of the fish
drawFish(i)
next
rect 0, 0, xmax, y0, 0 filled
rect 0, y0, x0, ymax, 0 filled
rect xmx, y0, xmax, ymax, 0 filled
rect x0, ymx, xmx, ymax, 0 filled
showpage
delay 10
wend
end

color 11
? "Please wait while kelp is growing..."
showpage
growKelp
setupFish
aquarium

Umm... Are the seaweed plants meant to grow gradually as the fish swim by? I have run both versions and the seaweed plants are fully grown in both... I think my machine runs a bit too quickly... This is NOT a bug report or a complaint... It's just an observation... Other than that, the aquarium is great... Good job...

J

All the growing takes place before the first display of aquarium, after that it's just fish swimming. In the first version, the kelp was swaying as if waves were rolling through. In second version, I stopped the swaying even though I got the kelp to display fast enough that the fish swim much more smoothly eg without the jerk forward, stop... sequence. Even with faster kelp display there is some flicker and jerking with swaying kelp, plus a new bug has popped up when the swaying has picked up a discontinuity of motion like film with a poorly seamed together loop.

On my system the first version posted not only had the jerky fish but the whole screen was flickering when the kelp was swaying. Maybe your system is fast enough to run the first version without all that(?), it is probably even worse on slower systems than mine.

Yes, the aquarium is an ongoing project. Perhaps someday it will have the Nautilus or giant squid making random visits.

Cool. So my machine is not so fast after all. Cool. You mentioned 'jerky' and 'flicker'? Saw no evidence of this. Everything runs quite smoothly. A squid you say? That would be cool. Perhaps a predator or two? lol

Fast or not, jerky or not, the aquarium is STILL a great job.

J

Johnno

IF your machine runs the first version without flicker OR jerky fish AND the kelp sways smoothly back and forth THEN your machine is faster than mine!!! AND you don't need the second version made because of the flicker and jerking the first version plays on my system.

but we already knew this from SdlBasic comparisons ;-))