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

bplus · « **on:** July 30, 2018, 11:21:18 pm »

Here is update of old favorite of mine. No other BASIC I've run this on can handle full screen kelp drawing.

Code: QB64: [Select]

_TITLE "Aquarium with swaying kelp"
'QB64 X 64 version 1.2 20180228/86  from git b301f92
'2018-07-30 translated 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?
 
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'   Press SpaceBar to grow new Kelp Bed, press escape to quit
 
'   Press + for more fish, - for less fish
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
CONST xmax = 1260
CONST ymax = 720
CONST swayLimit = 6
CONST maxFish = 500
 
SCREEN _NEWIMAGE(xmax, ymax, 32)
_FULLSCREEN
RANDOMIZE TIMER
 
TYPE fishType
    x AS SINGLE
    y AS SINGLE
    dx AS SINGLE
    sz AS SINGLE
    red AS SINGLE
    green AS SINGLE
    blue AS SINGLE
END TYPE
 
DIM SHARED kelp(xmax, ymax), f(maxFish) AS fishType
DIM SHARED fishFactor, restartFlag, nFish
 
nFish = 25 'for starters
 
restart:
restartFlag = 0
fishFactor = 50 ^ (1 / nFish) 'let's use a power lesson
growKelp
FOR i = 0 TO nFish
    newFish i, 1
NEXT
aquarium
IF restartFlag THEN GOTO restart
 
 
SUB growKelp ()
    ERASE kelp
    kelps = rand(25, 45)
    FOR x = 1 TO kelps
        kelp(rand(0, xmax), ymax) = rand(1, 15)
    NEXT
    FOR y = ymax - 1 TO 0 STEP -1
        FOR x = 0 TO xmax
            IF kelp(x, y + 1) THEN
                r = rand(1, 23)
                SELECT CASE r
                    CASE 1, 2, 3, 18 '1 branch node
                        IF x - 1 >= 0 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 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                    CASE 13, 14, 15, 16, 17, 19 '2 branch node
                        IF x - 1 >= 0 THEN kelp(x - 1, y) = kelp(x, y + 1)
                        IF x + 1 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                END SELECT
            END IF
        NEXT
    NEXT
END SUB
 
SUB showKelp (z)
    FOR y = 0 TO ymax
        dy = (_PI(y / 180) + z) * (1 - y / ymax)
        xoff = swayLimit * SIN(dy)
        FOR x = 0 TO xmax
            IF kelp(x, y) > 0 AND kelp(x, y) < 16 THEN
                COLOR _RGB32(0, kelp(x, y) * 16, 0)
                recf x + xoff, y, x + xoff + 1, y + 1
            END IF
        NEXT
    NEXT
END SUB
 
SUB newFish (i, tfStart)
    'the size and speed of a fish depends upon it's i number
    'it only has to be setup if tfStart
    IF tfStart THEN 'starting app place fish anywhere in sight
        f(i).sz = 10 + fishFactor ^ i
        f(i).dx = .2 * f(i).sz
        f(i).x = rand(0, xmax)
        IF RND < .5 THEN f(i).dx = f(i).dx * -1
    ELSE
        'choose a side to come in from fix x and dx accordingly
        IF RND < .5 THEN
            IF f(i).dx < 0 THEN f(i).dx = f(i).dx * -1
            f(i).x = 0
        ELSE
            IF f(i).dx > 0 THEN f(i).dx = f(i).dx * -1
            f(i).x = xmax
        END IF
    END IF
    f(i).y = rand(f(i).sz, ymax - f(i).sz)
    f(i).red = RND ^ 2: f(i).green = RND ^ 2: f(i).blue = RND ^ 2
END SUB
 
SUB drawfish (i)
    f(i).x = f(i).x + f(i).dx
    IF f(i).x < 0 - 1.5 * f(i).sz OR f(i).x > xmax + 1.5 * f(i).sz THEN newFish i, 0
    f(i).y = f(i).y + rand(-4, 4) * f(i).sz / 60
    FOR ra = 1 TO f(i).sz
        COLOR _RGB32(127 + 127 * SIN(f(i).red * .5 * ra), 127 + 127 * SIN(f(i).green * .5 * ra), 127 + 127 * SIN(f(i).blue * .5 * ra))
        IF f(i).dx < 0 THEN
            recf f(i).x + ra, f(i).y - ra, f(i).x + ra, f(i).y + ra
        ELSE
            recf f(i).x - ra, f(i).y - ra, f(i).x - ra, f(i).y + ra
        END IF
    NEXT
    FOR ra = 3 TO .3 * f(i).sz
        COLOR _RGB32(127 + 127 * SIN(f(i).red * 2 * ra), 127 + 127 * SIN(f(i).green * 2 * ra), 127 + 127 * SIN(f(i).blue * 2 * ra))
        IF f(i).dx < 0 THEN
            recf f(i).x + f(i).sz + ra, f(i).y - ra, f(i).x + f(i).sz + ra, f(i).y + ra
        ELSE
            recf f(i).x - f(i).sz - ra, f(i).y - ra, f(i).x - f(i).sz - ra, f(i).y + ra
        END IF
    NEXT
    IF f(i).dx < 0 THEN
        COLOR _RGB32(0, 0, 0): fcirc f(i).x + .2 * f(i).sz, f(i).y, .09 * f(i).sz
        COLOR _RGB32(255, 255, 0): CIRCLE (f(i).x + .2 * f(i).sz, f(i).y), .07 * f(i).sz
    ELSE
        COLOR _RGB32(0, 0, 0): fcirc f(i).x - .2 * f(i).sz, f(i).y, .09 * f(i).sz
        COLOR _RGB32(255, 255, 0): CIRCLE (f(i).x - .2 * f(i).sz, f(i).y), .07 * f(i).sz
    END IF
END SUB
 
SUB aquarium ()
    dz = .25: z = 0: hf = INT(9 * nFish / 10)
    WHILE NOT _KEYDOWN(27)
        IF _KEYDOWN(32) THEN restartFlag = 1: EXIT SUB
        IF _KEYDOWN(43) THEN 'plus more fish
            IF 2 * nFish <= maxFish THEN nFish = 2 * nFish + 5: restartFlag = 1: EXIT SUB
        END IF
        IF _KEYDOWN(95) THEN 'minus less fish
            IF nFish \ 2 >= 5 THEN nFish = nFish \ 2: restartFlag = 1: EXIT SUB
        END IF
 
        FOR i = 0 TO ymax
            COLOR _RGB32(0, 0, 255 - (i / ymax) * 255)
            ln 0, i, xmax, i
        NEXT
        FOR i = 0 TO hf 'draw some fish behind kelp
            drawfish (i)
        NEXT
        z = z + dz
        IF z > swayLimit OR z < -1 * swayLimit THEN dz = dz * -1
        showKelp (z)
        FOR i = hf + 1 TO nFish 'draw the rest of the fish
            drawfish (i)
        NEXT
 
        _DISPLAY
        _LIMIT 10
    WEND
END SUB
 
FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
 
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG
 
    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0
 
    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF
 
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB
 
SUB ln (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2)
END SUB
 
SUB rec (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2), , B
END SUB
 
SUB recf (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2), , BF
END SUB
 
 

Ashish · « **Reply #1 on:** August 01, 2018, 07:01:09 am »

This is wonderful!

johnno56 · « **Reply #2 on:** August 01, 2018, 08:28:29 am »

Well... That program almost made me sick! Oh. The program is great... it's the swaying of the kelp... back and forth; back and forth.....

Great job!!

J

bplus · « **Reply #3 on:** August 01, 2018, 09:13:07 am »

Thanks guys!

I never noticed the seasickness until going full screen, watch it for awhile and then look at something steady...

I thought spinning was bad, ha!

FellippeHeitor · « **Reply #4 on:** August 01, 2018, 11:56:35 am »

Cool effect, bplus!

bplus · « **Reply #5 on:** August 02, 2018, 10:03:23 am »

Well with such encouragement... version 2

Quote

' 2018-08-01 kPalette added and kelp background, new size kelp at front level.
' Fish evoled:
' 1. fish have pectorial fins now stroking
' 2. hey a new fish type!

Code: QB64: [Select]

_TITLE "Aquarium with swaying kelp"
'QB64 X 64 version 1.2 20180228/86  from git b301f92
 
'history:
'aquarium with swaying kelp2.sdlbas [B+=MGA] 2016-10-14
' thanks to Andy Amaya for Kelp growing idea
' Aquarium with swaying kelp.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-16
'2016-10-15 kelp2 grows faster, mod or fix sway?
'2018-07-30 translated to QB64
' size and speed depends on i, use fishFactor and powers of i
' more fish behind kelp
' 2018-08-01 kPalette added and kelp background, new size kelp at fromt level.
' Fish evoled:
' 1. fish have pectorial fins now stroking
' 2. hey a new fish type!
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'   Press SpaceBar to grow new Kelp Bed, press escape to quit
 
'   Press + for more fish, - for less fish
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
CONST xmax = 1260
CONST ymax = 720
CONST swayLimit = 3
CONST maxFish = 1024
 
SCREEN _NEWIMAGE(xmax, ymax, 32)
_FULLSCREEN
RANDOMIZE TIMER
 
TYPE fishType
    x AS SINGLE
    y AS SINGLE
    dx AS SINGLE
    sz AS SINGLE
    stroke AS INTEGER
    type AS INTEGER
    red AS SINGLE
    green AS SINGLE
    blue AS SINGLE
END TYPE
 
DIM SHARED kelp(xmax, ymax), f(maxFish) AS fishType
DIM SHARED fishFactor, restartFlag, nFish, back&
tColor = 0
DIM SHARED kPalette(287) AS LONG
FOR g = 15 TO 255 STEP 15
    FOR r = 15 TO .5 * g STEP 15
        kPalette(tColor) = _RGB32(0, .6 * g, 0)
        tColor = tColor + 1
        kPalette(tColor) = _RGB32(.2 * r, .6 * g, 0)
        tColor = tColor + 1
        kPalette(tColor) = _RGB32(0, .6 * g, .1 * r)
        tColor = tColor + 1
        kPalette(tColor) = _RGB32(.2 * r, .6 * g, .1 * r)
        tColor = tColor + 1
    NEXT
NEXT
back& = _NEWIMAGE(xmax, ymax, 32)
nFish = 64 'for starters
 
restart:
restartFlag = 0
makeBackground
growKelp
fishFactor = 50 ^ (1 / nFish) 'let's use a power lesson
FOR i = 1 TO nFish
    newFish i, 1
NEXT
aquarium
IF restartFlag THEN GOTO restart
 
SUB makeBackground ()
    _DEST back&
    ERASE kelp
    FOR i = 0 TO ymax
        COLOR _RGB32(0, 0, 255 - (i / ymax) * 255)
        ln 0, i, xmax, i
    NEXT
    kelps = rand(100, 200)
    FOR x = 1 TO kelps
        kelp(rand(0, xmax), ymax) = rand(1, 160)
    NEXT
    FOR y = ymax - 1 TO 0 STEP -1
        FOR x = 0 TO xmax
            IF kelp(x, y + 1) THEN
                r = rand(1, 23)
                SELECT CASE r
                    CASE 1, 2, 3, 18 '1 branch node
                        IF x - 1 >= 0 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 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                    CASE 13, 14, 15, 16, 17, 19 '2 branch node
                        IF x - 1 >= 0 THEN kelp(x - 1, y) = kelp(x, y + 1)
                        IF x + 1 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                END SELECT
            END IF
        NEXT
    NEXT
    FOR y = 0 TO ymax
        FOR x = 0 TO xmax
            IF kelp(x, y) > 0 THEN
                COLOR kPalette(kelp(x, y))
                frec x, y, x + 1, y + 1
            END IF
        NEXT
    NEXT
    _DEST 0
END SUB
 
SUB growKelp ()
    ERASE kelp
    kelps = rand(7, 15)
    FOR x = 1 TO kelps
        kelp(rand(0, .5 * xmax), ymax) = 3 * x + x MOD 4
    NEXT
    FOR y = ymax - 1 TO 0 STEP -1
        FOR x = 0 TO xmax
            IF kelp(x, y + 1) THEN
                r = rand(1, 23)
                SELECT CASE r
                    CASE 1, 2, 3, 18 '1 branch node
                        IF x - 1 >= 0 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 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                    CASE 13, 14, 15, 16, 17, 19 '2 branch node
                        IF x - 1 >= 0 THEN kelp(x - 1, y) = kelp(x, y + 1)
                        IF x + 1 <= xmax THEN kelp(x + 1, y) = kelp(x, y + 1)
                END SELECT
            END IF
        NEXT
    NEXT
END SUB
 
SUB showKelp (z)
    FOR y = 0 TO .5 * ymax
        dy = (_PI(y / 100) + z) * (1 - y / (.5 * ymax))
        xoff = swayLimit * SIN(dy)
        FOR x = 0 TO .5 * xmax
            IF kelp(x, y) > 0 THEN
                rc = x * y MOD 4
                SELECT CASE rc
                    CASE IS = 0: COLOR kPalette(kelp(x, y))
                    CASE IS = 1: COLOR kPalette(kelp(x, y) + 5)
                    CASE IS = 2: COLOR kPalette(kelp(x, y) + 10)
                    CASE ELSE: COLOR kPalette(kelp(x, y) + 15)
                END SELECT
                'IF y < RND * .25 * ymax / 1.5 AND RND < .3 THEN xxoff = xoff * RND ELSE xxoff = xoff
                frec x * 2 + xoff - 1, y * 2 - 1, x * 2 + xoff + 2, y * 2 + 2
                COLOR kPalette(kelp(x, y))
                fcirc x * 2 + xoff, y * 2, 1
            END IF
        NEXT
    NEXT
END SUB
 
SUB newFish (i, tfStart)
    'the size and speed of a fish depends upon it's i number
    'it only has to be setup if tfStart
    IF tfStart THEN 'starting app place fish anywhere in sight
        f(i).sz = 10 + fishFactor ^ i
        f(i).dx = .2 * f(i).sz
        f(i).x = rand(0, xmax)
        IF RND < .5 THEN f(i).dx = f(i).dx * -1
        f(i).stroke = rand(0, 3)
    ELSE
        'choose a side to come in from fix x and dx accordingly
        IF RND < .5 THEN
            IF f(i).dx < 0 THEN f(i).dx = f(i).dx * -1
            f(i).x = 0
        ELSE
            IF f(i).dx > 0 THEN f(i).dx = f(i).dx * -1
            f(i).x = xmax
        END IF
        f(i).stroke = 0
    END IF
    f(i).type = rand(0, 1)
    f(i).y = rand(f(i).sz, ymax - f(i).sz)
    f(i).red = RND ^ 2: f(i).green = RND ^ 2: f(i).blue = RND ^ 2
END SUB
 
SUB drawfish (i)
    f(i).x = f(i).x + f(i).dx
    IF f(i).x < 0 - 1.5 * f(i).sz OR f(i).x > xmax + 1.5 * f(i).sz THEN newFish i, 0
    f(i).y = f(i).y + rand(-4, 4) * f(i).sz / 60
    f(i).stroke = (f(i).stroke + 1) MOD 4
    FOR ra = 1 TO f(i).sz
        COLOR _RGB32(127 + 127 * SIN(f(i).red * .5 * ra), 127 + 127 * SIN(f(i).green * .5 * ra), 127 + 127 * SIN(f(i).blue * .5 * ra))
        IF f(i).dx < 0 THEN
            IF f(i).type AND ra > .5 * f(i).sz THEN
                frec f(i).x + ra, f(i).y - .7 * f(i).sz + .7 * ra, f(i).x + ra, f(i).y + .7 * f(i).sz - .7 * ra
            ELSE
                frec f(i).x + ra, f(i).y - ra, f(i).x + ra, f(i).y + ra
            END IF
        ELSE
            IF f(i).type AND ra > .5 * f(i).sz THEN
                frec f(i).x - ra, f(i).y - .7 * f(i).sz + .7 * ra, f(i).x - ra, f(i).y + .7 * f(i).sz - .7 * ra
            ELSE
                frec f(i).x - ra, f(i).y - ra, f(i).x - ra, f(i).y + ra
            END IF
        END IF
    NEXT
    FOR ra = 3 TO .3 * f(i).sz
        COLOR _RGB32(127 + 127 * SIN(f(i).red * 2 * ra), 127 + 127 * SIN(f(i).green * 2 * ra), 127 + 127 * SIN(f(i).blue * 2 * ra))
        IF f(i).dx < 0 THEN
            frec f(i).x + f(i).sz + ra, f(i).y - ra, f(i).x + f(i).sz + ra, f(i).y + ra
        ELSE
            frec f(i).x - f(i).sz - ra, f(i).y - ra, f(i).x - f(i).sz - ra, f(i).y + ra
        END IF
    NEXT
    IF f(i).dx < 0 THEN
        COLOR _RGB32(0, 0, 0): fcirc f(i).x + .2 * f(i).sz, f(i).y, .09 * f(i).sz
        COLOR _RGB32(255, 255, 0): CIRCLE (f(i).x + .2 * f(i).sz, f(i).y), .07 * f(i).sz
    ELSE
        COLOR _RGB32(0, 0, 0): fcirc f(i).x - .2 * f(i).sz, f(i).y, .09 * f(i).sz
        COLOR _RGB32(255, 255, 0): CIRCLE (f(i).x - .2 * f(i).sz, f(i).y), .07 * f(i).sz
    END IF
    COLOR _RGBA32(255, 255, 255, 100)
    IF f(i).dx < 0 THEN
        SELECT CASE f(i).stroke
            CASE 0: fEllipse f(i).x + .5 * f(i).sz, f(i).y + .2 * f(i).sz, .01 * f(i).sz, .1 * f(i).sz
            CASE 1: fEllipse f(i).x + .55 * f(i).sz, f(i).y + .2 * f(i).sz, .07 * f(i).sz, .1 * f(i).sz
            CASE 2: fEllipse f(i).x + .6 * f(i).sz, f(i).y + .2 * f(i).sz, .15 * f(i).sz, .1 * f(i).sz
            CASE 3: fEllipse f(i).x + .5 * f(i).sz, f(i).y + .2 * f(i).sz, .07 * f(i).sz, .1 * f(i).sz
        END SELECT
    ELSE
        SELECT CASE f(i).stroke
            CASE 0: fEllipse f(i).x - .5 * f(i).sz, f(i).y + .2 * f(i).sz, .01 * f(i).sz, .1 * f(i).sz
            CASE 1: fEllipse f(i).x - .55 * f(i).sz, f(i).y + .2 * f(i).sz, .07 * f(i).sz, .1 * f(i).sz
            CASE 2: fEllipse f(i).x - .6 * f(i).sz, f(i).y + .2 * f(i).sz, .15 * f(i).sz, .1 * f(i).sz
            CASE 3: fEllipse f(i).x - .5 * f(i).sz, f(i).y + .2 * f(i).sz, .07 * f(i).sz, .1 * f(i).sz
        END SELECT
    END IF
END SUB
 
SUB aquarium ()
    dz = .25: z = 0: hf = INT(9 * nFish / 10)
    WHILE NOT _KEYDOWN(27)
        IF _KEYDOWN(32) THEN restartFlag = 1: EXIT SUB
        IF _KEYDOWN(43) THEN 'plus more fish
            IF 2 * nFish <= maxFish THEN nFish = 2 * nFish: restartFlag = 1: EXIT SUB
        END IF
        IF _KEYDOWN(95) THEN 'minus less fish
            IF nFish / 2 >= 2 THEN nFish = nFish / 2: restartFlag = 1: EXIT SUB
        END IF
        _PUTIMAGE , back&, 0
        FOR i = 1 TO hf 'draw some fish behind kelp
            drawfish (i)
        NEXT
        z = z + dz
        IF z > swayLimit OR z < -1 * swayLimit THEN dz = dz * -1
        showKelp z
        FOR i = hf + 1 TO nFish 'draw the rest of the fish
            drawfish (i)
        NEXT
        COLOR _RGB32(255, 255, 255), _RGB(0, 0, 98)
        _PRINTSTRING (10, 10), LTRIM$(STR$(nFish))
        _DISPLAY
        _LIMIT 12
    WEND
END SUB
 
FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
 
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG
 
    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0
 
    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF
 
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB
 
SUB ln (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2)
END SUB
 
SUB rec (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2), , B
END SUB
 
SUB frec (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2), , BF
END SUB
 
SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
    DIM scale AS SINGLE, x AS LONG, y AS LONG
    scale = yRadius / xRadius
    LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    FOR x = 1 TO xRadius
        y = scale * SQR(xRadius * xRadius - x * x)
        LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
    NEXT
END SUB
 
 

johnno56 · « **Reply #6 on:** August 02, 2018, 07:51:28 pm »

Nice... Now where did I put my Dramamine?... lol Very cool indeed...

euklides · « **Reply #7 on:** August 07, 2018, 11:42:00 am »

Very nice... Where is the shark ?

bplus · « **Reply #8 on:** August 09, 2018, 10:05:13 am »

Quote from: euklides on August 07, 2018, 11:42:00 am

Very nice... Where is the shark ?

:)

I would love other people to contribute fish types, they could use these as parameters to a drawing routine:
TYPE fishType
x AS SINGLE
y AS SINGLE
dx AS SINGLE
sz AS SINGLE
stroke AS INTEGER
type AS INTEGER
red AS SINGLE
green AS SINGLE
blue AS SINGLE
END TYPE

Since this type includes a fish type, I could just add SELECT CASE block in the drawFish routine for adding fish or sharks or starfish or... maybe not whales. I guess there would be some sort of maximum size to allow. I would prefer a drawing routine as opposed to adding images as that would be in the spirit of this aquarium program.

So, so far the sharks are just in our imaginations... ;)

FellippeHeitor · « **Reply #9 on:** August 09, 2018, 12:27:06 pm »

I feel represented by SUB fEllipse!

bplus · « **Reply #10 on:** August 10, 2018, 12:59:02 am »

:-)) Speaking of representing, here is a handy drawing tool that may help with fins, it won't leak PAINT:

Code: QB64: [Select]

 
'use radians
SUB mArc (x, y, r, raStart, raStop, c AS _UNSIGNED LONG)
    'x, y origin, r = radius, c = color
 
    'raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached
 
    IF raStop < raStart THEN
        mArc x, y, r, raStart, _PI(2), c
        mArc x, y, r, 0, raStop, c
    ELSE
        ' modified to easier way suggested by Steve
        'Why was the line method not good? I forgot.
        al = _PI * r * r * (raStop - raStart) / _PI(2)
        FOR a = raStart TO raStop STEP 1 / al
            PSET (x + r * COS(a), y + r * SIN(a)), c
        NEXT
    END IF
END SUB
 

News:

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

bplus

Aquarium with swaying kelp

Ashish

Re: Aquarium with swaying kelp

johnno56

Re: Aquarium with swaying kelp

bplus

Re: Aquarium with swaying kelp

FellippeHeitor

Re: Aquarium with swaying kelp

bplus

Re: Aquarium with swaying kelp

johnno56

Re: Aquarium with swaying kelp

euklides

Re: Aquarium with swaying kelp

bplus

Re: Aquarium with swaying kelp

FellippeHeitor

Re: Aquarium with swaying kelp

bplus

Re: Aquarium with swaying kelp