### Author Topic: Dropping Balls  (Read 675 times)

#### bplus

##### Dropping Balls
« on: March 31, 2018, 01:54:05 AM »
Misunderstanding what Make71 wanted, I reworked my ball handling for bounces and collisions. Not bad for zero vectors or dot products... are you a fake physics fan?
Code: [Select]
`_TITLE "Dropping Balls by bplus 2018-03-31"RANDOMIZE TIMERCONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)gravity = 1balls = 8DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls    r(i) = rand(15, 20)    x(i) = rand(r(i), xmax - r(i))    y(i) = rand(r(i), ymax - r(i))    c(i) = rand(1, 15)    dx(i) = rand(1, 3) * rdir    dy(i) = rand(10, 20)    rr(i) = rand(200, 255)    gg(i) = rand(200, 255)    bb(i) = rand(200, 255)NEXTWHILE 1    CLS    FOR i = 1 TO balls        'ready for collision        a(i) = _ATAN2(dy(i), dx(i))        power = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5        FOR j = i + 1 TO balls            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                EXIT FOR            END IF        NEXT        dx(i) = power * COS(a(i))        dy(i) = power * SIN(a(i))        dy(i) = dy(i) + gravity        x(i) = x(i) + dx(i)        y(i) = y(i) + dy(i) '+ 2 * gravity        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN            x(i) = xmax / 2            y(i) = 0            dx(i) = rand(1, 3) * rdir            dy(i) = 0        END IF        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.8        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc x(i), y(i), rad        NEXT    NEXT    _DISPLAY    _LIMIT 20WENDFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUB`
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### bplus

##### Re: Dropping Balls
« Reply #1 on: March 31, 2018, 10:54:40 AM »
OK most of flaws mostly fixed.
Code: [Select]
`_TITLE "Dropping Balls 2 by bplus 2018-03-31"' attempt to fixRANDOMIZE TIMERCONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60gravity = 1balls = 8DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls    r(i) = rand(15, 20)    x(i) = rand(r(i), xmax - r(i))    y(i) = rand(r(i), ymax - r(i))    c(i) = rand(1, 15)    dx(i) = rand(0, 3) * rdir    dy(i) = rand(10, 20)    rr(i) = rand(200, 255)    gg(i) = rand(200, 255)    bb(i) = rand(200, 255)NEXTWHILE 1    CLS    FOR i = 1 TO balls        'ready for collision        dy(i) = dy(i) + gravity        a(i) = _ATAN2(dy(i), dx(i))        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5        imoved = 0        FOR j = i + 1 TO balls            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN                imoved = 1                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                'update new dx, dy for i and j balls                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5                power = .7 * (power1 + power2) / 2                dx(i) = power * COS(a(i))                dy(i) = power * SIN(a(i))                dx(j) = power * COS(a(j))                dy(j) = power * SIN(a(j))                x(i) = x(i) + dx(i)                y(i) = y(i) + dy(i)                x(j) = x(j) + dx(j)                y(j) = y(j) + dy(j)                EXIT FOR            END IF        NEXT        IF imoved = 0 THEN            x(i) = x(i) + dx(i)            y(i) = y(i) + dy(i)        END IF        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN            x(i) = xmax / 2 + rand(0, 100) * rdir            y(i) = 0            dx(i) = rand(0, 3) * rdir            dy(i) = 1        END IF        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc x(i), y(i), rad        NEXT    NEXT    _DISPLAY    _LIMIT 20WENDFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUB`
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### bplus

##### Re: Dropping Balls
« Reply #2 on: March 31, 2018, 01:57:00 PM »
Sound effects added, but a little off when lots of sound all at once, still it's fun to listen to:
Code: [Select]
`_TITLE "Dropping Balls 2 w sound by bplus 2018-03-31"' attempt to fixRANDOMIZE TIMERCONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60gravity = 1balls = 8DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls    r(i) = rand(15, 20)    x(i) = rand(r(i), xmax - r(i))    y(i) = rand(r(i), ymax - r(i))    c(i) = rand(1, 15)    dx(i) = rand(0, 3) * rdir    dy(i) = rand(10, 20)    rr(i) = rand(200, 255)    gg(i) = rand(200, 255)    bb(i) = rand(200, 255)NEXTWHILE 1    CLS    FOR i = 1 TO balls        'ready for collision        dy(i) = dy(i) + gravity        a(i) = _ATAN2(dy(i), dx(i))        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5        imoved = 0        FOR j = i + 1 TO balls            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN                imoved = 1                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                'update new dx, dy for i and j balls                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5                power = .7 * (power1 + power2) / 2                dx(i) = power * COS(a(i))                dy(i) = power * SIN(a(i))                dx(j) = power * COS(a(j))                dy(j) = power * SIN(a(j))                x(i) = x(i) + dx(i)                y(i) = y(i) + dy(i)                x(j) = x(j) + dx(j)                y(j) = y(j) + dy(j)                snd 120 + r(i) * 250, r(j) * .15                EXIT FOR            END IF        NEXT        IF imoved = 0 THEN            x(i) = x(i) + dx(i)            y(i) = y(i) + dy(i)        END IF        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN            x(i) = xmax / 2 + rand(0, 100) * rdir            y(i) = 0            dx(i) = rand(0, 3) * rdir            dy(i) = 1        END IF        IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc x(i), y(i), rad        NEXT    NEXT    _DISPLAY    _LIMIT 20WENDFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUBSUB snd (frq, dur)    SOUND frq / 2.2, dur * .01END SUB`
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### FellippeHeitor

• QB64 Developer
• LET IT = BE
##### Re: Dropping Balls
« Reply #3 on: April 01, 2018, 08:19:26 PM »
Love the sound synthesis with SOUND!

#### bplus

##### Re: Dropping Balls
« Reply #4 on: April 03, 2018, 06:39:05 PM »
Dynamically built pyramid pile, thanks to STxAxTIC's help:
Code: [Select]
`_TITLE "Dropping Balls pile attempt bplus 2018-04-03"'attempt to build pile by adjusting drop rate, elasticity, gravity' remove sound and adjust dropping to center of screen' built from Dropping balls 4 w snd and STATIC created 2018-04-3' add STATIC's moving ball before figuring bounce from collision' which was a mod of Dropping Balls 2 w sound posted 2018-03-31RANDOMIZE TIMERCONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60elastic = .5gravity = .5balls = 160DIM x(balls), y(balls), r(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls    r(i) = 15    x(i) = xmax / 2 + (i MOD 2) * 8 - 4    y(i) = 0    dx(i) = 0    dy(i) = 3    rr(i) = rand(200, 255)    gg(i) = rand(200, 255)    bb(i) = rand(200, 255)NEXTmaxBall = 0WHILE 1    CLS    loopCnt = loopCnt + 1    IF loopCnt MOD 17 = 0 THEN        IF maxBall < balls THEN maxBall = maxBall + 1    END IF    COLOR _RGB32(255, 255, 255)    _PRINTSTRING (100, 10), "Balls:" + STR\$(maxBall)    FOR i = 1 TO maxBall        'ready for collision        dy(i) = dy(i) + gravity        a(i) = _ATAN2(dy(i), dx(i))        imoved = 0        FOR j = i + 1 TO maxBall            ' The following is STATIC's adjustment of ball positions if overlapping            ' before calcultion of new positions from collision            ' Displacement vector and its magnitude.  Thanks STxAxTIC !            nx = x(j) - x(i)            ny = y(j) - y(i)            nm = SQR(nx ^ 2 + ny ^ 2)            IF nm < 1 + r(i) + r(j) THEN                nx = nx / nm                ny = ny / nm                ' Regardless of momentum exchange, separate the balls along the lone connecting them.                DO WHILE nm < 1 + r(i) + r(j)                    flub = .001 '* RND                    x(j) = x(j) + flub * nx                    y(j) = y(j) + flub * ny                    x(i) = x(i) - flub * nx                    y(i) = y(i) - flub * ny                    nx = x(j) - x(i)                    ny = y(j) - y(i)                    nm = SQR(nx ^ 2 + ny ^ 2)                    nx = nx / nm                    ny = ny / nm                LOOP                imoved = 1                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                'update new dx, dy for i and j balls                power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5                power = elastic * (power1 + power2) / 2                dx(i) = power * COS(a(i))                dy(i) = power * SIN(a(i))                dx(j) = power * COS(a(j))                dy(j) = power * SIN(a(j))                x(i) = x(i) + dx(i)                y(i) = y(i) + dy(i)                x(j) = x(j) + dx(j)                y(j) = y(j) + dy(j)                'EXIT FOR            END IF        NEXT        IF imoved = 0 THEN            x(i) = x(i) + dx(i)            y(i) = y(i) + dy(i)        END IF        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN            x(i) = xmax / 2 + (i MOD 2) * 4 * r(i) - 2 * r(i)            y(i) = 0            dx(i) = 0            dy(i) = 3        END IF        IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = -dy(i) * elastic '???: x(i) = x(i) + .1 * dx(i)        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc x(i), y(i), rad        NEXT    NEXT    _DISPLAY    _LIMIT 20WENDFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUBSUB snd (frq, dur)    SOUND frq / 2.2, dur * .01END SUB`
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### bplus

##### Re: Dropping Balls
« Reply #5 on: April 04, 2018, 12:19:54 AM »
For perfect pyramids, I offer this:
Code: [Select]
`_TITLE "pyramid of circles 2 by bplus 2018-04-03"CONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60DIM SHARED px(154), py(154), rr(154), gg(154), bb(154)FOR i = 1 TO 153    rr(i) = (RND * 55 + 200)    gg(i) = RND * 55 + 200 * INT(RND * 2)    bb(i) = RND * 55 + 200NEXT'let n = number of circles at base of pilen = 10'let r = radius of each circler = 20'let base be total length of pilebaseLength = 2 * r * n' center pyramid in middle of screenstartx = (xmax - baseLength) / 2'stacking circles that form equilateral triangles at their origins have a height change ofdeltaHeight = r * 3 ^ .5 'r times the sqr(3)FOR row = n TO 1 STEP -1    IF row = n THEN y = ymax - r - 1 ELSE y = y - deltaHeight    FOR col = 1 TO row        x = startx + col * 2 * r - r        index = index + 1        target x, y, index    NEXT    startx = startx + rNEXTSLEEPSUB target (x, y, i)    nx = x: ny = y    ra = _PI(1 / (INT(RND * 7) + 4) + 1 / 2)    dx = 10 * COS(ra)    dy = 10 * SIN(ra)    bounce = 0: rb = INT(RND * 7) + 3    WHILE bounce < rb        IF nx + dx > xmax - 20 OR nx + dx < 20 THEN dx = -dx: bounce = bounce + 1        IF ny + dy > ymax - 20 OR ny + dy < 20 THEN dy = -dy: bounce = bounce + 1        nx = nx + dx: ny = ny + dy    WEND    dx = -dx: dy = -dy    WHILE bounce > 0        IF nx + dx > xmax - 20 OR nx + dx < 20 THEN dx = -dx: bounce = bounce - 1        IF ny + dy > ymax - 20 OR ny + dy < 20 THEN dy = -dy: bounce = bounce - 1        nx = nx + dx: ny = ny + dy        CLS        FOR j = 1 TO i - 1            FOR rad = 20 TO 1 STEP -1                COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)                fcirc px(j), py(j), rad            NEXT        NEXT        FOR rad = 20 TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc nx, ny, rad        NEXT        _DISPLAY        _LIMIT 200    WEND    'last bit    WHILE SQR((nx - x) ^ 2 + (ny - y) ^ 2) > 20        nx = nx + dx        ny = ny + dy        CLS        FOR j = 1 TO i - 1            FOR rad = 20 TO 1 STEP -1                COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)                fcirc px(j), py(j), rad            NEXT        NEXT        FOR rad = 20 TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc nx, ny, rad        NEXT        _DISPLAY        _LIMIT 200    WEND    CLS    FOR j = 1 TO i - 1        FOR rad = 20 TO 1 STEP -1            COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)            fcirc px(j), py(j), rad        NEXT    NEXT    FOR rad = 20 TO 1 STEP -1        COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)        fcirc x, y, rad    NEXT    _DISPLAY    _DELAY .25    px(i) = x: py(i) = yEND SUB'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUB`
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### bplus

##### Re: Dropping Balls
« Reply #6 on: April 04, 2018, 10:36:52 AM »
Dang! I could of drawn a picture with the colored balls AND have the pyramid magically appear as from all the balls flying around slowly finding their resting place. BBL

B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### v

##### Re: Dropping Balls
« Reply #7 on: June 10, 2018, 11:35:11 AM »
How hard would it be to adapt for an hourglass simulator?

#### bplus

##### Re: Dropping Balls
« Reply #8 on: June 10, 2018, 12:41:07 PM »
How hard would it be to adapt for an hourglass simulator?

Wow, it's been just a couple of months since I have posted this but seems like a year. BTW I did finish the BBL later thing and was not impressed and other things came up, so apologies for that if anyone was waiting....

Sand in 2D is easy from this, if I recall, just adjust the bounce factors. But if you want a really cool 3D sim, Ashish would be likely of great help with the GL stuff.

Glass-like graphics effects might be interesting to explore! Does anyone have some simple models?

Oh Petr did some transparency stuff for buttons but need shiny glass reflecting surround colors if not images fit onto the glass surface and distorted according to glass shape. (Yikes more 3D stuff!)
« Last Edit: June 10, 2018, 12:44:53 PM by bplus »
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### Code Hunter

##### Re: Dropping Balls
« Reply #9 on: June 10, 2018, 05:15:37 PM »
How is this for a nice effect?

Code: [Select]
`_TITLE "Dropping Balls 2 w sound by bplus 2018-03-31"' attempt to fixRANDOMIZE TIMERCONST xmax = 800CONST ymax = 600SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60gravity = 1balls = 8DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls  r(i) = rand(15, 20)  x(i) = rand(r(i), xmax - r(i))  y(i) = rand(r(i), ymax - r(i))  c(i) = rand(1, 15)  dx(i) = rand(0, 3) * rdir  dy(i) = rand(10, 20)  rr(i) = rand(200, 255)  gg(i) = rand(200, 255)  bb(i) = rand(200, 255)NEXTWHILE 1  LINE (0, 0)-(xmax, ymax \ 2), _RGB(0, 191, 255), BF  LINE (0, ymax \ 2)-(xmax, ymax), _RGB(192, 192, 192), BF  FOR i = 1 TO balls    'ready for collision    dy(i) = dy(i) + gravity    a(i) = _ATAN2(dy(i), dx(i))    power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5    imoved = 0    FOR j = i + 1 TO balls      IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN        imoved = 1        a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))        a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))        'update new dx, dy for i and j balls        power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5        power = .7 * (power1 + power2) / 2        dx(i) = power * COS(a(i))        dy(i) = power * SIN(a(i))        dx(j) = power * COS(a(j))        dy(j) = power * SIN(a(j))        x(i) = x(i) + dx(i)        y(i) = y(i) + dy(i)        x(j) = x(j) + dx(j)        y(j) = y(j) + dy(j)        snd 120 + r(i) * 250, r(j) * .15        EXIT FOR      END IF    NEXT    IF imoved = 0 THEN      x(i) = x(i) + dx(i)      y(i) = y(i) + dy(i)    END IF    IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN      x(i) = xmax / 2 + rand(0, 100) * rdir      y(i) = 0      dx(i) = rand(0, 3) * rdir      dy(i) = 1    END IF    IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls    IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)    FOR rad = r(i) TO 1 STEP -1      COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)      fcirc x(i), y(i), rad      fcirc x(i), y(i) + map(y(i), 0, ymax, ymax \ 4, 0), rad      'mby = y(i) + map(y(i), 0, ymax, ymax, 0)      'IF mby > ymax \ 2 + r(i) THEN fcirc x(i), mby, rad    NEXT  NEXT  _DISPLAY  _LIMIT 20WENDFUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!END FUNCTIONFUNCTION rand (lo, hi)rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)DIM subRadius AS LONG, RadiusError AS LONGDIM X AS LONG, Y AS LONGsubRadius = ABS(R)RadiusError = -subRadiusX = subRadiusY = 0IF 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), , BFWHILE 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), , BFWENDEND SUBSUB snd (frq, dur)'SOUND frq / 2.2, dur * .01END SUB`
« Last Edit: June 13, 2018, 04:46:28 AM by odin »

#### bplus

##### Re: Dropping Balls
« Reply #10 on: June 10, 2018, 05:32:34 PM »
How is this for a nice effect?

...

I like this much better:
https://www.qb64.org/forum/index.php?topic=262.0

Code Hunter, if you modify my code could you write that somewhere on or around title.

I don't understand the need or use of map!

And what have you against the sounds?  ;D
« Last Edit: June 10, 2018, 05:48:39 PM by bplus »
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

#### Code Hunter

##### Re: Dropping Balls
« Reply #11 on: June 10, 2018, 06:07:28 PM »

How is this for a nice effect?

I like this much better:
https://www.qb64.org/forum/index.php?topic=262.0

Code Hunter, if you modify my code could you write that somewhere on or around title.

I don't understand the need or use of map!

And what have you against the sounds?  ;D

I am glad you liked my C64 immitation.

Added remarks to mention my edits.

The use of map is to take a value (in this case the balls Y location) and gets a value between ymax\4  and 0 and draws the mirrored ball at that location.

Sound has been restored here.

I am one who enjoys the sound of silence.  Yes that is a good song too.

Code: [Select]
`_TITLE "Dropping Balls 2 w sound by bplus 2018-03-31"' Small edits by Code Hunter'  Added a sky and floor to the program'  Added mirror effect where the balls only appear below the sky.' attempt to fixRANDOMIZE TIMERCONST xmax = 1024CONST ymax = 768SCREEN _NEWIMAGE(xmax, ymax, 32)'_SCREENMOVE 360, 60gravity = .25balls = 8DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)FOR i = 1 TO balls  r(i) = rand(15, 20)  x(i) = rand(r(i), xmax - r(i))  y(i) = rand(r(i), ymax - r(i))  c(i) = rand(1, 15)  dx(i) = rand(0, 3) * rdir  dy(i) = rand(10, 20)  rr(i) = rand(200, 255)  gg(i) = rand(200, 255)  bb(i) = rand(200, 255)NEXTWHILE 1  LINE (0, 0)-(xmax, ymax \ 2), _RGB(0, 191, 255), BF  LINE (0, ymax \ 2)-(xmax, ymax), _RGB(208, 208, 208), BF  FOR i = 1 TO balls    'ready for collision    dy(i) = dy(i) + gravity    a(i) = _ATAN2(dy(i), dx(i))    power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5    imoved = 0    FOR j = i + 1 TO balls      IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN        imoved = 1        a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))        a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))        'update new dx, dy for i and j balls        power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5        power = .7 * (power1 + power2) / 2        dx(i) = power * COS(a(i))        dy(i) = power * SIN(a(i))        dx(j) = power * COS(a(j))        dy(j) = power * SIN(a(j))        x(i) = x(i) + dx(i)        y(i) = y(i) + dy(i)        x(j) = x(j) + dx(j)        y(j) = y(j) + dy(j)        snd 120 + r(i) * 250, r(j) * .15        EXIT FOR      END IF    NEXT    IF imoved = 0 THEN      x(i) = x(i) + dx(i)      y(i) = y(i) + dy(i)    END IF    IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN      x(i) = xmax / 2 + rand(0, 100) * rdir      y(i) = 0      dx(i) = rand(0, 3) * rdir      dy(i) = 1    END IF    IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls    IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)    FOR rad = r(i) TO 1 STEP -1      COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)      fcirc x(i), y(i), rad      offset = map(y(i), 0, ymax, ymax \ 4, 0)      mbx = x(i)      mby = y(i) + offset      IF mby > ymax \ 2 + r(i) THEN fcirc mbx, mby, rad    NEXT  NEXT  _DISPLAY  _LIMIT 20WENDFUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!END FUNCTIONFUNCTION rand (lo, hi)rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)DIM subRadius AS LONG, RadiusError AS LONGDIM X AS LONG, Y AS LONGsubRadius = ABS(R)RadiusError = -subRadiusX = subRadiusY = 0IF 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), , BFWHILE 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), , BFWENDEND SUBSUB snd (frq, dur)SOUND frq / 2.2, dur * .01END SUB`
« Last Edit: June 13, 2018, 04:46:38 AM by odin »

#### v

##### Re: Dropping Balls
« Reply #12 on: June 10, 2018, 08:45:21 PM »
Here's a draft, several flaws though.

Code: [Select]
`_TITLE "Dropping Balls 2 w sound by vince 2018-03-31"' attempt to fixRANDOMIZE TIMERCONST xmax = 800CONST ymax = 600dim shared mx as integer,my as integer,mbl as integer,mbr as integer,mw as integerdim shared pi as doublepi = 3.1415926SCREEN _NEWIMAGE(xmax, ymax, 32)'_SCREENMOVE 360, 60gravity = 1balls = 1000DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)screen ,,1,0line (0,0)-(800,600),_rgb(0,0,0),bfa=0xx = 150*sin(2*a)yy = 300*cos(a)pset (xx+400,yy+300), _rgb(100,100,100)for a = 0 to 2*pi step 0.01        xx = 150*sin(2*a)        yy = 300*cos(a)        line -(xx+400,yy+300), _rgb(100,100,100)nextpaint (400,150),_rgb(100,100,100)paint (400,450),_rgb(100,100,100)line (380,150)-(420,450),_rgb(100,100,100),bfpcopy 1,0balls = 0for yy = 50 to 300-10 step 8for xx = 10 to 600-10 step 8        if point(xx,yy) <> _rgb(0,0,0) then                balls = balls + 1                r(balls) = 3                x(balls) = xx                y(balls) = yy                c(balls) = 15                dx(balls) = rand(0, 3) * rdir                dy(balls) = 15                rr(balls) = 255                gg(balls) = 255                bb(balls) = 0        end ifnextnextscreen ,,0,0'FOR i = 1 TO balls'    r(i) = rand(15, 20)'    x(i) = rand(r(i), xmax - r(i))'    y(i) = rand(r(i), ymax - r(i))'    c(i) = rand(1, 15)'    dx(i) = rand(0, 3) * rdir'    dy(i) = rand(10, 20)'    rr(i) = rand(200, 255)'    gg(i) = rand(200, 255)'    bb(i) = rand(200, 255)'NEXTWHILE 1        pcopy 1,0    FOR i = 1 TO balls        'ready for collision        dy(i) = dy(i) + gravity        a(i) = _ATAN2(dy(i), dx(i))        power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5        imoved = 0        FOR j = i + 1 TO balls            IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN                imoved = 1                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                'update new dx, dy for i and j balls                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5                power = .7 * (power1 + power2) / 2                dx(i) = power * COS(a(i))                dy(i) = power * SIN(a(i))                dx(j) = power * COS(a(j))                dy(j) = power * SIN(a(j))                x(i) = x(i) + dx(i)                y(i) = y(i) + dy(i)                x(j) = x(j) + dx(j)                y(j) = y(j) + dy(j)                snd 120 + r(i) * 250, r(j) * .15                EXIT FOR            END IF        NEXT        IF imoved = 0 THEN            x(i) = x(i) + dx(i)            y(i) = y(i) + dy(i)        END IF        'IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN        '    x(i) = xmax / 2 + rand(0, 100) * rdir        '    y(i) = 0        '    dx(i) = rand(0, 3) * rdir        '    dy(i) = 1        'END IF        'IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls                screen ,,1,0                '        IF point(x(i)+r(i),y(i))<>_rgb(100,100,100) THEN                        'y(i) = ymax - r(i)                        x(i) = x(i) - r(i)                        dy(i) = dy(i) * -.7                        dx(i) = dx(i) * -.7                        'x(i) = x(i) + .1 * dx(i)                elseif  point(x(i)-r(i),y(i))<>_rgb(100,100,100) then                         x(i) = x(i) + r(i)                        dy(i) = dy(i) * -.7                        dx(i) = dx(i) * -.7                elseif  point(x(i),y(i)+r(i))<>_rgb(100,100,100) then                         y(i) = y(i) - r(i)                        dy(i) = dy(i) * -.7                        dx(i) = dx(i) * -.7                elseif  point(x(i),y(i)-r(i))<>_rgb(100,100,100) then                         y(i) = y(i) + r(i)                        dy(i) = dy(i) * -.7                        dx(i) = dx(i) * -.7                end if                screen ,,0,0        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)            fcirc x(i), y(i), rad        NEXT    NEXT    _DISPLAY    _LIMIT 20WENDFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END 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)    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    WENDEND SUBSUB snd (frq, dur)    'SOUND frq / 2.2, dur * .01END SUB`

#### v

##### Re: Dropping Balls
« Reply #13 on: June 10, 2018, 09:26:37 PM »
As requested by Phil

Code: [Select]
`_TITLE "Dropping Balls pile attempt bplus ;-)"'attempt to build pile by adjusting drop rate, elasticity, gravity' remove sound and adjust dropping to center of screen' built from Dropping balls 4 w snd and STATIC created 2018-04-3' add STATIC's moving ball before figuring bounce from collision' which was a mod of Dropping Balls 2 w sound posted 2018-03-31RANDOMIZE TIMERCONST xmax = 800CONST ymax = 600dim pi as doublepi = 3.1415926SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 360, 60elastic = .5gravity = .5balls = 160DIM x(balls), y(balls), r(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)dim aa(balls)dim aaa(balls)FOR i = 1 TO balls    r(i) = 50    x(i) = xmax / 2 + (i MOD 2) * 8 - 4    y(i) = 0    dx(i) = 0    dy(i) = 3    rr(i) = rand(200, 255)    gg(i) = rand(200, 255)    bb(i) = rand(200, 255)        aa(i) = 2*pi*rnd        aaa(i) = 0        'rnd*0.1-0.05NEXTmaxBall = 0t = timerWHILE 1    CLS    'loopCnt = loopCnt + 1    'IF loopCnt MOD 17 = 0 THEN        IF maxBall < balls and timer-t>1 THEN                maxBall = maxBall + 1                t = timer        end if    'END IF    COLOR _RGB32(255, 255, 255)    _PRINTSTRING (100, 10), "Balls:" + STR\$(maxBall)    FOR i = 1 TO maxBall                aa(i) = aa(i) + aaa(i)                if abs(aaa(i)) > 0.5 then aaa(i)=aaa(i)+ sgn(aaa(i))*0.02        'ready for collision        dy(i) = dy(i) + gravity        a(i) = _ATAN2(dy(i), dx(i))        imoved = 0        FOR j = i + 1 TO maxBall            ' The following is STATIC's adjustment of ball positions if overlapping            ' before calcultion of new positions from collision            ' Displacement vector and its magnitude.  Thanks STxAxTIC !            nx = x(j) - x(i)            ny = y(j) - y(i)            nm = SQR(nx ^ 2 + ny ^ 2)            IF nm < 1 + r(i) + r(j) THEN                nx = nx / nm                ny = ny / nm                ' Regardless of momentum exchange, separate the balls along the lone connecting them.                DO WHILE nm < 1 + r(i) + r(j)                    flub = .001 '* RND                    x(j) = x(j) + flub * nx                    y(j) = y(j) + flub * ny                    x(i) = x(i) - flub * nx                    y(i) = y(i) - flub * ny                    nx = x(j) - x(i)                    ny = y(j) - y(i)                    nm = SQR(nx ^ 2 + ny ^ 2)                    nx = nx / nm                    ny = ny / nm                LOOP                imoved = 1                a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))                a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))                'update new dx, dy for i and j balls                power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5                power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5                power = elastic * (power1 + power2) / 2                dx(i) = power * COS(a(i))                dy(i) = power * SIN(a(i))                dx(j) = power * COS(a(j))                dy(j) = power * SIN(a(j))                x(i) = x(i) + dx(i)                y(i) = y(i) + dy(i)                x(j) = x(j) + dx(j)                y(j) = y(j) + dy(j)                'EXIT FOR                                aaa(i) = rnd*0.2-0.1            END IF        NEXT        IF imoved = 0 THEN            x(i) = x(i) + dx(i)            y(i) = y(i) + dy(i)        END IF        IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN            x(i) = xmax / 2 + (i MOD 2) * 4 * r(i) - 2 * r(i)            y(i) = 0            dx(i) = 0            dy(i) = 3                                aaa(i) = rnd*0.2-0.1        END IF        IF y(i) + r(i) > ymax THEN                y(i) = ymax - r(i): dy(i) = -dy(i) * elastic '???: x(i) = x(i) + .1 * dx(i)                                aaa(i) = rnd*0.2-0.1                end if        FOR rad = r(i) TO 1 STEP -1            COLOR _RGB32(rr(i) - 3 * rad, gg(i) - 3 * rad, bb(i) - 3 * rad)            fcirc x(i), y(i), rad        NEXT                textrot x(i), y(i), ltrim\$(str\$(i)), aa(i), aa(i)    NEXT    _DISPLAY    _LIMIT 30WENDsub textrot (x0 as integer, y0 as integer, s as string, a as double, b as double)        dim img as long        img = _newimage(16,16,32)        _dest img        line (0,0)-(16,16),_rgb(0,0,0),bf        color _rgb(255,255,255)        _printstring (0,0),left\$(s\$,2),img        _source img        _dest 0        dim z as long        r = 0.5        for yy = -16/r to 16/r        for xx = -16/r to 16/r                xxx=r*xx*cos(a)+r*yy*sin(a)+8                yyy=r*yy*cos(a)-r*xx*sin(a)+8                if xxx<15 and xxx>=0 then                if yyy<15 and yyy>=0 then                z = point(xxx,yyy)                if z = _rgb(255,255,255) then                        pset (x0+xx,y0+yy),_rgb(0,0,0)                end if                end if                end if        next        next        _freeimage(img)        _source 0end subFUNCTION rand (lo, hi)    rand = (RND * (hi - lo + 1)) \ 1 + loEND FUNCTIONFUNCTION rdir ()    IF RND < .5 THEN rdir = -1 ELSE rdir = 1END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB 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    WENDEND SUBSUB snd (frq, dur)    'SOUND frq / 2.2, dur * .01END SUB`
« Last Edit: June 10, 2018, 09:55:35 PM by v »

#### FellippeHeitor

• QB64 Developer
• LET IT = BE
##### Re: Dropping Balls
« Reply #14 on: June 10, 2018, 09:28:22 PM »
I'm stunned! That was awesome, Vince!