October 29, 2020, 02:12:39 AM

Author Topic: Aquarium with swaying kelp  (Read 954 times)

Offline bplus

  • Full Member
  • ***
  • Posts: 146
Aquarium with swaying kelp
« on: November 04, 2019, 03:06:55 AM »
Not bad for a little interpreter!
Code: [Select]
' 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 20
  wend
end

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

Offline Aurel

  • Full Member
  • ***
  • Posts: 185
    • AurelSoft
Re: Aquarium with swaying kelp
« Reply #1 on: November 04, 2019, 07:03:24 AM »
Yo Mark,, yes it is very cool.

You know me, somehow (i am not sure for reason) i don't like qb64 very much
but smallBasic i like  ;)

Offline Dabz

  • Sr. Member
  • ****
  • Posts: 261
  • Is it cos I is ginger?
    • dabzy.co.uk
Re: Aquarium with swaying kelp
« Reply #2 on: November 04, 2019, 12:11:56 PM »
Nice! :)

Dabz
Intel Core i5 6400 2.7GHz, NVIDIA GeForce GTX 1070 (8GB), 16Gig DDR4 RAM, 256GB SSD, 1TB HDD, Windows 10 64bit

Offline MikeHart

  • Hero Member
  • *****
  • Posts: 725
  • Cerberus-X Developer
    • Whitesky Games
Re: Aquarium with swaying kelp
« Reply #3 on: November 04, 2019, 04:37:28 PM »
Yo Mark,, yes it is very cool.

You know me, somehow (i am not sure for reason) i don't like qb64 very much
but smallBasic i like  ;)
What do you like about it?

Offline bplus

  • Full Member
  • ***
  • Posts: 146
Re: Aquarium with swaying kelp
« Reply #4 on: November 04, 2019, 05:19:43 PM »
I know what Aurel likes, he likes 100 line interpreters!

Who wouldn't?

Offline Aurel

  • Full Member
  • ***
  • Posts: 185
    • AurelSoft
Re: Aquarium with swaying kelp
« Reply #5 on: November 05, 2019, 04:16:45 PM »
Quote
I know what Aurel likes, he likes 100 line interpreters!
yes ...Bingo  :D

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal