Author Topic: Morph Curve (Read 5029 times)

bplus · « **on:** January 27, 2019, 10:23:28 pm »

That Paul Dunn does some cool stuff!

Code: QB64: [Select]

_TITLE "Morph Curve" 'for QB64 B+ 2019-01-27
' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
'from SpecBAS version Paul Dunn Dec 2, 2015
'[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
 
'prep
CONST xmax = 700
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
pts = 12000: interps = 20
REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
FOR n = 1 TO interps
    i(n) = SIN(n / interps * (_PI / 2))
NEXT
 
'main
n = 0: m = 0: rmode = 0
WHILE 1
    c = 0
    IF INKEY$ = " " THEN rmode = 1
    IF rmode = 0 THEN
        n = n + 1
        IF n > 12 THEN n = 0: m = m + 1
        IF m > 12 THEN rmode = 1
    END IF
    IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
    FOR t = 0 TO 2 * _PI STEP st
 
        q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
        q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
        c = c + 1
    NEXT
    q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
    CLS
    PRINT "m = "; m; "  n = "; n; "  spacebar skips to random mode."
    IF l = 0 THEN
        drawpoly q()
        l = l + 1
        _DISPLAY
        _DELAY 10 / 1000
    ELSE
        FOR t = 1 TO interps
            CLS
            PRINT "m = "; m; "  n = "; n;
            IF rmode <> 1 THEN PRINT "  spacebar skips to random mode." ELSE PRINT
            FOR nn = 0 TO pts
                s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
                s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
            NEXT
            s(nn, 0) = s(0, 0)
            s(nn, 1) = s(0, 1)
            drawpoly s()
            _DISPLAY
            _DELAY 10 / 1000
        NEXT
    END IF
    _DISPLAY
    _DELAY 100 / 1000
    'p() = q()
    REDIM p(LBOUND(q) TO UBOUND(q), 1)
    FOR i = LBOUND(q) TO UBOUND(q)
        p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
    NEXT
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
SUB drawpoly (a())
    FOR i = LBOUND(a) TO UBOUND(a) - 1
        LINE (a(i, 0), a(i, 1))-(a(i + 1, 0), a(i + 1, 1))
    NEXT
    LINE (a(UBOUND(a), 0), a(UBOUND(a), 1))-(a(LBOUND(a), 0), a(LBOUND(a), 1))
END SUB
 

Petr · « **Reply #1 on:** January 28, 2019, 01:31:22 am »

Hell, that's really good!

johnno56 · « **Reply #2 on:** January 28, 2019, 05:29:55 pm »

Cool... Reminds me of a bowl of spaghetti... Mmm... Pasta.

bplus · « **Reply #3 on:** January 28, 2019, 05:33:07 pm »

Thicker pasta and colorized pasta sauce (Hi Johnno!):

Code: QB64: [Select]

_TITLE "Morph Curve Colorized" 'for QB64 B+ 2019-01-28
' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
'from SpecBAS version Paul Dunn Dec 2, 2015
'[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
 
'prep
CONST xmax = 700
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
DIM SHARED plasmaN, plasmaR, plasmaG, plasmaB
pts = 12000: interps = 20
REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
FOR n = 1 TO interps
    i(n) = SIN(n / interps * (_PI / 2))
NEXT
 
'main
n = 0: m = 0: rmode = 0
WHILE 1
    resetPlasma
    c = 0
    IF INKEY$ = " " THEN rmode = 1
    IF rmode = 0 THEN
        n = n + 1
        IF n > 12 THEN n = 0: m = m + 1
        IF m > 12 THEN rmode = 1
    END IF
    IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
    FOR t = 0 TO 2 * _PI STEP st
        q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
        q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
        c = c + 1
    NEXT
    q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
    CLS
    PRINT "m = "; m; "  n = "; n; "  spacebar skips to random mode."
    IF l = 0 THEN
        drawpoly q()
        l = l + 1
        _DISPLAY
        _DELAY 10 / 1000
    ELSE
        FOR t = 1 TO interps
            CLS
            PRINT "m = "; m; "  n = "; n;
            IF rmode <> 1 THEN PRINT "  spacebar skips to random mode." ELSE PRINT
            FOR nn = 0 TO pts
                s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
                s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
            NEXT
            s(nn, 0) = s(0, 0)
            s(nn, 1) = s(0, 1)
            drawpoly s()
            _DISPLAY
            _DELAY 10 / 1000
        NEXT
    END IF
    _DISPLAY
    _DELAY 100 / 1000
    'p() = q()
    REDIM p(LBOUND(q) TO UBOUND(q), 1)
    FOR i = LBOUND(q) TO UBOUND(q)
        p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
    NEXT
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
SUB drawpoly (a())
    FOR i = LBOUND(a) TO UBOUND(a) - 1
        kl~& = setPlasma~&
        thic a(i, 0), a(i, 1), a(i + 1, 0), a(i + 1, 1), 4, kl~&
    NEXT
    kl~& = setPlasma~&
    thic a(UBOUND(a), 0), a(UBOUND(a), 1), a(LBOUND(a), 0), a(LBOUND(a), 1), 4, kl~&
END SUB
 
SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
    'add filled circles at each end
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    fcirc x1, y1, t2, K
    fcirc x2, y2, t2, K
    a = _ATAN2(y2 - y1, x2 - x1)
    x3 = x1 + t2 * COS(a + _PI(.5))
    y3 = y1 + t2 * SIN(a + _PI(.5))
    x4 = x1 + t2 * COS(a - _PI(.5))
    y4 = y1 + t2 * SIN(a - _PI(.5))
    x5 = x2 + t2 * COS(a + _PI(.5))
    y5 = y2 + t2 * SIN(a + _PI(.5))
    x6 = x2 + t2 * COS(a - _PI(.5))
    y6 = y2 + t2 * SIN(a - _PI(.5))
    filltri x6, y6, x4, y4, x3, y3, K
    filltri x3, y3, x5, y5, x6, y6, K
END SUB
 
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB
 
SUB resetPlasma () 'all globals
    plasmaR = RND ^ 2: plasmaG = RND ^ 2: plasmaB = RND ^ 2: plasmaN = 0
END SUB
 
FUNCTION setPlasma~& () 'all globals
    plasmaN = plasmaN + .01
    setPlasma~& = _RGB32(120 + 84 * SIN(plasmaR * plasmaN), 120 + 84 * SIN(plasmaG * plasmaN), 120 + 84 * SIN(plasmaB * plasmaN))
END FUNCTION
 
'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED 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), K: 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), K, 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), K, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
    WEND
END SUB
 
 

EDIT: adjust thic call to 4 (from 3), as some lines were beady, need even thickness.

johnno56 · « **Reply #4 on:** January 29, 2019, 03:54:23 am »

Much better! Linguini !!

Pete · « **Reply #5 on:** January 29, 2019, 10:32:28 am »

Now Mark just needs to add balls... Meat balls!

Pete :D

bplus · « **Reply #6 on:** January 29, 2019, 11:29:16 am »

Quote from: Pete on January 29, 2019, 10:32:28 am

Now Mark just needs to add balls... Meat balls!

Pete :D

Dang! why didn't I think of that? hmm...

Thanks Pete :D

Pete · « **Reply #7 on:** January 29, 2019, 12:42:28 pm »

Don't worry about the pasta. I'll keep "stirring the pot" while you bang out your meatballs.

Pete :D

bplus · « **Reply #8 on:** January 29, 2019, 12:44:42 pm »

OK I have added meatballs to the plate. They are red unless you look at them. ;-))

Code: QB64: [Select]

_TITLE "Morph Curve Colorized and Balled" 'for QB64 B+ 2019-01-29
' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
'from SpecBAS version Paul Dunn Dec 2, 2015
'[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
 
'2019-01-29 add magic red meat balls to the plate
 
'prep
CONST xmax = 700
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 20
DIM SHARED plasmaN, plasmaR, plasmaG, plasmaB
pts = 12000: interps = 20
REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
FOR n = 1 TO interps
    i(n) = SIN(n / interps * (_PI / 2))
NEXT
 
'main
n = 0: m = 0: rmode = 0
WHILE 1
    resetPlasma
    c = 0
    IF INKEY$ = " " THEN rmode = 1
    IF rmode = 0 THEN
        n = n + 1
        IF n > 12 THEN n = 0: m = m + 1
        IF m > 12 THEN rmode = 1
    END IF
    IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
    FOR t = 0 TO 2 * _PI STEP st
        q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
        q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
        c = c + 1
    NEXT
    q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
    magicRedBalls
    IF rmode <> 1 THEN
        _TITLE "Morph Curve: m =" + STR$(m) + ",  n =" + STR$(n) + ",  spacebar skips to random mode."
    ELSE
        _TITLE "Morph Curve: m =" + STR$(m) + ",  n =" + STR$(n)
    END IF
    IF l = 0 THEN
        drawpoly q()
        l = l + 1
        _DISPLAY
        _DELAY 10 / 1000
    ELSE
        FOR t = 1 TO interps
            magicRedBalls
            FOR nn = 0 TO pts
                s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
                s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
            NEXT
            s(nn, 0) = s(0, 0)
            s(nn, 1) = s(0, 1)
            drawpoly s()
            _DISPLAY
            _DELAY 10 / 1000
        NEXT
    END IF
    _DISPLAY
    _DELAY 200 / 1000
    'p() = q()
    REDIM p(LBOUND(q) TO UBOUND(q), 1)
    FOR i = LBOUND(q) TO UBOUND(q)
        p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
    NEXT
WEND
 
FUNCTION rand (lo, hi)
    rand = (RND * (hi - lo + 1)) \ 1 + lo
END FUNCTION
 
SUB drawpoly (a())
    FOR i = LBOUND(a) TO UBOUND(a) - 1
        kl~& = setPlasma~&
        thic a(i, 0), a(i, 1), a(i + 1, 0), a(i + 1, 1), 4, kl~&
    NEXT
    kl~& = setPlasma~&
    thic a(UBOUND(a), 0), a(UBOUND(a), 1), a(LBOUND(a), 0), a(LBOUND(a), 1), 4, kl~&
END SUB
 
SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
    'add filled circles at each end
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    fcirc x1, y1, t2, K
    fcirc x2, y2, t2, K
    a = _ATAN2(y2 - y1, x2 - x1)
    x3 = x1 + t2 * COS(a + _PI(.5))
    y3 = y1 + t2 * SIN(a + _PI(.5))
    x4 = x1 + t2 * COS(a - _PI(.5))
    y4 = y1 + t2 * SIN(a - _PI(.5))
    x5 = x2 + t2 * COS(a + _PI(.5))
    y5 = y2 + t2 * SIN(a + _PI(.5))
    x6 = x2 + t2 * COS(a - _PI(.5))
    y6 = y2 + t2 * SIN(a - _PI(.5))
    filltri x6, y6, x4, y4, x3, y3, K
    filltri x3, y3, x5, y5, x6, y6, K
END SUB
 
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB
 
SUB resetPlasma () 'all globals
    plasmaR = RND ^ 2: plasmaG = RND ^ 2: plasmaB = RND ^ 2: plasmaN = 0
END SUB
 
FUNCTION setPlasma~& () 'all globals
    plasmaN = plasmaN + .01
    setPlasma~& = _RGB32(120 + 84 * SIN(plasmaR * plasmaN), 120 + 84 * SIN(plasmaG * plasmaN), 120 + 84 * SIN(plasmaB * plasmaN))
END FUNCTION
 
'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED 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), K: 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), K, 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), K, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
    WEND
END SUB
 
SUB magicRedBalls
    COLOR _RGBA32(128, 128, 128, 100), _RGB32(120, 0, 0)
    CLS
    FOR i = 25 TO xmax STEP 50
        LINE (i, 0)-(i + 10, ymax), , BF
        LINE (0, i)-(xmax, i + 10), , BF
    NEXT
    COLOR
    FOR y = 30 TO ymax STEP 50
        FOR x = 30 TO xmax STEP 50
            fcirc x, y, 10, _RGB32(128, 128, 128)
        NEXT
    NEXT
    CIRCLE (xmax / 2, ymax / 2), 330, _RGB32(199, 199, 199)
    CIRCLE (xmax / 2, ymax / 2), 410, _RGB32(199, 199, 199)
    PAINT (xmax / 2, 5), _RGB32(180, 200, 180), _RGB32(199, 199, 199)
    PAINT (10, 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
    PAINT (xmax - 10, 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
    PAINT (10, ymax - 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
    PAINT (xmax - 10, ymax - 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
    FOR r = 0 TO 20
        CIRCLE (xmax / 2, ymax / 2), 330 + r, _RGB32(100 + 5 * r, 100 + 5 * r, 100 + 5 * r)
    NEXT
    CIRCLE (xmax / 2, ymax / 2), 408, _RGB32(204, 205, 205)
END SUB
 

Pete · « **Reply #9 on:** January 29, 2019, 12:53:58 pm »

No offense, but that looks more like a cherry pie, and the lattice crust is starting to mold. Oh well, meatballs, pie, what's the difference? I suppose one way you'd be thought of as a master cooker and the other way, well...

Definitely a short-order cook / baker, regardless!

Pete :D

bplus · « **Reply #10 on:** January 29, 2019, 04:27:13 pm »

OK, not meatballs just a plate decoration. Here is the table set:

johnno56 · « **Reply #11 on:** January 29, 2019, 10:32:50 pm »

What?!? No cheese!?

Can you do a roast chicken? oh, or even better, Lasagne... Mmmm...

Pete · « **Reply #12 on:** January 30, 2019, 12:44:16 am »

Yeah Mark. Get in the kitchen and code me a sweater!

Pete :D

News:

Author Topic: Morph Curve (Read 5029 times)

bplus

Morph Curve

Petr

Re: Morph Curve

johnno56

Re: Morph Curve

bplus

Re: Morph Curve

johnno56

Re: Morph Curve

Pete

Re: Morph Curve

bplus

Re: Morph Curve

Pete

Re: Morph Curve

bplus

Re: Morph Curve

Pete

Re: Morph Curve

bplus

Re: Morph Curve

johnno56

Re: Morph Curve

Pete

Re: Morph Curve