Author Topic: 2D ball collisions without trigonometry. (Read 21143 times)

NOVARSEG · « **Reply #75 on:** May 26, 2021, 07:01:19 pm »

@bplus

Ok I will try coding that later. For now I'm just playing with the numbers. The idea behind using FULLSCREEN is that it has the ability to fill the entire screen. Doing an 800,600,32 with newimage will be close to the solution.

The main thing is to have a nice undistorted grid with fullscreen. I want to use the entire computer display. Fullscreen also makes graphics appear larger. (at times)

example
newimage (_DeskTopWidth ,_DeskTopHeight ,32)

so I think that a FULLSCREEN after this won't have any effect because it can not stretch the image. ?

OldMoses · « **Reply #76 on:** May 26, 2021, 07:21:09 pm »

I tweaked this a little bit earlier today for a large display. I still haven't gotten back mouse function on the input vector grab, IDK what is wrong there. Funny how sometimes a modeling tool will distract one from an original topic.

It's like, "Oh look, a chicken.":D

EDIT:
I almost forgot to fix the grid...that should do it

Code: QB64: [Select]

'Original code & some full display adjustments by OldMoses
'Additional code by Novarseg
 
$COLOR:32
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    cn AS STRING * 4 '                                          ball name by color
    c AS _UNSIGNED LONG '                                       color
    p AS V2 '                                                   position
    m AS V2 '                                                   movement (pre-contact) incoming
    x AS V2 '                                                   vector of post contact movement
    s AS INTEGER '                                              magnitude of movement
END TYPE
DIM TEXT(1) AS STRING
DIM RAD AS SINGLE
RAD = 0 ' * _PI
DIM c(1) AS STRING
 
DIM vertex(1, 1) AS V2 '                                        mouse grabbing handles
DIM mouse AS V2
DIM b(1) AS ball
'DIM SHARED AS V2 origin
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
b(0).c = Red: b(0).cn = "red"
b(1).c = Cyan: b(1).cn = "cyan"
 
SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32)
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 0, 0
WINDOW (-_DESKTOPWIDTH / 2, _DESKTOPHEIGHT / 2)-(_DESKTOPWIDTH / 2, -_DESKTOPHEIGHT / 2)
'_FULLSCREEN
 
'starting state
b(0).m.x = 0: b(0).m.y = 100 '    reds approach vector
b(0).s = PyT(origin, b(0).m)
 
b(1).m.x = -100: b(1).m.y = 0 '   cyans approach vector
b(1).s = PyT(origin, b(1).m)
 
b(0).p.x = 0: b(0).p.y = 0 '     ball position x, y
b(1).p.x = -100: b(1).p.y = 100 'ball position x, y
f3 = 0
ar = 1
DO
    CLS
    ms = MBS '                                                  process mouse actions dragging endpoints
    IF ms AND 64 THEN
        _PRINTSTRING (0, 0), "mouse (" + STR$(mouse.x) + ", " + STR$(mouse.y) + ")"
        mouse.x = map!(_MOUSEX, 0, _DESKTOPWIDTH - 1, -_DESKTOPWIDTH / 2, _DESKTOPWIDTH / 2)
        mouse.y = map!(_MOUSEY, 0, _DESKTOPHEIGHT - 1, _DESKTOPHEIGHT / 2, -_DESKTOPHEIGHT / 2)
        FOR x = 0 TO 1
            FOR y = 0 TO 1
                ds! = PyT(vertex(x, y), mouse)
                IF ds! < ballradius * .25 THEN i = x: j = y
            NEXT y
        NEXT x
        SELECT CASE j '                                         grabbing impact position or start of incoming vector
            CASE IS = 0 '                                       impact position- here we use mouse as the new b(#).p
                b(i).p = mouse
            CASE IS = 1 '                                       starting point- here we obtain the b(#).m mathematically
                b(i).m = b(i).p: VecAdd b(i).m, mouse, -1
        END SELECT
    ELSE
        IF _KEYDOWN(18432) THEN b(i).p.y = b(i).p.y + 1
        IF _KEYDOWN(20480) THEN b(i).p.y = b(i).p.y - 1
        IF _KEYDOWN(19200) THEN b(i).p.x = b(i).p.x - 1
        IF _KEYDOWN(19712) THEN b(i).p.x = b(i).p.x + 1
 
        '**************Code added by Novarseg
        'Vector rotation and vector magnitude adjustment using keyboard input
 
        I$ = INKEY$
        IF f3 = 0 THEN I$ = "b": f3 = 1
        IF I$ = "b" AND i = 0 THEN i = 1: c(1) = "  SELECTED": c(0) = "           ": GOTO LL1 'cyan
        IF I$ = "b" AND i = 1 THEN i = 0: c(0) = "  SELECTED": c(1) = "           " 'red
        LL1:
 
        IF I$ = "c" THEN 'increase vector magnitude
            mult = 1.01
            VecMult b(i).m, mult
        END IF
 
        IF I$ = "v" THEN 'decrease vector magnitude
            mult = 1.01 'should be div to avoid confusion, still works though
            VecDIV b(i).m, mult 'added a new sub
        END IF
 
 
        IF I$ = "z" THEN 'rotate vector counter clockwise
            IF RAD > _PI * 2 THEN RAD = 0
            'IF RAD < 0 THEN RAD = _PI * 2
            IF INKEY$ <> "z" THEN f1 = 0
            IF f1 = 0 THEN t1 = TIMER
            f1 = 1
            RAD = RAD + .005
            IF TIMER - t1 > 1.5 THEN
                RAD = RAD + .05
            END IF
            signC = COS(RAD) * 1 / ABS(COS(RAD))
            signS = SIN(RAD) * 1 / ABS(SIN(RAD))
            b(i).s = PyT(origin, b(i).m)
            b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
            b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
        END IF
 
        IF I$ = "x" THEN 'rotate vector clockwise
 
            'IF RAD > _PI * 2 THEN RAD = 0
            IF RAD < 0 THEN RAD = _PI * 2
 
            IF INKEY$ <> "x" THEN f1 = 0
            IF f1 = 0 THEN t1 = TIMER
            f1 = 1
            RAD = RAD - .005
            IF TIMER - t1 > 1.5 THEN
                RAD = RAD - .05
            END IF
            signC = COS(RAD) * 1 / ABS(COS(RAD))
            signS = SIN(RAD) * 1 / ABS(SIN(RAD))
            b(i).s = PyT(origin, b(i).m)
            b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
            b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
            '**************END Code added Novarseg
        END IF
 
        IF I$ = "q" THEN
            ar = ar + .01
        END IF
 
        IF I$ = "w" THEN
            ar = ar - .01
        END IF
 
 
        _DELAY .1
    END IF
    'mouse.x = map!(_MOUSEX, 0, 599, -300, 300)
 
 
    'START OF COLLISION MATHEMATICS SECTION
    ballradius = PyT(b(0).p, b(1).p) / 2
 
    FOR bn = 0 TO 1
        vertex(bn, 0) = b(bn).p '                               first we establish the mouse handles for ball position
        vertex(bn, 1) = b(bn).p: VecAdd vertex(bn, 1), b(bn).m, -1 ' and incoming vector starting point
    NEXT bn
 
    'Now all the previous garbage is distilled into a single SUB call once a collision is determined
    B2BCollision b(0), b(1)
    'END OF COLLISION MATHEMATICS SECTION
 
    'graphic representation
    FOR grid = -_DESKTOPWIDTH / 2 TO _DESKTOPWIDTH / 2 'STEP 20
        IF grid MOD 20 <> 0 THEN _CONTINUE 
        IF grid MOD 100 = 0 THEN c& = &HFF7F7F7F ELSE c& = &H5F7F7F7F
        LINE (grid, _DESKTOPHEIGHT / 2)-(grid, -_DESKTOPHEIGHT / 2), c& 'Gray
        LINE (-_DESKTOPWIDTH / 2, grid)-(_DESKTOPWIDTH / 2, grid), c& ' Gray
    NEXT grid
    LINE (b(1).p.x, b(1).p.y)-(b(0).p.x, b(0).p.y), White, , &B0010001000100010 'strike vector
 
    FOR dr = 0 TO 1
 
        CIRCLE (b(dr).p.x, b(dr).p.y), ballradius, b(dr).c, , , ar
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).m.x, b(dr).p.y - b(dr).m.y), b(dr).c 'incoming
 
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).x.x, b(dr).p.y + b(dr).x.y), b(dr).c, , &B1111000011110000 'exit vector
        b$ = b(dr).cn + " @ (" + _TRIM$(STR$(INT(b(dr).p.x))) + ", " + _TRIM$(STR$(INT(b(dr).p.y))) + ")"
 
        b$ = b$ + "  along <" + _TRIM$(STR$(INT(b(dr).m.x))) + ", " + _TRIM$(STR$(INT(b(dr).m.y))) + ">"
        _PRINTSTRING (0, _DESKTOPHEIGHT - 80 + (16 * dr)), SPACE$(80)
        b$ = b$ + "  exits along <" + _TRIM$(STR$(INT(b(dr).x.x))) + ", " + _TRIM$(STR$(INT(b(dr).x.y))) + ">" + c(dr)
 
        _PRINTSTRING (0, _DESKTOPHEIGHT - 80 + (16 * dr)), b$
 
        TEXT(dr) = b$ + CHR$(13) + CHR$(10) 'NOVARSEG added this line
    NEXT dr
 
    IF _KEYHIT = ASC("f") THEN 'NOVARSEG added this line
        OPEN "BALL STUFF.TXT" FOR BINARY AS #1 'NOVARSEG added this line
        PUT #1, , TEXT(0) 'NOVARSEG added this line
        PUT #1, , TEXT(1) 'NOVARSEG added this line
        CLOSE 'NOVARSEG added this line
    END IF 'NOVARSEG added this line
 
    _LIMIT 50
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
 
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    ' DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    DIM un AS V2
    DIM ut AS V2
    DIM ncomp1 AS V2
    DIM ncomp2 AS V2
    DIM tcomp1 AS V2
    DIM tcomp2 AS V2
 
 
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.m) '
    bnci2 = VecDot(un, ball2.m) '
    btci1 = VecDot(ut, ball1.m) '
    btci2 = VecDot(ut, ball2.m) '
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.x = ncomp1: VecAdd ball1.x, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.x = ncomp2: VecAdd ball2.x, tcomp2, 1 '               add normal and tangent exit vectors
 
END SUB 'B2BCollision
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(var1.x - var2.x, var1.y - var2.y)
 
END FUNCTION 'PyT
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS SINGLE)
 
    var.x = -(var.x + (var2.x * var3)) '                           add vector (or a scalar multiple of) var2 to var)
    var.y = var.y + (var2.y * var3) '                           use var3 = -1 to subtract var2 from var
 
END SUB 'Add_Vector
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'Vec_Mult
 
SUB VecDIV (vec AS V2, divisor AS SINGLE) 'added by Novarseg
 
    vec.x = vec.x / divisor
    vec.y = vec.y / divisor
 
END SUB 'VecDIV
 
 
SUB VecNorm (var AS V2)
 
    m = PyT(origin, var)
    IF m = 0 THEN
        var.x = 0: var.y = 0 '                                  vector with magnitude 0 is a zero vector
    ELSE
        var.x = var.x / m: var.y = var.y / m '                  convert var to unit vector
    END IF
 
END SUB 'VecNorm
 
 

NOVARSEG · « **Reply #77 on:** May 26, 2021, 07:42:16 pm »

@OldMoses
Nice display.

FULLSCREEN enabled

Can't see parameter text at bottom though

Code: QB64: [Select]

'Original code & some full display adjustments by OldMoses
'Additional code by Novarseg
 
$COLOR:32
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    cn AS STRING * 4 '                                          ball name by color
    c AS _UNSIGNED LONG '                                       color
    p AS V2 '                                                   position
    m AS V2 '                                                   movement (pre-contact) incoming
    x AS V2 '                                                   vector of post contact movement
    s AS INTEGER '                                              magnitude of movement
END TYPE
DIM TEXT(1) AS STRING
DIM RAD AS SINGLE
RAD = 0 ' * _PI
DIM c(1) AS STRING
 
DIM vertex(1, 1) AS V2 '                                        mouse grabbing handles
DIM mouse AS V2
DIM b(1) AS ball
'DIM SHARED AS V2 origin
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
b(0).c = Red: b(0).cn = "red"
b(1).c = Cyan: b(1).cn = "cyan"
 
SCREEN _NEWIMAGE(_DESKTOPWIDTH * .5, _DESKTOPHEIGHT * .5, 32)
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 0, 0
WINDOW (-_DESKTOPWIDTH / 4, _DESKTOPHEIGHT / 4)-(_DESKTOPWIDTH / 4, -_DESKTOPHEIGHT / 4)
_FULLSCREEN
 
'starting state
b(0).m.x = 0: b(0).m.y = 100 '    reds approach vector
b(0).s = PyT(origin, b(0).m)
 
b(1).m.x = -100: b(1).m.y = 0 '   cyans approach vector
b(1).s = PyT(origin, b(1).m)
 
b(0).p.x = 0: b(0).p.y = 0 '     ball position x, y
b(1).p.x = -100: b(1).p.y = 100 'ball position x, y
f3 = 0
ar = 1
DO
    CLS
    ms = MBS '                                                  process mouse actions dragging endpoints
    IF ms AND 64 THEN
        _PRINTSTRING (0, 0), "mouse (" + STR$(mouse.x) + ", " + STR$(mouse.y) + ")"
        mouse.x = map!(_MOUSEX, 0, _DESKTOPWIDTH - 1, -_DESKTOPWIDTH / 2, _DESKTOPWIDTH / 2)
        mouse.y = map!(_MOUSEY, 0, _DESKTOPHEIGHT - 1, _DESKTOPHEIGHT / 2, -_DESKTOPHEIGHT / 2)
        FOR x = 0 TO 1
            FOR y = 0 TO 1
                ds! = PyT(vertex(x, y), mouse)
                IF ds! < ballradius * .25 THEN i = x: j = y
            NEXT y
        NEXT x
        SELECT CASE j '                                         grabbing impact position or start of incoming vector
            CASE IS = 0 '                                       impact position- here we use mouse as the new b(#).p
                b(i).p = mouse
            CASE IS = 1 '                                       starting point- here we obtain the b(#).m mathematically
                b(i).m = b(i).p: VecAdd b(i).m, mouse, -1
        END SELECT
    ELSE
        IF _KEYDOWN(18432) THEN b(i).p.y = b(i).p.y + 1
        IF _KEYDOWN(20480) THEN b(i).p.y = b(i).p.y - 1
        IF _KEYDOWN(19200) THEN b(i).p.x = b(i).p.x - 1
        IF _KEYDOWN(19712) THEN b(i).p.x = b(i).p.x + 1
 
        '**************Code added by Novarseg
        'Vector rotation and vector magnitude adjustment using keyboard input
 
        I$ = INKEY$
        IF f3 = 0 THEN I$ = "b": f3 = 1
        IF I$ = "b" AND i = 0 THEN i = 1: c(1) = "  SELECTED": c(0) = "           ": GOTO LL1 'cyan
        IF I$ = "b" AND i = 1 THEN i = 0: c(0) = "  SELECTED": c(1) = "           " 'red
        LL1:
 
        IF I$ = "c" THEN 'increase vector magnitude
            mult = 1.01
            VecMult b(i).m, mult
        END IF
 
        IF I$ = "v" THEN 'decrease vector magnitude
            mult = 1.01 'should be div to avoid confusion, still works though
            VecDIV b(i).m, mult 'added a new sub
        END IF
 
 
        IF I$ = "z" THEN 'rotate vector counter clockwise
            IF RAD > _PI * 2 THEN RAD = 0
            'IF RAD < 0 THEN RAD = _PI * 2
            IF INKEY$ <> "z" THEN f1 = 0
            IF f1 = 0 THEN t1 = TIMER
            f1 = 1
            RAD = RAD + .005
            IF TIMER - t1 > 1.5 THEN
                RAD = RAD + .05
            END IF
            signC = COS(RAD) * 1 / ABS(COS(RAD))
            signS = SIN(RAD) * 1 / ABS(SIN(RAD))
            b(i).s = PyT(origin, b(i).m)
            b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
            b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
        END IF
 
        IF I$ = "x" THEN 'rotate vector clockwise
 
            'IF RAD > _PI * 2 THEN RAD = 0
            IF RAD < 0 THEN RAD = _PI * 2
 
            IF INKEY$ <> "x" THEN f1 = 0
            IF f1 = 0 THEN t1 = TIMER
            f1 = 1
            RAD = RAD - .005
            IF TIMER - t1 > 1.5 THEN
                RAD = RAD - .05
            END IF
            signC = COS(RAD) * 1 / ABS(COS(RAD))
            signS = SIN(RAD) * 1 / ABS(SIN(RAD))
            b(i).s = PyT(origin, b(i).m)
            b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
            b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
            '**************END Code added Novarseg
        END IF
 
        IF I$ = "q" THEN
            ar = ar + .01
        END IF
 
        IF I$ = "w" THEN
            ar = ar - .01
        END IF
 
 
        _DELAY .1
    END IF
    'mouse.x = map!(_MOUSEX, 0, 599, -300, 300)
 
 
    'START OF COLLISION MATHEMATICS SECTION
    ballradius = PyT(b(0).p, b(1).p) / 2
 
    FOR bn = 0 TO 1
        vertex(bn, 0) = b(bn).p '                               first we establish the mouse handles for ball position
        vertex(bn, 1) = b(bn).p: VecAdd vertex(bn, 1), b(bn).m, -1 ' and incoming vector starting point
    NEXT bn
 
    'Now all the previous garbage is distilled into a single SUB call once a collision is determined
    B2BCollision b(0), b(1)
    'END OF COLLISION MATHEMATICS SECTION
 
    'graphic representation
    FOR grid = -_DESKTOPWIDTH / 2 TO _DESKTOPWIDTH / 2 STEP 20
        IF grid MOD 100 = 0 THEN c& = &HFF7F7F7F ELSE c& = &H5F7F7F7F
        LINE (grid, _DESKTOPHEIGHT / 2)-(grid, -_DESKTOPHEIGHT / 2), c& 'Gray
        LINE (-_DESKTOPWIDTH / 2, grid)-(_DESKTOPWIDTH / 2, grid), c& ' Gray
    NEXT grid
    LINE (b(1).p.x, b(1).p.y)-(b(0).p.x, b(0).p.y), White, , &B0010001000100010 'strike vector
 
    FOR dr = 0 TO 1
 
        CIRCLE (b(dr).p.x, b(dr).p.y), ballradius, b(dr).c, , , ar
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).m.x, b(dr).p.y - b(dr).m.y), b(dr).c 'incoming
 
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).x.x, b(dr).p.y + b(dr).x.y), b(dr).c, , &B1111000011110000 'exit vector
        b$ = b(dr).cn + " @ (" + _TRIM$(STR$(INT(b(dr).p.x))) + ", " + _TRIM$(STR$(INT(b(dr).p.y))) + ")"
 
        b$ = b$ + "  along <" + _TRIM$(STR$(INT(b(dr).m.x))) + ", " + _TRIM$(STR$(INT(b(dr).m.y))) + ">"
        _PRINTSTRING (0, _DESKTOPHEIGHT - 80 + (16 * dr)), SPACE$(80)
        b$ = b$ + "  exits along <" + _TRIM$(STR$(INT(b(dr).x.x))) + ", " + _TRIM$(STR$(INT(b(dr).x.y))) + ">" + c(dr)
 
        _PRINTSTRING (0, _DESKTOPHEIGHT - 80 + (16 * dr)), b$
 
        TEXT(dr) = b$ + CHR$(13) + CHR$(10) 'NOVARSEG added this line
    NEXT dr
 
    IF _KEYHIT = ASC("f") THEN 'NOVARSEG added this line
        OPEN "BALL STUFF.TXT" FOR BINARY AS #1 'NOVARSEG added this line
        PUT #1, , TEXT(0) 'NOVARSEG added this line
        PUT #1, , TEXT(1) 'NOVARSEG added this line
        CLOSE 'NOVARSEG added this line
    END IF 'NOVARSEG added this line
 
    _LIMIT 50
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
 
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    ' DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    DIM un AS V2
    DIM ut AS V2
    DIM ncomp1 AS V2
    DIM ncomp2 AS V2
    DIM tcomp1 AS V2
    DIM tcomp2 AS V2
 
 
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.m) '
    bnci2 = VecDot(un, ball2.m) '
    btci1 = VecDot(ut, ball1.m) '
    btci2 = VecDot(ut, ball2.m) '
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.x = ncomp1: VecAdd ball1.x, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.x = ncomp2: VecAdd ball2.x, tcomp2, 1 '               add normal and tangent exit vectors
 
END SUB 'B2BCollision
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(var1.x - var2.x, var1.y - var2.y)
 
END FUNCTION 'PyT
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS SINGLE)
 
    var.x = -(var.x + (var2.x * var3)) '                           add vector (or a scalar multiple of) var2 to var)
    var.y = var.y + (var2.y * var3) '                           use var3 = -1 to subtract var2 from var
 
END SUB 'Add_Vector
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'Vec_Mult
 
SUB VecDIV (vec AS V2, divisor AS SINGLE) 'added by Novarseg
 
    vec.x = vec.x / divisor
    vec.y = vec.y / divisor
 
END SUB 'VecDIV
 
 
SUB VecNorm (var AS V2)
 
    m = PyT(origin, var)
    IF m = 0 THEN
        var.x = 0: var.y = 0 '                                  vector with magnitude 0 is a zero vector
    ELSE
        var.x = var.x / m: var.y = var.y / m '                  convert var to unit vector
    END IF
 
END SUB 'VecNorm

OldMoses · « **Reply #78 on:** May 26, 2021, 08:02:12 pm »

FULLSCREEN probably stretched it past the bottom of the display. Even without FULLSCREEN, I had to choke up on it a bit to keep it in my version of the display. You might have to pull it up some more on lines #176 & 179 by subtracting more from _DESKTOPHEIGHT, assuming that FULLSCREEN doesn't mess with _PRINTSTRING in some way I'm unaware of.

I've never been satisfied with FULLSCREEN whenever I've used it. It seems to render things a lot grainier than a 32 bit screen will.

SMcNeill · « **Reply #79 on:** May 26, 2021, 08:21:32 pm »

Instead of using full screen, why not just calculate the largest possible screen you can use and maintain the original screen ratio, and then _putimage your workscreen onto it, make it the display screen, and keep it centered on the desktop? You'd always be working in your original screen, wouldn't need to change coordinate values or scale anything... All you'd do is _PUTIMAGE your workscreen onto the displayscreen before your _DISPLAY statement.

Or, even easier:

Forget about _FULLSCREEN. Just use $RESIZE:(smooth or stretch) and let the user stretch to whatever size they want for their desktop/readability.

Code: QB64: [Select]

SX = 400: SY = 400
SCREEN _NEWIMAGE(SX, SY, 32)
$RESIZE:SMOOTH
CLS , &HFF0000AA
FOR i = 1 TO 10
    PRINT i
NEXT
DO
    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYHIT = 27
 

The above should show how simple resize is to add, and how to scales our images while maintaining aspect ratio, simply enough. And, best of all -- all your code which you've wrote already will continue to work just like always. mouse coordinates are automatically scaled. screen coordinates are automatically scaled. Your program is the same old 400 x 400 which you wrote it in, in all ways, except the user is simply resizing the final display to whatever size they want it to be on their desktop.

Honestly, I think $RESIZE:(smooth or stretch) should be included in almost all programs. There's really very few cases where I see it as something you wouldn't want to allow.

STxAxTIC · « **Reply #80 on:** May 26, 2021, 08:38:42 pm »

When y'all get spheres figured out, you can play with this code, which works for any shape of any mass about any axis (all in 2d).

What it doesn't handle well is sustained contact between objects. (I would have to stare at this code a while to keep working on it.) Nobody tell me you were able to make an object pass through a boundary, I know! :-) This is because it's still in general mode and not optimized for any particular game.

Anyway - it completely nails the one-off collision. Have a ball... or an amoeba. PRESS SPACE DURING PLAY TO PAUSE EVERYTHING AND DRAW YOUR OWN THING. (Not sure if the instructions say this.)

Code: QB64: [Select]

' Display
Screen _NewImage(800, 600, 32)
_ScreenMove (_DesktopWidth \ 2 - _Width \ 2) - 3, (_DesktopHeight \ 2 - _Height \ 2) - 29
_Title "Collisions - Version 9"
_Delay 1
 
' Meta
start:
Clear
Cls
Randomize Timer
 
' Data structures
Type Vector
    x As Double
    y As Double
End Type
 
Dim Shared vtemp As Vector
 
' Object type
Type Object
    Centroid As Vector
    Collisions As Long
    CollisionSwitch As Integer
    DeltaO As Double
    DeltaV As Vector
    Diameter As Double
    Elements As Integer
    Fixed As Integer
    Mass As Double
    MOI As Double
    PartialNormal As Vector
    Omega As Double
    Shade As _Unsigned Long
    Velocity As Vector
End Type
 
' Object storage
Dim Shared Shape(300) As Object
Dim Shared PointChain(300, 500) As Vector
Dim Shared TempChain(300, 500) As Vector
Dim Shared ShapeCount As Integer
Dim Shared SelectedShape As Integer
 
' Dynamics
Dim Shared CollisionCount As Integer
Dim Shared ProximalPairs(300 / 2, 1 To 2) As Integer
Dim Shared ProximalPairsCount As Integer
Dim Shared ContactPoints As Integer
Dim Shared CPC, FPC, RST, VD, SV As Double
 
' Environment
Dim Shared ForceField As Vector ' Ex: gravity
 
' Initialize
ShapeCount = 0
CollisionCount = 0
 
' Prompt
Cls
Call cprintstring(16 * 17, "WELCOME!                    ")
Call cprintstring(16 * 16, "Press 1 for Pool prototype  ")
Call cprintstring(16 * 15, "Press 2 for Wacky game      ")
Call cprintstring(16 * 14, "Press 3 for Concentric rings")
Call cprintstring(16 * 13, "Press 4 for Walls only      ")
Call cprintstring(16 * 12, "Press 5 for Angle pong game ")
_Display
 
_KeyClear
Do
    kk = _KeyHit
    Select Case kk
        Case Asc("1")
            Call SetupPoolGame
            Exit Do
        Case Asc("2")
            Call SetupWackyGame
            Exit Do
        Case Asc("3")
            Call SetupRings
            Exit Do
        Case Asc("4")
            Call SetupWallsOnly
            Exit Do
        Case Asc("5")
            Call SetupAnglePong
            Exit Do
        Case Else
            _KeyClear
    End Select
    _Limit 60
Loop
 
Call Graphics
Call cprintstring(-16 * 4, "During Play:")
Call cprintstring(-16 * 6, "Move mouse to select closest object (by centroid).")
Call cprintstring(-16 * 7, "Boost velocity with arrow keys or W/S/A/D.        ")
Call cprintstring(-16 * 8, "Boost angluar velocity with Q/E.                  ")
Call cprintstring(-16 * 9, "Drag and fling object with Mouse 1.               ")
Call cprintstring(-16 * 10, "Rotate selected object with Mousewheel.           ")
Call cprintstring(-16 * 11, "Halt all motion with ESC.                         ")
Call cprintstring(-16 * 12, "Create new ball with Mouse 2.                     ")
Call cprintstring(-16 * 13, "Initiate creative mode with SPACE.                ")
Call cprintstring(-16 * 14, "Restart by pressing R during motion.              ")
Call cprintstring(-16 * 16, "PRESS ANY KEY TO BEGIN.")
_Display
Do: Loop Until (_KeyHit > 0)
While (_MouseInput): Wend
_KeyClear
 
' Main loop
Do
    If (UserInput = -1) Then GoTo start
    Call PairDynamics(CPC, FPC, RST)
    Call FleetDynamics(VD, SV)
    Call Graphics
    _Limit 120
Loop
 
End
 
Function UserInput
    TheReturn = 0
    ' Keyboard input
    kk = _KeyHit
    Select Case kk
        Case 32
            Do: Loop Until _KeyHit
            While _MouseInput: Wend
            _KeyClear
            Call cprintstring(16 * 17, "Drag Mouse 1 counter-clockwise to draw a new shape.")
            Call cprintstring(16 * 16, "Make sure centroid is inside body.                 ")
            Call NewMouseShape(7.5, 150, 15)
            Cls
        Case 18432, Asc("w"), Asc("W") ' Up arrow
            Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 1.05 + 1.5
        Case 20480, Asc("s"), Asc("S") ' Down arrow
            Shape(SelectedShape).Velocity.y = Shape(SelectedShape).Velocity.y * 0.95 - 1.5
        Case 19200, Asc("a"), Asc("A") ' Left arrow
            Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 0.95 - 1.5
        Case 19712, Asc("d"), Asc("D") ' Right arrow
            Shape(SelectedShape).Velocity.x = Shape(SelectedShape).Velocity.x * 1.05 + 1.5
        Case Asc("e"), Asc("E")
            Shape(SelectedShape).Omega = Omega * 0.5 - .02
        Case Asc("q"), Asc("Q")
            Shape(SelectedShape).Omega = Omega * 1.5 + .02
        Case Asc("r"), Asc("R")
            TheReturn = -1
        Case 27
            For k = 1 To ShapeCount
                Shape(k).Velocity.x = .000001 * (Rnd - .5)
                Shape(k).Velocity.y = .000001 * (Rnd - .5)
                Shape(k).Omega = .000001 * (Rnd - .5)
            Next
    End Select
    If (kk) Then
        _KeyClear
    End If
 
    ' Mouse input
    mb = 0
    mxold = 999999999
    myold = 999999999
    Do While _MouseInput
        x = _MouseX
        y = _MouseY
        If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
            x = x - (_Width / 2)
            y = -y + (_Height / 2)
            rmin = 999999999
            For k = 1 To ShapeCount
                dx = x - Shape(k).Centroid.x
                dy = y - Shape(k).Centroid.y
                r2 = dx * dx + dy * dy
                If (r2 < rmin) Then
                    rmin = r2
                    SelectedShape = k
                End If
            Next
            If (_MouseButton(1)) Then
                If (mb = 0) Then
                    mb = 1
                    vtemp.x = x - Shape(SelectedShape).Centroid.x
                    vtemp.y = y - Shape(SelectedShape).Centroid.y
                    Call TranslateShape(SelectedShape, vtemp)
                    Shape(SelectedShape).Velocity.x = 0
                    Shape(SelectedShape).Velocity.y = 0
                    Shape(SelectedShape).Omega = 0
                    mxold = x
                    myold = y
                End If
            End If
            If (_MouseButton(2)) Then
                If (mb = 0) Then
                    mb = 1
                    Call NewAutoBall(x, y, 15, 0, 1, 1, 0)
                    _Delay .1
                End If
            End If
            If (_MouseWheel > 0) Then
                Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, -.02 * 8 * Atn(1))
            End If
            If (_MouseWheel < 0) Then
                Call RotShape(SelectedShape, Shape(SelectedShape).Centroid, .02 * 8 * Atn(1))
            End If
        End If
    Loop
    If ((mxold <> 999999999) And (myold <> 999999999)) Then
        Shape(SelectedShape).Velocity.x = x - mxold
        Shape(SelectedShape).Velocity.y = y - myold
    End If
    UserInput = TheReturn
End Function
 
Sub PairDynamics (CoarseProximityConstant As Double, FineProximityConstant As Double, Restitution As Double)
 
    Dim GrossJ(300) As Integer
    Dim GrossK(300) As Integer
    Dim NumJK As Integer
 
    ' Proximity detection
    ProximalPairsCount = 0
    Shape1 = 0
    Shape2 = 0
    For j = 1 To ShapeCount
        Shape(j).CollisionSwitch = 0
        Shape(j).DeltaO = 0
        Shape(j).DeltaV.x = 0
        Shape(j).DeltaV.y = 0
        Shape(j).PartialNormal.x = 0
        Shape(j).PartialNormal.y = 0
        For k = j + 1 To ShapeCount
            dx = Shape(j).Centroid.x - Shape(k).Centroid.x
            dy = Shape(j).Centroid.y - Shape(k).Centroid.y
            dr = Sqr(dx * dx + dy * dy)
            If (dr < (CoarseProximityConstant) * (Shape(j).Diameter + Shape(k).Diameter)) Then
                ProximalPairsCount = ProximalPairsCount + 1
                ProximalPairs(ProximalPairsCount, 1) = j
                ProximalPairs(ProximalPairsCount, 2) = k
                'Shape1 = j
                'Shape2 = k
            End If
        Next
    Next
 
    ContactPoints = 0
 
    If (ProximalPairsCount > 0) Then
        For n = 1 To ProximalPairsCount
            Shape1 = ProximalPairs(n, 1)
            Shape2 = ProximalPairs(n, 2)
 
            ' Collision detection
            rmin = 999999999
            ClosestIndex1 = 0
            ClosestIndex2 = 0
            NumJK = 0
            For j = 1 To Shape(Shape1).Elements
                For k = 1 To Shape(Shape2).Elements
                    dx = PointChain(Shape1, j).x - PointChain(Shape2, k).x
                    dy = PointChain(Shape1, j).y - PointChain(Shape2, k).y
                    r2 = dx * dx + dy * dy
 
                    If (r2 <= FineProximityConstant) Then
 
                        ContactPoints = ContactPoints + 1
 
                        ' Partial normal vector 1
                        nx1 = CalculateNormalY(Shape1, j)
                        ny1 = -CalculateNormalX(Shape1, j)
                        nn = Sqr(nx1 * nx1 + ny1 * ny1)
                        nx1 = nx1 / nn
                        ny1 = ny1 / nn
                        Shape(Shape1).PartialNormal.x = Shape(Shape1).PartialNormal.x + nx1
                        Shape(Shape1).PartialNormal.y = Shape(Shape1).PartialNormal.y + ny1
 
                        ' Partial normal vector 2
                        nx2 = CalculateNormalY(Shape2, k)
                        ny2 = -CalculateNormalX(Shape2, k)
                        nn = Sqr(nx2 * nx2 + ny2 * ny2)
                        nx2 = nx2 / nn
                        ny2 = ny2 / nn
                        Shape(Shape2).PartialNormal.x = Shape(Shape2).PartialNormal.x + nx2
                        Shape(Shape2).PartialNormal.y = Shape(Shape2).PartialNormal.y + ny2
 
                        NumJK = NumJK + 1
                        GrossJ(NumJK) = j
                        GrossK(NumJK) = k
 
                    End If
                    If (r2 < rmin) Then
                        rmin = r2
                        ClosestIndex1 = j
                        ClosestIndex2 = k
                    End If
                Next
            Next
 
            If (NumJK > 1) Then
                If ((GrossJ(1) - GrossJ(NumJK)) * (GrossJ(1) - GrossJ(NumJK)) > 50) Then
                    'ClosestIndex1 = 1
                Else
                    ClosestIndex1 = Int(IntegrateArray(GrossJ(), NumJK) / NumJK)
                End If
                If ((GrossK(1) - GrossK(NumJK)) * (GrossK(1) - GrossK(NumJK)) > 50) Then
                    'ClosestIndex2 = 1
                Else
                    ClosestIndex2 = Int(IntegrateArray(GrossK(), NumJK) / NumJK)
                End If
            End If
 
            If (rmin <= FineProximityConstant) Then
 
                CollisionCount = CollisionCount + 1
                Shape(Shape1).CollisionSwitch = 1
                Shape(Shape2).CollisionSwitch = 1
 
                ' Undo previous motion
                If (Shape(Shape1).Collisions = 0) Then
                    Call RotShape(Shape1, Shape(Shape1).Centroid, -1 * Shape(Shape1).Omega)
                    vtemp.x = -1 * (Shape(Shape1).Velocity.x)
                    vtemp.y = -1 * (Shape(Shape1).Velocity.y)
                    Call TranslateShape(Shape1, vtemp)
                End If
                If (Shape(Shape2).Collisions = 0) Then
                    Call RotShape(Shape2, Shape(Shape2).Centroid, -1 * Shape(Shape2).Omega)
                    vtemp.x = -1 * (Shape(Shape2).Velocity.x)
                    vtemp.y = -1 * (Shape(Shape2).Velocity.y)
                    Call TranslateShape(Shape2, vtemp)
                End If
 
                ' Momentum absorption
                If (Shape(Shape1).Collisions = 0) Then
                    Shape(Shape1).Velocity.x = Shape(Shape1).Velocity.x * Restitution
                    Shape(Shape1).Velocity.y = Shape(Shape1).Velocity.y * Restitution
                End If
                If (Shape(Shape2).Collisions = 0) Then
                    Shape(Shape2).Velocity.x = Shape(Shape2).Velocity.x * Restitution
                    Shape(Shape2).Velocity.y = Shape(Shape2).Velocity.y * Restitution
                End If
 
                ' Centroid of object 1 (cx1, cy1)
                cx1 = Shape(Shape1).Centroid.x
                cy1 = Shape(Shape1).Centroid.y
 
                ' Centroid of object 2 (cx2, cy2)
                cx2 = Shape(Shape2).Centroid.x
                cy2 = Shape(Shape2).Centroid.y
 
                ' Contact point on object 1 (px1, py1)
                px1 = PointChain(Shape1, ClosestIndex1).x
                py1 = PointChain(Shape1, ClosestIndex1).y
 
                ' Contact point on object 2 (px2, py2)
                px2 = PointChain(Shape2, ClosestIndex2).x
                py2 = PointChain(Shape2, ClosestIndex2).y
 
                ' Contact-centroid differentials 1 (dx1, dy1)
                dx1 = px1 - cx1
                dy1 = py1 - cy1
 
                ' Contact-centroid differentials 2 (dx2, dy2)
                dx2 = px2 - cx2
                dy2 = py2 - cy2
 
                ' Normal vector 1 (nx1, ny1)
                nn = Sqr(Shape(Shape1).PartialNormal.x * Shape(Shape1).PartialNormal.x + Shape(Shape1).PartialNormal.y * Shape(Shape1).PartialNormal.y)
                nx1 = Shape(Shape1).PartialNormal.x / nn
                ny1 = Shape(Shape1).PartialNormal.y / nn
 
                ' Normal vector 2 (nx2, ny2)
                nn = Sqr(Shape(Shape2).PartialNormal.x * Shape(Shape2).PartialNormal.x + Shape(Shape2).PartialNormal.y * Shape(Shape2).PartialNormal.y)
                nx2 = Shape(Shape2).PartialNormal.x / nn
                ny2 = Shape(Shape2).PartialNormal.y / nn
 
                '''
                'nx1 = CalculateNormalY(Shape1, ClosestIndex1)
                'ny1 = -CalculateNormalX(Shape1, ClosestIndex1)
                'nn = SQR(nx1 * nx1 + ny1 * ny1)
                'nx1 = nx1 / nn
                'ny1 = ny1 / nn
 
                'nx2 = CalculateNormalY(Shape2, ClosestIndex2)
                'ny2 = -CalculateNormalX(Shape2, ClosestIndex2)
                'nn = SQR(nx2 * nx2 + ny2 * ny2)
                'nx2 = nx2 / nn
                'ny2 = ny2 / nn
                '''
 
                ' Perpendicular vector 1 (prx1, pry1)
                prx1 = -1 * dy1
                pry1 = dx1
                pp = Sqr(prx1 * prx1 + pry1 * pry1)
                prx1 = prx1 / pp
                pry1 = pry1 / pp
 
                ' Perpendicular vector 2 (prx2, pry2)
                prx2 = -1 * dy2
                pry2 = dx2
                pp = Sqr(prx2 * prx2 + pry2 * pry2)
                prx2 = prx2 / pp
                pry2 = pry2 / pp
 
                ' Angular velocity vector 1 (w1, r1, vx1, vy1)
                w1 = Shape(Shape1).Omega
                r1 = Sqr(dx1 * dx1 + dy1 * dy1)
                vx1 = w1 * r1 * prx1
                vy1 = w1 * r1 * pry1
 
                ' Angular velocity vector 2 (w2, r2, vx2, vy2)
                w2 = Shape(Shape2).Omega
                r2 = Sqr(dx2 * dx2 + dy2 * dy2)
                vx2 = w2 * r2 * prx2
                vy2 = w2 * r2 * pry2
 
                ' Mass terms (m1, m2, mu)
                m1 = Shape(Shape1).Mass
                m2 = Shape(Shape2).Mass
                mu = 1 / (1 / m1 + 1 / m2)
 
                ' Re-Calculate moment of inertia (i1, i2)
                vtemp.x = px1
                vtemp.y = py1
                Call CalculateMOI(Shape1, vtemp)
                vtemp.x = px2
                vtemp.y = py2
                Call CalculateMOI(Shape2, vtemp)
                i1 = Shape(Shape1).MOI
                i2 = Shape(Shape2).MOI
 
                ' Velocity differentials (v1, v2, dvtx, dvty)
                vcx1 = Shape(Shape1).Velocity.x
                vcy1 = Shape(Shape1).Velocity.y
                vcx2 = Shape(Shape2).Velocity.x
                vcy2 = Shape(Shape2).Velocity.y
                vtx1 = vcx1 + vx1
                vty1 = vcy1 + vy1
                vtx2 = vcx2 + vx2
                vty2 = vcy2 + vy2
                v1 = Sqr(vtx1 * vtx1 + vty1 * vty1)
                v2 = Sqr(vtx2 * vtx2 + vty2 * vty2)
                dvtx = vtx2 - vtx1
                dvty = vty2 - vty1
 
                ' Geometry (n1dotdvt, n2dotdvt)
                n1dotdvt = nx1 * dvtx + ny1 * dvty
                n2dotdvt = nx2 * dvtx + ny2 * dvty
 
                ' Momentum exchange (qx1, qy1, qx2, qy2)
                qx1 = nx1 * 2 * mu * n1dotdvt
                qy1 = ny1 * 2 * mu * n1dotdvt
                qx2 = nx2 * 2 * mu * n2dotdvt
                qy2 = ny2 * 2 * mu * n2dotdvt
 
                ' Momentum exchange unit vector (qhat)
                qq = Sqr(qx1 * qx1 + qy1 * qy1)
                If (qx1 * qx1 > 0.01) Then
                    qhatx1 = qx1 / qq
                Else
                    qx1 = 0
                    qhatx1 = 0
                End If
                If (qy1 * qy1 > 0.01) Then
                    qhaty1 = qy1 / qq
                Else
                    qy1 = 0
                    qhaty1 = 0
                End If
                qq = Sqr(qx2 * qx2 + qy2 * qy2)
                If (qx2 * qx2 > 0.01) Then
                    qhatx2 = qx2 / qq
                Else
                    qx2 = 0
                    qhatx2 = 0
                End If
                If (qy2 * qy2 > 0.01) Then
                    qhaty2 = qy2 / qq
                Else
                    qy2 = 0
                    qhaty2 = 0
                End If
 
                ' Angular impulse (qdotp)
                q1dotp1 = qx1 * prx1 + qy1 * pry1
                q2dotp2 = qx2 * prx2 + qy2 * pry2
 
                ' Translational impulse (qdotn, ndotrhat, f)
                q1dotn1 = qhatx1 * nx1 + qhaty1 * ny1
                q2dotn2 = qhatx2 * nx2 + qhaty2 * ny2
                n1dotr1hat = (nx1 * dx1 + ny1 * dy1) / r1
                n2dotr2hat = (nx2 * dx2 + ny2 * dy2) / r2
                f1 = -q1dotn1 * n1dotr1hat
                f2 = -q2dotn2 * n2dotr2hat
 
                ' Special case for shape within shape.
                np = nx1 * nx2 + ny1 * ny2
                If (np > 0) Then
                    dcx = cx1 - cx2
                    dcy = cy1 - cy2
                    dc = Sqr(dcx * dcx + dcy * dcy)
                    If (dc < (r1 + r2)) Then
                        If (m1 > m2) Then ' This criteria may be bullshit in general but works now.
                            q1dotp1 = -q1dotp1
                            f1 = -f1
                        Else
                            q2dotp2 = -q2dotp2
                            f2 = -f2
                        End If
                    End If
                End If
 
                ' Angular impulse update (edits omega)
                Shape(Shape1).DeltaO = Shape(Shape1).DeltaO + r1 * q1dotp1 / i1
                Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - r2 * q2dotp2 / i2
 
                ' Linear impulse update (edits velocity)
                dvx1 = f1 * qx1 / m1
                dvy1 = f1 * qy1 / m1
                dvx2 = f2 * qx2 / m2
                dvy2 = f2 * qy2 / m2
                dvx1s = dvx1 * dvx1
                dvy1s = dvy1 * dvy1
                dvx2s = dvx2 * dvx2
                dvy2s = dvy2 * dvy2
                If ((dvx1s > .001) And (dvx1s < 50)) Then
                    Shape(Shape1).DeltaV.x = Shape(Shape1).DeltaV.x + dvx1
                End If
                If ((dvy1s > .001) And (dvy1s < 50)) Then
                    Shape(Shape1).DeltaV.y = Shape(Shape1).DeltaV.y + dvy1
                End If
                If ((dvx2s > .001) And (dvx2s < 50)) Then
                    Shape(Shape2).DeltaV.x = Shape(Shape2).DeltaV.x + dvx2
                End If
                If ((dvy2s > .001) And (dvy2s < 50)) Then
                    Shape(Shape2).DeltaV.y = Shape(Shape2).DeltaV.y + dvy2
                End If
 
                ' External torque (edits omega)
                torque1 = m1 * (dx1 * ForceField.y - dy1 * ForceField.x)
                torque2 = m2 * (dx2 * ForceField.y - dy2 * ForceField.x)
                Shape(Shape1).DeltaO = Shape(Shape1).DeltaO - torque1 / i1
                Shape(Shape2).DeltaO = Shape(Shape2).DeltaO - torque2 / i2
 
                ' Separate along normal (edits position)
                If (Shape(Shape1).Collisions < 2) Then ' changed from = 0
                    vtemp.x = -nx1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
                    vtemp.y = -ny1 * (.5 / m1) * (1 * v1 ^ 2 + 1 * w1 ^ 2)
                    Call TranslateShape(Shape1, vtemp)
                End If
                If (Shape(Shape2).Collisions < 2) Then
                    vtemp.x = -nx2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
                    vtemp.y = -ny2 * (.5 / m2) * (1 * v2 ^ 2 + 1 * w2 ^ 2)
                    Call TranslateShape(Shape2, vtemp)
                End If
 
                ' Dent along normal
                'PointChain(Shape1, ClosestIndex1).x = PointChain(Shape1, ClosestIndex1).x - v1 * nx1 / 2
                'PointChain(Shape1, ClosestIndex1).y = PointChain(Shape1, ClosestIndex1).y - v1 * ny1 / 2
                'PointChain(Shape2, ClosestIndex2).x = PointChain(Shape2, ClosestIndex2).x - v2 * nx2 / 2
                'PointChain(Shape2, ClosestIndex2).y = PointChain(Shape2, ClosestIndex2).y - v2 * ny2 / 2
 
                ' Feedback
                If ((Shape(Shape1).Collisions = 0) And (Shape(Shape2).Collisions = 0)) Then
                    Call snd(100 * (v1 + v2) / 2, .5)
                End If
 
            End If
        Next
    End If
End Sub
 
Sub FleetDynamics (MotionDamping As Double, LowLimitVelocity As Double)
 
    For ShapeIndex = 1 To ShapeCount
 
        ' Contact update
        If (Shape(ShapeIndex).CollisionSwitch = 1) Then
            Shape(ShapeIndex).Collisions = Shape(ShapeIndex).Collisions + 1
        Else
            Shape(ShapeIndex).Collisions = 0
        End If
 
        If (Shape(ShapeIndex).Fixed = 0) Then
 
            ' Angular velocity update
            Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega + Shape(ShapeIndex).DeltaO
 
            ' Linear velocity update
            Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + Shape(ShapeIndex).DeltaV.x
            Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + Shape(ShapeIndex).DeltaV.y
 
            If (Shape(ShapeIndex).Collisions = 0) Then
                ' Freefall (if airborne)
                Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x + ForceField.x
                Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y + ForceField.y
            End If
 
            If (Shape(ShapeIndex).Collisions > 2) Then
                ' Static friction
                If ((Shape(ShapeIndex).Velocity.x * Shape(ShapeIndex).Velocity.x) < LowLimitVelocity) Then
                    Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * .05
                End If
                If ((Shape(ShapeIndex).Velocity.y * Shape(ShapeIndex).Velocity.y) < LowLimitVelocity) Then
                    Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * .05
                End If
                If ((Shape(ShapeIndex).Omega * Shape(ShapeIndex).Omega) < .000015 * LowLimitVelocity) Then
                    Shape(ShapeIndex).Omega = 0
                End If
            End If
 
            ' Rotation update
            Call RotShape(ShapeIndex, Shape(ShapeIndex).Centroid, Shape(ShapeIndex).Omega)
 
            ' Position update
            Call TranslateShape(ShapeIndex, Shape(ShapeIndex).Velocity)
 
            ' Motion Damping
            Shape(ShapeIndex).Velocity.x = Shape(ShapeIndex).Velocity.x * MotionDamping
            Shape(ShapeIndex).Velocity.y = Shape(ShapeIndex).Velocity.y * MotionDamping
            Shape(ShapeIndex).Omega = Shape(ShapeIndex).Omega * MotionDamping
 
        Else
 
            ' Lock all motion
            Shape(ShapeIndex).Velocity.x = 0
            Shape(ShapeIndex).Velocity.y = 0
            Shape(ShapeIndex).Omega = 0
 
        End If
    Next
 
End Sub
 
Sub Graphics
    Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 200), BF
    Locate 1, 1: Print ProximalPairsCount, CollisionCount, ContactPoints
    For ShapeIndex = 1 To ShapeCount
        For i = 1 To Shape(ShapeIndex).Elements - 1
            Call cpset(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, Shape(ShapeIndex).Shade)
            Call cline(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
            If (ShapeIndex = SelectedShape) Then
                Call ccircle(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, 1, Shape(ShapeIndex).Shade)
            End If
        Next
        Call cpset(PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
        Call cline(PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).x, PointChain(ShapeIndex, Shape(ShapeIndex).Elements).y, Shape(ShapeIndex).Shade)
        Call cline(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, PointChain(ShapeIndex, 1).x, PointChain(ShapeIndex, 1).y, Shape(ShapeIndex).Shade)
        If (ShapeIndex = SelectedShape) Then
            Call ccircle(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, 3, Shape(ShapeIndex).Shade)
            Call cpaint(Shape(ShapeIndex).Centroid.x, Shape(ShapeIndex).Centroid.y, Shape(ShapeIndex).Shade, Shape(ShapeIndex).Shade)
        End If
    Next
    _Display
End Sub
 
Function IntegrateArray (arr() As Integer, lim As Integer)
    t = 0
    For j = 1 To lim
        t = t + arr(j)
    Next
    IntegrateArray = t
End Function
 
Function CalculateNormalX (k As Integer, i As Integer)
    Dim l As Vector
    Dim r As Vector
    li = i - 1
    ri = i + 1
    If (i = 1) Then li = Shape(k).Elements
    If (i = Shape(k).Elements) Then ri = 1
    l.x = PointChain(k, li).x
    r.x = PointChain(k, ri).x
    dx = r.x - l.x
    CalculateNormalX = dx
End Function
 
Function CalculateNormalY (k As Integer, i As Integer)
    Dim l As Vector
    Dim r As Vector
    li = i - 1
    ri = i + 1
    If (i = 1) Then li = Shape(k).Elements
    If (i = Shape(k).Elements) Then ri = 1
    l.y = PointChain(k, li).y
    r.y = PointChain(k, ri).y
    dy = r.y - l.y
    CalculateNormalY = dy
End Function
 
Sub CalculateCentroid (k As Integer)
    xx = 0
    yy = 0
    For i = 1 To Shape(k).Elements
        xx = xx + PointChain(k, i).x
        yy = yy + PointChain(k, i).y
    Next
    Shape(k).Centroid.x = xx / Shape(k).Elements
    Shape(k).Centroid.y = yy / Shape(k).Elements
End Sub
 
Sub CalculateDiameter (k As Integer)
    r2max = -1
    For i = 1 To Shape(k).Elements
        xx = Shape(k).Centroid.x - PointChain(k, i).x
        yy = Shape(k).Centroid.y - PointChain(k, i).y
        r2 = xx * xx + yy * yy
        If (r2 > r2max) Then
            r2max = r2
        End If
    Next
    Shape(k).Diameter = Sqr(r2max)
End Sub
 
Sub CalculateMass (k As Integer, factor As Double)
    aa = 0
    For i = 2 To Shape(k).Elements
        x = PointChain(k, i).x - Shape(k).Centroid.x
        y = PointChain(k, i).y - Shape(k).Centroid.y
        dx = (PointChain(k, i).x - PointChain(k, i - 1).x)
        dy = (PointChain(k, i).y - PointChain(k, i - 1).y)
        da = .5 * (x * dy - y * dx)
        aa = aa + da
    Next
    Shape(k).Mass = factor * Sqr(aa * aa)
End Sub
 
Sub CalculateMOI (k As Integer, ctrvec As Vector)
    xx = 0
    yy = 0
    For i = 1 To Shape(k).Elements
        a = ctrvec.x - PointChain(k, i).x
        b = ctrvec.y - PointChain(k, i).y
        xx = xx + a * a
        yy = yy + b * b
    Next
    Shape(k).MOI = Sqr((xx + yy) * (xx + yy)) * (Shape(k).Mass / Shape(k).Elements)
End Sub
 
Sub TranslateShape (k As Integer, c As Vector)
    For i = 1 To Shape(k).Elements
        PointChain(k, i).x = PointChain(k, i).x + c.x
        PointChain(k, i).y = PointChain(k, i).y + c.y
    Next
    Shape(k).Centroid.x = Shape(k).Centroid.x + c.x
    Shape(k).Centroid.y = Shape(k).Centroid.y + c.y
End Sub
 
Sub RotShape (k As Integer, c As Vector, da As Double)
    For i = 1 To Shape(k).Elements
        xx = PointChain(k, i).x - c.x
        yy = PointChain(k, i).y - c.y
        PointChain(k, i).x = c.x + xx * Cos(da) - yy * Sin(da)
        PointChain(k, i).y = c.y + yy * Cos(da) + xx * Sin(da)
    Next
End Sub
 
Sub NewAutoBall (x1 As Double, y1 As Double, r1 As Double, r2 As Double, pa As Double, pb As Double, fx As Integer)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = fx
    Shape(ShapeCount).Collisions = 0
    i = 0
    For j = 0 To (8 * Atn(1)) Step .02 * 8 * Atn(1)
        i = i + 1
        r = r1 + r2 * Cos(pa * j) ^ pb
        PointChain(ShapeCount, i).x = x1 + r * Cos(j)
        PointChain(ShapeCount, i).y = y1 + r * Sin(j)
    Next
    Shape(ShapeCount).Elements = i
    Call CalculateCentroid(ShapeCount)
    If (fx = 0) Then
        Call CalculateMass(ShapeCount, 1)
    Else
        Call CalculateMass(ShapeCount, 999999)
    End If
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    If (fx = 0) Then
        Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
    Else
        Shape(ShapeCount).Shade = _RGB(100, 100, 100)
    End If
    SelectedShape = ShapeCount
End Sub
 
Sub NewAutoBrick (x1 As Double, y1 As Double, wx As Double, wy As Double, ang As Double)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = 1
    Shape(ShapeCount).Collisions = 0
    i = 0
    For j = -wy / 2 To wy / 2 Step 5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + wx / 2
        PointChain(ShapeCount, i).y = y1 + j
    Next
    For j = wx / 2 To -wx / 2 Step -5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + j
        PointChain(ShapeCount, i).y = y1 + wy / 2
    Next
    For j = wy / 2 To -wy / 2 Step -5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 - wx / 2
        PointChain(ShapeCount, i).y = y1 + j
    Next
    For j = -wx / 2 To wx / 2 Step 5
        i = i + 1
        PointChain(ShapeCount, i).x = x1 + j
        PointChain(ShapeCount, i).y = y1 - wy / 2
    Next
    Shape(ShapeCount).Elements = i
    Call CalculateCentroid(ShapeCount)
    Call CalculateMass(ShapeCount, 99999)
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    Shape(ShapeCount).Shade = _RGB(100, 100, 100)
    SelectedShape = ShapeCount
    Call RotShape(ShapeCount, Shape(ShapeCount).Centroid, ang)
End Sub
 
Sub NewBrickLine (xi As Double, yi As Double, xf As Double, yf As Double, wx As Double, wy As Double)
    d1 = Sqr((xf - xi) ^ 2 + (yf - yi) ^ 2)
    d2 = Sqr(wx ^ 2 + wy ^ 2)
    ang = Atn((yf - yi) / (xf - xi))
    f = 1.2 * d2 / d1
    For t = 0 To 1 + f Step f
        Call NewAutoBrick(xi * (1 - t) + xf * t, yi * (1 - t) + yf * t, wx, wy, ang)
    Next
End Sub
 
Sub NewMouseShape (rawresolution As Double, targetpoints As Integer, smoothiterations As Integer)
    ShapeCount = ShapeCount + 1
    Shape(ShapeCount).Fixed = 0
    Shape(ShapeCount).Collisions = 0
    numpoints = 0
    xold = 999 ^ 999
    yold = 999 ^ 999
    Do
        Do While _MouseInput
            x = _MouseX
            y = _MouseY
            If (x > 0) And (x < _Width) And (y > 0) And (y < _Height) Then
                If _MouseButton(1) Then
                    x = x - (_Width / 2)
                    y = -y + (_Height / 2)
                    delta = Sqr((x - xold) ^ 2 + (y - yold) ^ 2)
                    If (delta > rawresolution) And (numpoints < targetpoints - 1) Then
                        numpoints = numpoints + 1
                        PointChain(ShapeCount, numpoints).x = x
                        PointChain(ShapeCount, numpoints).y = y
                        Call cpset(x, y, _RGB(0, 255, 255))
                        xold = x
                        yold = y
                    End If
                End If
            End If
        Loop
        _Display
    Loop Until Not _MouseButton(1) And (numpoints > 1)
 
    Do While (numpoints < targetpoints)
        rad2max = -1
        kmax = -1
        For k = 1 To numpoints - 1
            xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
            yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
            rad2 = xfac ^ 2 + yfac ^ 2
            If rad2 > rad2max Then
                kmax = k
                rad2max = rad2
            End If
        Next
        edgecase = 0
        xfac = PointChain(ShapeCount, numpoints).x - PointChain(ShapeCount, 1).x
        yfac = PointChain(ShapeCount, numpoints).y - PointChain(ShapeCount, 1).y
        rad2 = xfac ^ 2 + yfac ^ 2
        If (rad2 > rad2max) Then
            kmax = numpoints
            rad2max = rad2
            edgecase = 1
        End If
        numpoints = numpoints + 1
        If (edgecase = 0) Then
            For j = numpoints To kmax + 1 Step -1
                PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
                PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
            Next
            PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
            PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
        Else
            PointChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
            PointChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
        End If
    Loop
 
    For j = 1 To smoothiterations
        For k = 2 To numpoints - 1
            TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
            TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
        Next
        For k = 2 To numpoints - 1
            PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
            PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
        Next
        TempChain(ShapeCount, 1).x = (1 / 2) * (PointChain(ShapeCount, numpoints).x + PointChain(ShapeCount, 2).x)
        TempChain(ShapeCount, 1).y = (1 / 2) * (PointChain(ShapeCount, numpoints).y + PointChain(ShapeCount, 2).y)
        PointChain(ShapeCount, 1).x = TempChain(ShapeCount, 1).x
        PointChain(ShapeCount, 1).y = TempChain(ShapeCount, 1).y
        TempChain(ShapeCount, numpoints).x = (1 / 2) * (PointChain(ShapeCount, 1).x + PointChain(ShapeCount, numpoints - 1).x)
        TempChain(ShapeCount, numpoints).y = (1 / 2) * (PointChain(ShapeCount, 1).y + PointChain(ShapeCount, numpoints - 1).y)
        PointChain(ShapeCount, numpoints).x = TempChain(ShapeCount, numpoints).x
        PointChain(ShapeCount, numpoints).y = TempChain(ShapeCount, numpoints).y
    Next
 
    Shape(ShapeCount).Elements = numpoints
    Call CalculateCentroid(ShapeCount)
    Call CalculateMass(ShapeCount, 1)
    Call CalculateMOI(ShapeCount, Shape(ShapeCount).Centroid)
    Call CalculateDiameter(ShapeCount)
    Shape(ShapeCount).Velocity.x = 0
    Shape(ShapeCount).Velocity.y = 0
    Shape(ShapeCount).Omega = 0
    Shape(ShapeCount).Shade = _RGB(100 + Int(Rnd * 155), 100 + Int(Rnd * 155), 100 + Int(Rnd * 155))
    SelectedShape = ShapeCount
End Sub
 
Sub cline (x1 As Double, y1 As Double, x2 As Double, y2 As Double, col As _Unsigned Long)
    Line (_Width / 2 + x1, -y1 + _Height / 2)-(_Width / 2 + x2, -y2 + _Height / 2), col
End Sub
 
Sub ccircle (x1 As Double, y1 As Double, rad As Double, col As _Unsigned Long)
    Circle (_Width / 2 + x1, -y1 + _Height / 2), rad, col
End Sub
 
Sub cpset (x1 As Double, y1 As Double, col As _Unsigned Long)
    PSet (_Width / 2 + x1, -y1 + _Height / 2), col
End Sub
 
Sub cpaint (x1 As Double, y1 As Double, col1 As _Unsigned Long, col2 As _Unsigned Long)
    Paint (_Width / 2 + x1, -y1 + _Height / 2), col1, col2
End Sub
 
Sub cprintstring (y As Double, a As String)
    _PrintString (_Width / 2 - (Len(a) * 8) / 2, -y + _Height / 2), a
End Sub
 
Sub snd (frq As Double, dur As Double)
    If ((frq >= 37) And (frq <= 2000)) Then
        Sound frq, dur
    End If
End Sub
 
Sub SetupPoolGame
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0
 
    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
 
    ' Balls (billiard setup)
    x0 = 160
    y0 = 0
    r = 15
    gg = 2 * r + 4
    gx = gg * Cos(30 * 3.14159 / 180)
    gy = gg * Sin(30 * 3.14159 / 180)
    Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 + 4 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 + 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 0 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 2 * gy, r, 0, 1, 1, 0)
    Call NewAutoBall(x0 + 4 * gx, y0 - 4 * gy, r, 0, 1, 1, 0)
 
    ' Cue ball
    Call NewAutoBall(-220, 0, r, 0, 1, 1, 0)
    Shape(ShapeCount).Velocity.x = 10 + 2 * Rnd
    Shape(ShapeCount).Velocity.y = 1 * (Rnd - .5)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)
 
    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0
End Sub
 
Sub SetupWackyGame
    ' Set external field
    ForceField.x = 0
    ForceField.y = -.08
 
    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
 
    ' Wacky balls
    x0 = -70
    y0 = 120
    r1 = 15
    r2 = 2.5
    gg = 2.5 * (r1 + r2) + 3.5
    gx = gg * Cos(30 * 3.14159 / 180)
    gy = gg * Sin(30 * 3.14159 / 180)
    Call NewAutoBall(x0 + 0 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 1 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 + 0 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 2 * gx, y0 - 2 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 + 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 1 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
    Call NewAutoBall(x0 + 3 * gx, y0 - 3 * gy, r1, r2, Int(Rnd * 3) + 1, Int(Rnd * 1) + 2, 0)
 
    ' Slanted bricks
    wx = 60
    wy = 10
    ww = Sqr(wx * wx + wy * wy) * .85
    Call NewBrickLine(ww, 0, 100 + ww, 100, wx, wy)
    Call NewBrickLine(-ww, 0, -100 - ww, 100, wx, wy)
 
    ' Fidget spinner
    Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)
 
    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.70
    VD = 0.995
    SV = 0.025
End Sub
 
Sub SetupRings
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0
 
    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
 
    For r = 25 To 175 Step 25
        Call NewAutoBall(0, 0, r, 0, 1, 1, 0)
    Next
 
    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0.025
End Sub
 
Sub SetupWallsOnly
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0 - .08
 
    ' Fidget spinner
    Call NewAutoBall(-220, 0, 20, 15, 1.5, 2, 0)
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)
 
    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
 
    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 0.75
    VD = 0.995
    SV = 0.025
End Sub
 
Sub SetupAnglePong
    ' Set external field
    ForceField.x = 0
    ForceField.y = 0
 
    ' Rectangular border
    wx = 42
    wy = 10
    Call NewBrickLine(-_Width / 2 + wx, _Height / 2 - wy, _Width / 2 - wx, _Height / 2 - wy, wx, wy)
    Call NewBrickLine(-_Width / 2 + wx, -_Height / 2 + wy, _Width / 2 - wx, -_Height / 2 + wy, wx, wy)
    wx = 40
    wy = 10
    Call NewBrickLine(-_Width / 2 + wy, -_Height / 2 + 2 * wx, -_Width / 2 + wy, _Height / 2 - 2 * wx, wx, wy)
    Call NewBrickLine(_Width / 2 - wy, -_Height / 2 + 2 * wx, _Width / 2 - wy, _Height / 2 - 2 * wx, wx, wy)
 
    ' Pong ball
    Call NewAutoBall(0, 200, 20, 0, 1, 1, 0)
    Shape(ShapeCount).Velocity.x = -1
    Shape(ShapeCount).Velocity.y = -3
    Shape(ShapeCount).Shade = _RGB(255, 255, 255)
 
    ' Pong Paddle
    Call NewAutoBrick(-100, 10, 100, -10, -.02 * 8 * Atn(1))
    vtemp.x = 0
    vtemp.y = -200
    Call TranslateShape(ShapeCount, vtemp)
    Shape(ShapeCount).Shade = _RGB(200, 200, 200)
 
    ' Parameters
    CPC = 1.15
    FPC = 8
    RST = 1 '0.75
    VD = 1 '0.995
    SV = 0.025
End Sub

NOVARSEG · « **Reply #81 on:** May 27, 2021, 02:28:17 am »

several coffees later

was having problems with ball contact and I thought FULLSCREEN was to blame. Actually the FULLSCREEN is very precise. Run the code and try the arrow keys. See how the balls maintain perfect contact at all positions.

Keys to rotate vector are z or x
keys to adjust vector magnitude (ball velocity) are c or v
Key to toggle red or cyan ball is b

As in the original code, the arrow keys move the ball positions.

rotate vector has an auto fine / coarse control. hold down key longer, for coarse rotation and momentary for fine rotation.

Code shows how WINDOW, FULLSCREEN and NEWIMAGE can work together to make graphics larger on the computer display. This method fills the entire screen automatically. This should work on any size of computer display.

Everyone puts down FULLSCREEN but it has it's uses. There are probably even better ways to do this.

Code: QB64: [Select]

'Original code by OldMoses
'Additional code by Novarseg
 
$COLOR:32
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    cn AS STRING * 4 '                                          ball name by color
    c AS _UNSIGNED LONG '                                       color
    p AS V2 '                                                   position
    m AS V2 '                                                   movement (pre-contact) incoming
    x AS V2 '                                                   vector of post contact movement
    s AS INTEGER '                                              magnitude of movement
END TYPE
 
DIM TEXT(1) AS STRING
DIM RAD AS SINGLE
RAD = 0
DIM c(1) AS STRING
DIM AR AS SINGLE
DIM vertex(1, 1) AS V2 '                                        mouse grabbing handles
DIM mouse AS V2
DIM b(1) AS ball
'DIM SHARED AS V2 origin
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
b(0).c = Red: b(0).cn = "red"
b(1).c = Cyan: b(1).cn = "cyan"
 
SCREEN _NEWIMAGE(600, 600, 32) ' this will (should) allow the magnify effect of fullscreen
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 10, 10
 
AR = _DESKTOPWIDTH / _DESKTOPHEIGHT 'Aspect ratio
 
y1 = (600 / ((_DESKTOPWIDTH / _DESKTOPHEIGHT) + 1))
 
x1 = (600 / ((_DESKTOPHEIGHT / _DESKTOPWIDTH) + 1))
 
WINDOW (-x1, y1)-(x1, -y1) 'correct fullscreen x , y  distortion etc
 
_FULLSCREEN
 
'starting state
b(0).m.x = 0: b(0).m.y = 100 '    reds approach vector
b(0).s = PyT(origin, b(0).m)
'b(0).s = _HYPOT(origin.x - b(0).m.x, origin.y - b(0).m.y) ' reds magnitude (speed or force)
 
b(1).m.x = -100: b(1).m.y = 0 '   cyans approach vector
b(1).s = PyT(origin, b(1).m)
'b(1).s = _HYPOT(origin.x - b(1).m.x, origin.y - b(1).m.y) ' cyans magnitude (speed or force)
 
b(0).p.x = 0: b(0).p.y = 0 '     ball position x, y
b(1).p.x = -100: b(1).p.y = 100 'ball position x, y
 
DO
    CLS
    ms = MBS '                                                  process mouse actions dragging endpoints
    IF ms AND 64 THEN
 
        mouse.x = map!(_MOUSEX, 0, 599, -300, 300)
        mouse.y = map!(_MOUSEY, 0, 599, 300, -300)
 
        FOR x = 0 TO 1
            FOR y = 0 TO 1
                ds! = PyT(vertex(x, y), mouse)
                IF ds! < ballradius * .5 THEN i = x: j = y
            NEXT y
        NEXT x
        SELECT CASE j '                                         grabbing impact position or start of incoming vector
            CASE IS = 0 '                                       impact position- here we use mouse as the new b(#).p
                b(i).p = mouse
            CASE IS = 1 '                                       starting point- here we obtain the b(#).m mathematically
                b(i).m = b(i).p: VecAdd b(i).m, mouse, -1
        END SELECT
    END IF
 
    'IF _KEYDOWN(114) THEN i = 0
    'IF _KEYDOWN(99) THEN i = 1
    IF _KEYDOWN(18432) THEN b(i).p.y = b(i).p.y + 1
    IF _KEYDOWN(20480) THEN b(i).p.y = b(i).p.y - 1
    IF _KEYDOWN(19200) THEN b(i).p.x = b(i).p.x - 1
    IF _KEYDOWN(19712) THEN b(i).p.x = b(i).p.x + 1
 
    'IF _KEYDOWN(119) THEN b(i).m.y = b(i).m.y - 1
    'IF _KEYDOWN(115) THEN b(i).m.y = b(i).m.y + 1
    'IF _KEYDOWN(97) THEN b(i).m.x = b(i).m.x + 1
    'IF _KEYDOWN(100) THEN b(i).m.x = b(i).m.x - 1
 
    '**************Code added by Novarseg
    'Vector rotation and vector magnitude adjustment using keyboard input
 
    I$ = INKEY$
 
    _DELAY .04 'allows enough time for keyboard buffer to accumulate characters
    '           so the vector rotation (fast / slow) operates properly
    '           there is probably a better way to do this
    IF I$ = "" THEN f1 = 0
 
    IF f3 = 0 THEN I$ = "b": f3 = 1
    IF I$ = "b" AND f2 = 0 THEN i = 1: f2 = 1: c(1) = "  SELECTED": c(0) = "           ": GOTO LL1 'cyan
    IF I$ = "b" AND f2 = 1 THEN i = 0: f2 = 0: c(0) = "  SELECTED": c(1) = "           " 'red
    LL1:
 
    IF I$ = "c" THEN 'increase vector magnitude
        mult = 1.01
        VecMult b(i).m, mult
    END IF
 
    IF I$ = "v" THEN 'decrease vector magnitude
        div = 1.01
        VecDIV b(i).m, div 'added a new sub
    END IF
 
    IF I$ = "z" THEN 'rotate vector counter clockwise
        IF RAD > _PI * 2 THEN RAD = 0
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD = RAD + .05
        IF TIMER - t1 <= 1.5 THEN RAD = RAD + .005
 
        signC = COS(RAD) * 1 / ABS(COS(RAD))
        signS = SIN(RAD) * 1 / ABS(SIN(RAD))
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
        b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
    END IF
 
    IF I$ = "x" THEN 'rotate vector clockwise
        IF RAD < 0 THEN RAD = _PI * 2
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD = RAD - .05
        IF TIMER - t1 <= 1.5 THEN RAD = RAD - .005
 
        signC = COS(RAD) * 1 / ABS(COS(RAD))
        signS = SIN(RAD) * 1 / ABS(SIN(RAD))
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
        b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
 
    END IF
    '**************END Code added Novarseg
 
 
    'START OF COLLISION MATHEMATICS SECTION
    ballradius = bPyT(b(0).p, b(1).p, AR) / 2 'the only time this function is used
 
    FOR bn = 0 TO 1
        vertex(bn, 0) = b(bn).p '                               first we establish the mouse handles for ball position
        vertex(bn, 1) = b(bn).p: VecAdd vertex(bn, 1), b(bn).m, -1 ' and incoming vector starting point
    NEXT bn
 
    'Now all the previous garbage is distilled into a single SUB call once a collision is determined
    B2BCollision b(0), b(1)
    'END OF COLLISION MATHEMATICS SECTION
 
    'graphic representation
    FOR grid = -300 TO 300 STEP 20
        IF grid MOD 100 = 0 THEN c& = &HFF7F7F7F ELSE c& = &H5F7F7F7F
        LINE (grid, 300)-(grid, -300), c& 'Gray  'vertical lines
        LINE (-300, grid)-(300, grid), c& ' Gray  'horizontal lines
    NEXT grid
    LINE (b(1).p.x, b(1).p.y)-(b(0).p.x, b(0).p.y), White, , &B0010001000100010 'strike vector
 
    FOR dr = 0 TO 1
 
        CIRCLE (b(dr).p.x, b(dr).p.y), ballradius, b(dr).c, , , AR
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).m.x, b(dr).p.y - b(dr).m.y), b(dr).c 'incoming
 
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).x.x, b(dr).p.y + b(dr).x.y), b(dr).c, , &B1111000011110000 'exit vector
        b$ = b(dr).cn + " @ (" + _TRIM$(STR$(INT(b(dr).p.x))) + ", " + _TRIM$(STR$(INT(b(dr).p.y))) + ")"
        b$ = b$ + "  along <" + _TRIM$(STR$(INT(b(dr).m.x))) + ", " + _TRIM$(STR$(INT(b(dr).m.y))) + ">"
        b$ = b$ + "  exits along <" + _TRIM$(STR$(INT(b(dr).x.x))) + ", " + _TRIM$(STR$(INT(b(dr).x.y))) + ">" + c(dr)
 
        _PRINTSTRING (0, 567 + (16 * dr)), b$
 
        TEXT(dr) = b$ + CHR$(13) + CHR$(10) 'NOVARSEG added this line
    NEXT dr
 
    IF _KEYHIT = ASC("f") THEN 'NOVARSEG added this line
        OPEN "BALL STUFF.TXT" FOR BINARY AS #1 'NOVARSEG added this line
        PUT #1, , TEXT(0) 'NOVARSEG added this line
        PUT #1, , TEXT(1) 'NOVARSEG added this line
        CLOSE 'NOVARSEG added this line
    END IF 'NOVARSEG added this line
 
    ' _LIMIT 500
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
 
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    ' DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    DIM un AS V2
    DIM ut AS V2
    DIM ncomp1 AS V2
    DIM ncomp2 AS V2
    DIM tcomp1 AS V2
    DIM tcomp2 AS V2
 
 
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.m) '
    bnci2 = VecDot(un, ball2.m) '
    btci1 = VecDot(ut, ball1.m) '
    btci2 = VecDot(ut, ball2.m) '
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.x = ncomp1: VecAdd ball1.x, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.x = ncomp2: VecAdd ball2.x, tcomp2, 1 '               add normal and tangent exit vectors
 
END SUB 'B2BCollision
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(var1.x - var2.x, var1.y - var2.y)
 
END FUNCTION 'PyT
 
FUNCTION bPyT (var1 AS V2, var2 AS V2, var3) 'to calulate ball radius only
    'var1.x = var1.x * 1.6384
    bPyT = _HYPOT((var1.x - var2.x) * var3, (var1.y - var2.y) * var3)
 
END FUNCTION 'bPyT
 
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS SINGLE)
 
    var.x = -(var.x + (var2.x * var3)) '                           add vector (or a scalar multiple of) var2 to var)
    var.y = var.y + (var2.y * var3) '                           use var3 = -1 to subtract var2 from var
 
END SUB 'Add_Vector
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'Vec_Mult
 
SUB VecDIV (vec AS V2, divisor AS SINGLE) 'added by Novarseg
 
    vec.x = vec.x / divisor
    vec.y = vec.y / divisor
 
END SUB 'VecDIV
 
 
SUB VecNorm (var AS V2)
 
    m = PyT(origin, var)
    IF m = 0 THEN
        var.x = 0: var.y = 0 '                                  vector with magnitude 0 is a zero vector
    ELSE
        var.x = var.x / m: var.y = var.y / m '                  convert var to unit vector
    END IF
 
END SUB 'VecNorm

@STxAxTIC
realistic effects

OldMoses · « **Reply #82 on:** May 27, 2021, 09:06:33 pm »

I think I may have solved my magnetic ball issue. This latest version even seems to break well. At least I haven't been able to "break" it yet... and I'm amazed at how much the code distilled down. I'm starting to feel like I can now invest time and stress in the table details.

Also fixed the cue strike so that it strikes clean and doesn't "thrust" the cueball if you're slow releasing the button.

A couple control pointers:

It uses all mouse buttons and wheel.
roll the wheel back like you're pulling back a pinball spring. A force number will show in the cueball up to a max of 35
roll the wheel the other way and the force will "reduce" to a max of -35. Click the wheel button sets force at max positive.

Why negative force? you might ask...
positive force accelerates the ball away from the mouse cursor
negative force accelerates the ball toward the mouse cursor
very useful for aiming when you're scrunched up against the table edge.

left click to shoot
click the right mouse button to reset the rack for a new break.

Code: QB64: [Select]

$COLOR:32
'ball colors 1 yellow 2 blue 3 red 4 purple 5 orange 6 green 7 maroon 8 black
'9 yellow/s 10 blue/s 11 red/s 12 purple/s 13 orange/s 14 green/s 15 maroon/s
 
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    sunk AS _BYTE '                                             has ball been sunk true/false
    c AS _UNSIGNED LONG '                                       ball color
    p AS V2 '                                                   position vector
    d AS V2 '                                                   direction vector
    n AS V2 '                                                   normalized direction vector
    s AS SINGLE '                                               speed
    r AS _BYTE '                                                rack position
END TYPE
 
DIM SHARED xtable AS INTEGER
DIM SHARED ytable AS INTEGER
DIM SHARED xt5 AS INTEGER
DIM SHARED bsiz AS INTEGER '                                    radius of ball
DIM SHARED bsiz2 AS INTEGER '                                   ball diameter or sphere of contact
DIM SHARED bl(15) AS ball '                                     ball data
DIM SHARED bnum(15) AS LONG
DIM SHARED tbl AS LONG
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
 
'Set the table size
IF _DESKTOPWIDTH > _DESKTOPHEIGHT * 1.6 THEN
    xtable = _DESKTOPWIDTH - 100: ytable = xtable / 2
ELSE
    ytable = _DESKTOPHEIGHT - 80: xtable = ytable * 2
END IF
 
 
bsiz = INT(((xtable / 118.1102) * 2.375) / 2) '                 size balls to table
bsiz2 = bsiz * 2
xt5 = xtable * .05
 
RANDOMIZE TIMER
RESTORE hue
FOR x = 0 TO 15
    READ bl(x).c
NEXT x
 
MakeTable
MakeBalls
RackEmUp
bl(0).p.y = INT(ytable * .5) '                                  position the cue
bl(0).p.x = INT(xtable * .75)
 
a& = _NEWIMAGE(xtable, ytable, 32)
_DEST a&: SCREEN a&
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 5, 5
 
COLOR , &HFF007632
CLS
 
DO
    CLS
    _PUTIMAGE , tbl, a&
 
    FOR x = 0 TO 15
        IF bl(x).sunk THEN
            IF x = 0 THEN
                'scratch
                bl(0).p.y = INT(ytable * .5) '                  position the cue
                bl(0).p.x = INT(xtable * .75)
            ELSE
                _CONTINUE
            END IF
        END IF
        VecAdd bl(x).p, bl(x).d, 1
        VecMult bl(x).d, .99
        IF PyT(origin, bl(x).d) < .05 THEN bl(x).d = origin
        ColCheck x
        _PUTIMAGE (INT(bl(x).p.x) - CINT(_WIDTH(bnum(x)) / 2), INT(bl(x).p.y) - CINT(_HEIGHT(bnum(x)) / 2)), bnum(x), a&
    NEXT x
 
    ms = MBS%
    IF ms AND 1 THEN
        IF (origin.x = bl(0).d.x) AND (origin.y = bl(0).d.y) THEN
            bl(0).d.x = bl(0).p.x - _MOUSEX '                   get the cue strike vector
            bl(0).d.y = bl(0).p.y - _MOUSEY
            VecNorm bl(0).d '                                   shrink it
            VecMult bl(0).d, su '                               grow it
            DO UNTIL NOT _MOUSEBUTTON(1) '                      prevents cue thrusting,
                WHILE _MOUSEINPUT: WEND '                       i.e. constant acceleration across table
            LOOP '                                              while holding down mouse button
            su = 0 '                                            reset strike units
        END IF
    END IF
    IF ms AND 2 THEN '                                          if mouse right button reset the rack
        BallStop '                                              all displacements to = origin
        bl(0).p.y = INT(ytable * .5)
        bl(0).p.x = INT(xtable * .75)
        RackEmUp
    END IF
    IF ms AND 4 THEN '                                          if mouse center button, set full strike
        IF su = 35 THEN su = 0
        IF su = 0 THEN su = 35
    END IF
    IF ms AND 512 THEN '                                        roll mousewheel back, accelerate away from mouse cursor
        su = Limit%(35, su + 1) '                               like pulling back a pinball spring
    END IF
    IF ms AND 1024 THEN '                                       roll mousewheel frw'd, accelerate towards mouse cursor
        su = su + 1 * (su > -35) '                              helpful in aiming from table edge
    END IF
 
    LINE (_MOUSEX, _MOUSEY)-(CINT(bl(0).p.x), CINT(bl(0).p.y))
    'slope of target line
    pathx = CINT(bl(0).p.x) - _MOUSEX: pathy = CINT(bl(0).p.y) - _MOUSEY
    LINE (bl(0).p.x, bl(0).p.y)-(pathx * 1000, pathy * 1000), Blue
    IF (bl(0).d.x = 0) AND (bl(0).d.y = 0) THEN
        _PRINTSTRING (bl(0).p.x - 8, bl(0).p.y - 8), STR$(su)
    END IF
    _DISPLAY
    _LIMIT 100
LOOP UNTIL _KEYDOWN(27)
 
END
 
'                                                               DATA SECTION
hue:
DATA 4294967295,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688
DATA 4278190080,4294967040,4278190335,4294901760,4286578816,4294944000,4278222848,4286578688
 
start:
DATA 1,2,15,14,8,3,4,6,11,13,12,7,9,10,5,0
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.d) '                               ball 1 normal component of input velocity
    bnci2 = VecDot(un, ball2.d) '                               ball 2 normal component of input velocity
    btci1 = VecDot(ut, ball1.d) '                               ball 1 tangent component of input velocity
    btci2 = VecDot(ut, ball2.d) '                               ball 2 tangent component of input velocity
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.d = ncomp1: VecAdd ball1.d, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.d = ncomp2: VecAdd ball2.d, tcomp2, 1 '               add normal and tangent exit vectors
 
    VecMult ball1.d, .95 '                                      lets take 5% of energy in entropic factors
    VecMult ball2.d, .95
 
END SUB 'B2BCollision
 
 
SUB BallStop
 
    FOR x = 0 TO 15
        bl(x).d = origin
    NEXT x
 
END SUB 'BallStop
 
 
SUB ColCheck (var AS INTEGER)
 
    'check for ball in displacement radius
    disp = SQR(bl(var).d.x * bl(var).d.x + bl(var).d.y * bl(var).d.y) 'vector magnitude for this iteration
    FOR x = 0 TO 15 '
        IF x = var THEN _CONTINUE
        dist = PyT(bl(var).p, bl(x).p) '                calculate distance between var and x
        IF dist < bsiz2 THEN '                          are they closer than two radii, i.e. stuck together
            DIM AS V2 un
            un = bl(var).p: VecAdd un, bl(x).p, -1 '    get a normal vector between them
            VecNorm un '                                shrink it to a unit vector
            VecMult un, (bsiz2 - dist) '                grow it by the amount they intersect
            VecAdd bl(var).p, un, 1 '                   add it to the position
        END IF
        IF dist - bsiz2 < disp THEN '                   if ball x is within reach of magnitude
            dx = bl(var).p.x - bl(x).p.x
            dy = bl(var).p.y - bl(x).p.y
            A## = (bl(var).d.x * bl(var).d.x) + (bl(var).d.y * bl(var).d.y) 'displacement range
            B## = 2 * bl(var).d.x * dx + 2 * bl(var).d.y * dy
                C## = (bl(x).p.x * bl(x).p.x) + (bl(x).p.y * bl(x).p.y) + (bl(var).p.x * bl(var).p.x)_
                     + (bl(var).p.y * bl(var).p.y) + -2 * (bl(x).p.x * bl(var).p.x + bl(x).p.y * bl(var).p.y) - (bsiz2 * bsiz2)
            disabc## = (B## * B##) - 4 * A## * C##
            IF disabc## > 0 THEN '                          ray intersects ball x position
                B2BCollision bl(var), bl(x)
            END IF '                                        end: disabc <= 0  aka ball missed
        END IF '                                            end: dist < disp test
    NEXT x
 
    'wall bounces - now we need to work in pocket corners which we will tentatively treat like immobile balls flanking the holes
    IF bl(var).p.x < bsiz + xt5 OR bl(var).p.x > xtable - bsiz - xt5 THEN
        bl(var).d.x = -bl(var).d.x
        IF bl(var).p.x < bsiz + xt5 THEN '                            if beyond left edge
            bl(var).p.x = bl(var).p.x + (2 * (bsiz + xt5 - bl(var).p.x))
        END IF
        IF bl(var).p.x > xtable - bsiz - xt5 THEN '                   if beyond right edge
            bl(var).p.x = bl(var).p.x - (2 * (bl(var).p.x - (xtable - bsiz - xt5)))
        END IF
    END IF
    IF bl(var).p.y < bsiz + xt5 OR bl(var).p.y > ytable - bsiz - xt5 THEN
        bl(var).d.y = -bl(var).d.y
        IF bl(var).p.y < bsiz + xt5 THEN '                            if beyond top edge
            bl(var).p.y = bl(var).p.y + (2 * (bsiz + xt5 - bl(var).p.y))
        END IF
        IF bl(var).p.y > ytable - bsiz - xt5 THEN '                   if beyond bottom edge
            bl(var).p.y = bl(var).p.y - (2 * (bl(var).p.y - (ytable - bsiz - xt5)))
        END IF
    END IF
 
END SUB 'ColCheck
 
 
SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG, C2 AS _UNSIGNED LONG)
    DIM R AS INTEGER, RError AS INTEGER '                       SMcNeill's circle fill
    DIM X AS INTEGER, Y AS INTEGER
 
    R = ABS(RR)
    RError = -R
    X = R
    Y = 0
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C2, BF 'these two need white here for 9-15 balls
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C2, BF
            END IF
            X = X - 1
            RError = RError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB 'FCirc
 
 
FUNCTION Limit% (lim AS INTEGER, var AS INTEGER)
 
    Limit% = lim - ((var - lim) * (var < lim + 1))
 
END FUNCTION 'Limit%
 
 
SUB MakeBalls
 
    FOR x = 0 TO 15
        'make ball images here
        bnum(x) = _NEWIMAGE(bsiz * 2 + 4, bsiz * 2 + 4, 32)
        _DEST bnum(x)
        IF x = 0 THEN '                                         Cue ball
            FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, bl(x).c
            CIRCLE (_WIDTH(bnum(x)) / 2, _HEIGHT(bnum(x)) / 2), bsiz + 1, Black
        ELSE
            'Solids or stripes
            IF x <= 8 THEN
                FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, bl(x).c ' solid
            ELSE
                FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz, bl(x).c, White '   stripe
            END IF
            FCirc INT(_WIDTH(bnum(x)) / 2), INT(_HEIGHT(bnum(x)) / 2), bsiz - 5, White, White 'number circle
            CIRCLE (_WIDTH(bnum(x)) / 2, _HEIGHT(bnum(x)) / 2), bsiz + 1, Black
            n$ = _TRIM$(STR$(x))
            t& = _NEWIMAGE(16, 16, 32)
            _DEST t&
            COLOR Black
            _PRINTMODE _KEEPBACKGROUND
            IF LEN(n$) > 1 THEN a = 0 ELSE a = 4
            _PRINTSTRING (a, 0), n$, t&
            _DEST bnum(x)
            _PUTIMAGE (8, 8)-(_WIDTH(bnum(x)) - 8, _HEIGHT(bnum(x)) - 8), t&, bnum(x)
            _FREEIMAGE t&
        END IF
    NEXT x
 
END SUB 'MakeBalls
 
 
SUB MakeTable
 
    tbl = _NEWIMAGE(xtable, ytable, 32)
    _DEST tbl
    COLOR , &HFF007632
    CLS
    FOR x = 0 TO 2
        LINE (x, x)-(xtable - x, ytable - x), Black, B
    NEXT x
    FCirc xtable * .75, ytable * .5, 5, Gray, Gray
    FCirc xtable * .75, ytable * .5, 2, White, White
    LINE (xt5, xt5)-(xtable - xt5, ytable - xt5), &HFFFF0000, B , &HF0F0
 
END SUB 'MakeTable
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(ABS(var1.x - var2.x), ABS(var1.y - var2.y)) '  distances and magnitudes
 
END FUNCTION 'PyT
 
 
SUB RackEmUp
 
    yoff = bsiz2 + 4
    xoff = SQR((yoff / 2) * (yoff / 2) + yoff * yoff) - 4
 
    RESTORE start
    FOR rank = 1 TO 5
        FOR b = 1 TO rank
            READ k
            bl(k).p.x = (.25 * xtable) - (xoff * (rank - 1))
            bl(k).p.y = (.5 * ytable) - ((rank - 1) * (.5 * yoff)) + ((b - 1) * yoff)
    NEXT b, rank
 
END SUB 'RackEmUp
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS INTEGER)
 
    var.x = var.x + (var2.x * var3) '                           add (or subtract) two vectors defined by unitpoint
    var.y = var.y + (var2.y * var3) '                           var= base vector, var2= vector to add
 
END SUB 'VecAdd
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'VecMult
 
SUB VecNorm (var AS V2)
 
    m = SQR(var.x * var.x + var.y * var.y) '                    convert var to unit vector
    var.x = var.x / m
    var.y = var.y / m
 
END SUB 'VecNorm
 

NOVARSEG · « **Reply #83 on:** May 27, 2021, 09:22:26 pm »

Graphics look better. Still uses FULLSCREEN .

Code: QB64: [Select]

'Original code by OldMoses
'Additional code by Novarseg
 
$COLOR:32
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    cn AS STRING * 4 '                                          ball name by color
    c AS _UNSIGNED LONG '                                       color
    p AS V2 '                                                   position
    m AS V2 '                                                   movement (pre-contact) incoming
    x AS V2 '                                                   vector of post contact movement
    s AS INTEGER '                                              magnitude of movement
END TYPE
 
 
DIM TEXT(1) AS STRING
DIM RAD AS SINGLE
RAD = 0
DIM c(1) AS STRING
DIM AR AS SINGLE
DIM vertex(1, 1) AS V2 '                                        mouse grabbing handles
DIM mouse AS V2
DIM b(1) AS ball
 
'DIM SHARED AS V2 origin
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
b(0).c = Red: b(0).cn = "red"
b(1).c = Cyan: b(1).cn = "cyan"
 
SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32) 'prevents FULLSCREEN distortion
 
DO: LOOP UNTIL _SCREENEXISTS
' _SCREENMOVE 10, 10
 
MAG = _DESKTOPHEIGHT / 300 'this 300 is from the grid drawing code.
 
WINDOW (-_DESKTOPWIDTH / MAG, _DESKTOPHEIGHT / MAG)-(_DESKTOPWIDTH / MAG, -_DESKTOPHEIGHT / MAG)
 
_FULLSCREEN 'gives a full screen - not a window!
 
'starting state
b(0).m.x = 0: b(0).m.y = 100 '    reds approach vector
b(0).s = PyT(origin, b(0).m)
b(1).m.x = -100: b(1).m.y = 0 '   cyans approach vector
b(1).s = PyT(origin, b(1).m)
b(0).p.x = 0: b(0).p.y = 0 '     ball position x, y
b(1).p.x = -100: b(1).p.y = 100 'ball position x, y
 
DO
    CLS
    ms = MBS '                                                  process mouse actions dragging endpoints
    IF ms AND 64 THEN
 
        mouse.x = map!(_MOUSEX, 0, 599, -300, 300)
        mouse.y = map!(_MOUSEY, 0, 599, 300, -300)
 
        FOR x = 0 TO 1
            FOR y = 0 TO 1
                ds! = PyT(vertex(x, y), mouse)
                IF ds! < ballradius * .5 THEN i = x: j = y
            NEXT y
        NEXT x
        SELECT CASE j '                                         grabbing impact position or start of incoming vector
            CASE IS = 0 '                                       impact position- here we use mouse as the new b(#).p
                b(i).p = mouse
            CASE IS = 1 '                                       starting point- here we obtain the b(#).m mathematically
                b(i).m = b(i).p: VecAdd b(i).m, mouse, -1
        END SELECT
    END IF
 
    'IF _KEYDOWN(114) THEN i = 0
    'IF _KEYDOWN(99) THEN i = 1
    IF _KEYDOWN(18432) THEN b(i).p.y = b(i).p.y + 1
    IF _KEYDOWN(20480) THEN b(i).p.y = b(i).p.y - 1
    IF _KEYDOWN(19200) THEN b(i).p.x = b(i).p.x - 1
    IF _KEYDOWN(19712) THEN b(i).p.x = b(i).p.x + 1
 
    'IF _KEYDOWN(119) THEN b(i).m.y = b(i).m.y - 1
    'IF _KEYDOWN(115) THEN b(i).m.y = b(i).m.y + 1
    'IF _KEYDOWN(97) THEN b(i).m.x = b(i).m.x + 1
    'IF _KEYDOWN(100) THEN b(i).m.x = b(i).m.x - 1
 
    '**************Code added by Novarseg
    'Vector rotation and vector magnitude adjustment using keyboard input
 
    I$ = INKEY$
 
    _DELAY .04 'allows enough time for keyboard buffer to accumulate characters
    '           so the vector rotation (fast / slow) operates properly
    '           there is probably a better way to do this
    IF I$ = "" THEN f1 = 0
 
    IF f3 = 0 THEN I$ = "b": f3 = 1
    IF I$ = "b" AND f2 = 0 THEN i = 1: f2 = 1: c(1) = "  SELECTED": c(0) = "           ": GOTO LL1 'cyan
    IF I$ = "b" AND f2 = 1 THEN i = 0: f2 = 0: c(0) = "  SELECTED": c(1) = "           " 'red
    LL1:
 
    IF I$ = "c" THEN 'increase vector magnitude
        mult = 1.01
        VecMult b(i).m, mult
    END IF
 
    IF I$ = "v" THEN 'decrease vector magnitude
        div = 1.01
        VecDIV b(i).m, div 'added a new sub
    END IF
 
    IF I$ = "z" THEN 'rotate vector counter clockwise
        IF RAD > _PI * 2 THEN RAD = 0
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD = RAD + .05
        IF TIMER - t1 <= 1.5 THEN RAD = RAD + .005
 
        signC = COS(RAD) * 1 / ABS(COS(RAD))
        signS = SIN(RAD) * 1 / ABS(SIN(RAD))
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
        b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
    END IF
 
    IF I$ = "x" THEN 'rotate vector clockwise
        IF RAD < 0 THEN RAD = _PI * 2
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD = RAD - .05
        IF TIMER - t1 <= 1.5 THEN RAD = RAD - .005
 
        signC = COS(RAD) * 1 / ABS(COS(RAD))
        signS = SIN(RAD) * 1 / ABS(SIN(RAD))
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5) * signS
        b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5) * signC
 
 
    END IF
    '**************END Code added Novarseg
 
 
    'START OF COLLISION MATHEMATICS SECTION
 
    ballradius = PyT(b(0).p, b(1).p) / 2
 
    FOR bn = 0 TO 1
        vertex(bn, 0) = b(bn).p '                               first we establish the mouse handles for ball position
        vertex(bn, 1) = b(bn).p: VecAdd vertex(bn, 1), b(bn).m, -1 ' and incoming vector starting point
    NEXT bn
 
    'Now all the previous garbage is distilled into a single SUB call once a collision is determined
    B2BCollision b(0), b(1)
    'END OF COLLISION MATHEMATICS SECTION
 
    'graphic representation
    FOR grid = -300 TO 300 STEP 20
        IF grid MOD 100 = 0 THEN c& = &HFF7F7F7F ELSE c& = &H5F7F7F7F
        LINE (grid, 300)-(grid, -300), c& 'Gray  'vertical lines
        LINE (-300, grid)-(300, grid), c& ' Gray  'horizontal lines
    NEXT grid
 
 
    LINE (b(1).p.x, b(1).p.y)-(b(0).p.x, b(0).p.y), White, , &B0010001000100010 'strike vector
 
    FOR dr = 0 TO 1
 
        CIRCLE (b(dr).p.x, b(dr).p.y), ballradius, b(dr).c, , , 1 'AR
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).m.x, b(dr).p.y - b(dr).m.y), b(dr).c 'incoming
 
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).x.x, b(dr).p.y + b(dr).x.y), b(dr).c, , &B1111000011110000 'exit vector
        b$ = b(dr).cn + " @ (" + _TRIM$(STR$(INT(b(dr).p.x))) + ", " + _TRIM$(STR$(INT(b(dr).p.y))) + ")"
        b$ = b$ + "  along <" + _TRIM$(STR$(INT(b(dr).m.x))) + ", " + _TRIM$(STR$(INT(b(dr).m.y))) + ">"
        b$ = b$ + "  exits along <" + _TRIM$(STR$(INT(b(dr).x.x))) + ", " + _TRIM$(STR$(INT(b(dr).x.y))) + ">" + c(dr)
 
        _PRINTSTRING (0, 567 + (16 * dr)), b$
 
        TEXT(dr) = b$ + CHR$(13) + CHR$(10) 'NOVARSEG added this line
    NEXT dr
 
    IF _KEYHIT = ASC("f") THEN 'NOVARSEG added this line
        OPEN "BALL STUFF.TXT" FOR BINARY AS #1 'NOVARSEG added this line
        PUT #1, , TEXT(0) 'NOVARSEG added this line
        PUT #1, , TEXT(1) 'NOVARSEG added this line
        CLOSE 'NOVARSEG added this line
    END IF 'NOVARSEG added this line
 
    _LIMIT 500
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
 
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    ' DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    DIM un AS V2
    DIM ut AS V2
    DIM ncomp1 AS V2
    DIM ncomp2 AS V2
    DIM tcomp1 AS V2
    DIM tcomp2 AS V2
 
 
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.m) '
    bnci2 = VecDot(un, ball2.m) '
    btci1 = VecDot(ut, ball1.m) '
    btci2 = VecDot(ut, ball2.m) '
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.x = ncomp1: VecAdd ball1.x, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.x = ncomp2: VecAdd ball2.x, tcomp2, 1 '               add normal and tangent exit vectors
 
END SUB 'B2BCollision
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(var1.x - var2.x, var1.y - var2.y)
 
END FUNCTION 'PyT
 
FUNCTION bPyT (var1 AS V2, var2 AS V2, var3) 'to calulate ball radius only
    'var1.x = var1.x * 1.6384
    bPyT = _HYPOT((var1.x - var2.x) * var3, (var1.y - var2.y) * var3)
 
END FUNCTION 'bPyT
 
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS SINGLE)
 
    var.x = -(var.x + (var2.x * var3)) '                           add vector (or a scalar multiple of) var2 to var)
    var.y = var.y + (var2.y * var3) '                           use var3 = -1 to subtract var2 from var
 
END SUB 'Add_Vector
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'Vec_Mult
 
SUB VecDIV (vec AS V2, divisor AS SINGLE) 'added by Novarseg
 
    vec.x = vec.x / divisor
    vec.y = vec.y / divisor
 
END SUB 'VecDIV
 
 
SUB VecNorm (var AS V2)
 
    m = PyT(origin, var)
    IF m = 0 THEN
        var.x = 0: var.y = 0 '                                  vector with magnitude 0 is a zero vector
    ELSE
        var.x = var.x / m: var.y = var.y / m '                  convert var to unit vector
    END IF
 
END SUB 'VecNorm

simplified code

changed

Quote

signC = COS(RAD) * 1 / ABS(COS(RAD))
signS = SIN(RAD) * 1 / ABS(SIN(RAD))
b(i).s = PyT(origin, b(i).m)
b(i).m.y = ((b(i).s ^ 2 / (((COS(RAD)) ^ 2 / (SIN(RAD)) ^ 2) + 1)) ^ .5)* signS
b(i).m.x = -((b(i).s ^ 2 / (((SIN(RAD)) ^ 2 / (COS(RAD)) ^ 2) + 1)) ^ .5)* signC

to

Quote

b(i).s = PyT(origin, b(i).m)
b(i).m.y = b(i).s * COS(RAD(i))
b(i).m.x = b(i).s * SIN(RAD(i))

Code: QB64: [Select]

'Original code by OldMoses
'Additional code by Novarseg
 
$COLOR:32
TYPE V2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE ball
    cn AS STRING * 4 '                                          ball name by color
    c AS _UNSIGNED LONG '                                       color
    p AS V2 '                                                   position
    m AS V2 '                                                   movement (pre-contact) incoming
    x AS V2 '                                                   vector of post contact movement
    s AS INTEGER '                                              magnitude of movement
END TYPE
 
 
DIM TEXT(1) AS STRING
DIM RAD(1) AS SINGLE
RAD = 0
DIM c(1) AS STRING
DIM AR AS SINGLE
DIM vertex(1, 1) AS V2 '                                        mouse grabbing handles
DIM mouse AS V2
DIM b(1) AS ball
 
'DIM SHARED AS V2 origin
DIM SHARED origin AS V2
origin.x = 0: origin.y = 0
b(0).c = Red: b(0).cn = "red"
b(1).c = Cyan: b(1).cn = "cyan"
 
SCREEN _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 32) 'prevents FULLSCREEN distortion
 
DO: LOOP UNTIL _SCREENEXISTS
' _SCREENMOVE 10, 10
 
MAG = _DESKTOPHEIGHT / 300 'this 300 is from the grid drawing code.
 
WINDOW (-_DESKTOPWIDTH / MAG, _DESKTOPHEIGHT / MAG)-(_DESKTOPWIDTH / MAG, -_DESKTOPHEIGHT / MAG)
 
_FULLSCREEN 'gives a full screen - not a window!
 
'starting state
b(0).m.x = 0: b(0).m.y = 100 '    reds approach vector
b(0).s = PyT(origin, b(0).m)
b(1).m.x = -100: b(1).m.y = 0 '   cyans approach vector
RAD(1) = 3 * _PI / 2
b(1).s = PyT(origin, b(1).m)
b(0).p.x = 0: b(0).p.y = 0 '     ball position x, y
b(1).p.x = -100: b(1).p.y = 100 'ball position x, y
 
DO
    CLS
    ms = MBS '                                                  process mouse actions dragging endpoints
    IF ms AND 64 THEN
 
        mouse.x = map!(_MOUSEX, 0, 599, -300, 300)
        mouse.y = map!(_MOUSEY, 0, 599, 300, -300)
 
        FOR x = 0 TO 1
            FOR y = 0 TO 1
                ds! = PyT(vertex(x, y), mouse)
                IF ds! < ballradius * .5 THEN i = x: j = y
            NEXT y
        NEXT x
        SELECT CASE j '                                         grabbing impact position or start of incoming vector
            CASE IS = 0 '                                       impact position- here we use mouse as the new b(#).p
                b(i).p = mouse
            CASE IS = 1 '                                       starting point- here we obtain the b(#).m mathematically
                b(i).m = b(i).p: VecAdd b(i).m, mouse, -1
        END SELECT
    END IF
 
    'IF _KEYDOWN(114) THEN i = 0
    'IF _KEYDOWN(99) THEN i = 1
    IF _KEYDOWN(18432) THEN b(i).p.y = b(i).p.y + 1
    IF _KEYDOWN(20480) THEN b(i).p.y = b(i).p.y - 1
    IF _KEYDOWN(19200) THEN b(i).p.x = b(i).p.x - 1
    IF _KEYDOWN(19712) THEN b(i).p.x = b(i).p.x + 1
 
    'IF _KEYDOWN(119) THEN b(i).m.y = b(i).m.y - 1
    'IF _KEYDOWN(115) THEN b(i).m.y = b(i).m.y + 1
    'IF _KEYDOWN(97) THEN b(i).m.x = b(i).m.x + 1
    'IF _KEYDOWN(100) THEN b(i).m.x = b(i).m.x - 1
 
    '**************Code added by Novarseg
    'Vector rotation and vector magnitude adjustment using keyboard input
 
    I$ = INKEY$
 
    _DELAY .04 'allows enough time for keyboard buffer to accumulate characters
    '           so the vector rotation (fast / slow) operates properly
    '           there is probably a better way to do this
    IF I$ = "" THEN f1 = 0
 
    IF f3 = 0 THEN I$ = "b": f3 = 1
    IF I$ = "b" AND f2 = 0 THEN i = 1: f2 = 1: c(1) = "  SELECTED": c(0) = "           ": GOTO LL1 'cyan
    IF I$ = "b" AND f2 = 1 THEN i = 0: f2 = 0: c(0) = "  SELECTED": c(1) = "           " 'red
    LL1:
 
    IF I$ = "c" THEN 'increase vector magnitude
        mult = 1.01
        VecMult b(i).m, mult
    END IF
 
    IF I$ = "v" THEN 'decrease vector magnitude
        div = 1.01
        VecDIV b(i).m, div 'added a new sub
    END IF
 
    IF I$ = "z" THEN 'rotate vector counter clockwise
        IF RAD(i) > _PI * 2 THEN RAD(i) = 0
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD(i) = RAD(i) + .05
        IF TIMER - t1 <= 1.5 THEN RAD(i) = RAD(i) + .005
 
 
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = b(i).s * COS(RAD(i))
        b(i).m.x = b(i).s * SIN(RAD(i))
 
    END IF
 
    IF I$ = "x" THEN 'rotate vector clockwise
        IF RAD(i) < 0 THEN RAD(i) = _PI * 2
 
        IF f1 = 0 THEN t1 = TIMER: f1 = 1
        IF TIMER - t1 > 1.5 THEN RAD(i) = RAD(i) - .05
        IF TIMER - t1 <= 1.5 THEN RAD(i) = RAD(i) - .005
 
        b(i).s = PyT(origin, b(i).m)
        b(i).m.y = b(i).s * COS(RAD(i))
        b(i).m.x = b(i).s * SIN(RAD(i))
    END IF
    '**************END Code added Novarseg
 
 
    'START OF COLLISION MATHEMATICS SECTION
 
    ballradius = PyT(b(0).p, b(1).p) / 2
 
    FOR bn = 0 TO 1
        vertex(bn, 0) = b(bn).p '                               first we establish the mouse handles for ball position
        vertex(bn, 1) = b(bn).p: VecAdd vertex(bn, 1), b(bn).m, -1 ' and incoming vector starting point
    NEXT bn
 
    'Now all the previous garbage is distilled into a single SUB call once a collision is determined
    B2BCollision b(0), b(1)
    'END OF COLLISION MATHEMATICS SECTION
 
    'graphic representation
    FOR grid = -300 TO 300 STEP 20
        IF grid MOD 100 = 0 THEN c& = &HFF7F7F7F ELSE c& = &H5F7F7F7F
        LINE (grid, 300)-(grid, -300), c& 'Gray  'vertical lines
        LINE (-300, grid)-(300, grid), c& ' Gray  'horizontal lines
    NEXT grid
 
 
    LINE (b(1).p.x, b(1).p.y)-(b(0).p.x, b(0).p.y), White, , &B0010001000100010 'strike vector
 
    FOR dr = 0 TO 1
 
        CIRCLE (b(dr).p.x, b(dr).p.y), ballradius, b(dr).c, , , 1 'AR
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).m.x, b(dr).p.y - b(dr).m.y), b(dr).c 'incoming
 
        LINE (b(dr).p.x, b(dr).p.y)-(b(dr).p.x + b(dr).x.x, b(dr).p.y + b(dr).x.y), b(dr).c, , &B1111000011110000 'exit vector
        b$ = b(dr).cn + " @ (" + _TRIM$(STR$(INT(b(dr).p.x))) + ", " + _TRIM$(STR$(INT(b(dr).p.y))) + ")"
        b$ = b$ + "  along <" + _TRIM$(STR$(INT(b(dr).m.x))) + ", " + _TRIM$(STR$(INT(b(dr).m.y))) + ">"
        b$ = b$ + "  exits along <" + _TRIM$(STR$(INT(b(dr).x.x))) + ", " + _TRIM$(STR$(INT(b(dr).x.y))) + ">" + c(dr)
 
        _PRINTSTRING (0, 567 + (16 * dr)), b$
 
        TEXT(dr) = b$ + CHR$(13) + CHR$(10) 'NOVARSEG added this line
    NEXT dr
 
    IF _KEYHIT = ASC("f") THEN 'NOVARSEG added this line
        OPEN "BALL STUFF.TXT" FOR BINARY AS #1 'NOVARSEG added this line
        PUT #1, , TEXT(0) 'NOVARSEG added this line
        PUT #1, , TEXT(1) 'NOVARSEG added this line
        CLOSE 'NOVARSEG added this line
    END IF 'NOVARSEG added this line
 
    _LIMIT 500
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END
 
 
SUB B2BCollision (ball1 AS ball, ball2 AS ball)
 
    ' DIM AS V2 un, ut, ncomp1, ncomp2, tcomp1, tcomp2
    DIM un AS V2
    DIM ut AS V2
    DIM ncomp1 AS V2
    DIM ncomp2 AS V2
    DIM tcomp1 AS V2
    DIM tcomp2 AS V2
 
 
    un = ball2.p: VecAdd un, ball1.p, -1: VecNorm un '          establish unit normal
    ut.x = -un.y: ut.y = un.x '                                 establish unit tangent
    bnci1 = VecDot(un, ball1.m) '
    bnci2 = VecDot(un, ball2.m) '
    btci1 = VecDot(ut, ball1.m) '
    btci2 = VecDot(ut, ball2.m) '
 
    bncx1 = bnci2 '                                             compute normal component of ball 1 exit velocity
    bncx2 = bnci1 '                                             compute normal component of ball 2 exit velocity
 
    ncomp1 = un: VecMult ncomp1, bncx1 '                        unit normal exit vector x normal component of exit vector ball1
    tcomp1 = ut: VecMult tcomp1, btci1 '                        unit tangent exit vector x tangent component of exit vector
    ncomp2 = un: VecMult ncomp2, bncx2 '                        same for ball2, unit normal...
    tcomp2 = ut: VecMult tcomp2, btci2 '                        same for ball2, unit tangent...
 
    ball1.x = ncomp1: VecAdd ball1.x, tcomp1, 1 '               add normal and tangent exit vectors
    ball2.x = ncomp2: VecAdd ball2.x, tcomp2, 1 '               add normal and tangent exit vectors
 
END SUB 'B2BCollision
 
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
 
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
 
END FUNCTION 'map!
 
 
FUNCTION MBS% 'Mouse Button Status  Author: Steve McNeill
    STATIC StartTimer AS _FLOAT
    STATIC ButtonDown AS INTEGER
    STATIC ClickCount AS INTEGER
    CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
    '                          Down longer counts as a HOLD event.
    SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
    WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
        SELECT CASE SGN(_MOUSEWHEEL)
            CASE 1: MBS = MBS OR 512
            CASE -1: MBS = MBS OR 1024
        END SELECT
    WEND
 
    IF _MOUSEBUTTON(1) THEN MBS = MBS OR 1
    IF _MOUSEBUTTON(2) THEN MBS = MBS OR 2
    IF _MOUSEBUTTON(3) THEN MBS = MBS OR 4
 
    IF StartTimer = 0 THEN
        IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
            ButtonDown = 1: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(2) THEN
            ButtonDown = 2: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        ELSEIF _MOUSEBUTTON(3) THEN
            ButtonDown = 3: StartTimer = TIMER(0.01)
            Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
        END IF
    ELSE
        BD = ButtonDown MOD 3
        IF BD = 0 THEN BD = 3
        IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit.  It's a click
            IF _MOUSEBUTTON(BD) = 0 THEN MBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                MBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                MBS = MBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
END FUNCTION 'MBS%
 
 
FUNCTION PyT (var1 AS V2, var2 AS V2)
 
    PyT = _HYPOT(var1.x - var2.x, var1.y - var2.y)
 
END FUNCTION 'PyT
 
FUNCTION bPyT (var1 AS V2, var2 AS V2, var3) 'to calulate ball radius only
    'var1.x = var1.x * 1.6384
    bPyT = _HYPOT((var1.x - var2.x) * var3, (var1.y - var2.y) * var3)
 
END FUNCTION 'bPyT
 
 
 
SUB VecAdd (var AS V2, var2 AS V2, var3 AS SINGLE)
 
    var.x = -(var.x + (var2.x * var3)) '                           add vector (or a scalar multiple of) var2 to var)
    var.y = var.y + (var2.y * var3) '                           use var3 = -1 to subtract var2 from var
 
END SUB 'Add_Vector
 
 
FUNCTION VecDot (var AS V2, var2 AS V2)
 
    VecDot = var.x * var2.x + var.y * var2.y '                  get dot product of var & var2
 
END FUNCTION 'VecDot
 
 
SUB VecMult (vec AS V2, multiplier AS SINGLE)
 
    vec.x = vec.x * multiplier '                                multiply vector by scalar value
    vec.y = vec.y * multiplier
 
END SUB 'Vec_Mult
 
SUB VecDIV (vec AS V2, divisor AS SINGLE) 'added by Novarseg
 
    vec.x = vec.x / divisor
    vec.y = vec.y / divisor
 
END SUB 'VecDIV
 
 
SUB VecNorm (var AS V2)
 
    m = PyT(origin, var)
    IF m = 0 THEN
        var.x = 0: var.y = 0 '                                  vector with magnitude 0 is a zero vector
    ELSE
        var.x = var.x / m: var.y = var.y / m '                  convert var to unit vector
    END IF
 
END SUB 'VecNorm

STxAxTIC · « **Reply #84 on:** May 27, 2021, 11:30:59 pm »

Looks good Moses!

NOVARSEG · « **Reply #85 on:** May 28, 2021, 01:19:04 am »

Looking at OldMoses code now. Great work.

bplus · « **Reply #86 on:** May 28, 2021, 10:30:54 am »

@OldMoses Yes! I am a little confused by cue stick (not the wheel, that's good!) but really nice ball action.

OldMoses · « **Reply #87 on:** May 28, 2021, 07:00:39 pm »

Probably with the addition of a cue stick image I could make it less confusing, it would then provide an orientation aid. I just can't figure out a natural way of cue handling that doesn't come with various aiming and/or force issues, particularly when shooting from a wall. Aim gets really coarse when the mouse cursor is close to the ball, for mathematically obvious reasons.

And speaking of mathematics; I actually realized that for all its nice appearance, it is not mathematically correct. It doesn't compute ball vectors at the point of impact, but rather from the point at which it's ray tracing equation detects a future collision in the present main loop iteration. It's close, but no cigar, as they say... This is more pronounced at faster speeds. By slowing down the _LIMIT 100 to a _LIMIT 10, the effect can then be easily seen, with faster balls shearing away from each other before actually touching. Updating the striking ball's position reintroduced the magnetic effect. So, back to the drawing board yet again...

Still, I'll consider this a usable baseline from which to tweak things.

bplus · « **Reply #88 on:** May 28, 2021, 08:49:03 pm »

Quote

And speaking of mathematics; I actually realized that for all its nice appearance, it is not mathematically correct. It doesn't compute ball vectors at the point of impact, but rather from the point at which it's ray tracing equation detects a future collision in the present main loop iteration.

@OldMoses About backing up balls to collision kiss point see last code block below

This (from my Pool 3.1, Steve's forum) backs up 2 balls just detected as having deepest collision for ball i, saveJ was the other ball index.

Code: QB64: [Select]

        For i = 0 To topBall
            minDist = 100000: saveJ = -1
            For j = 0 To topBall 'find deepest collision in case more than one we want earliest = deepest penetration
                If i <> j And b(i).x <> -1000 Then
                    dist = Sqr((b(i).x - b(j).x) * (b(i).x - b(j).x) + (b(i).y - b(j).y) * (b(i).y - b(j).y))
                    If dist < BDia Then ' collision but is it first or deepest collision
                        If dist < minDist Then minDist = dist: saveJ = j
                    End If
                End If
            Next
            If saveJ <> -1 Then ' found collision change ball i dx, dy   calc new course for ball i
                ''reflection  from circle  using Vectors  from JB, thanks tsh73
                v1$ = vect$(b(i).x, b(i).y) ' circle i
                v2$ = vect$(b(saveJ).x, b(saveJ).y) ' the other circle j
                dv1$ = vect$(b(i).dx, b(i).dy) ' change in velocity vector
                dv2$ = vect$(b(saveJ).dx, b(saveJ).dy)
                dv1u$ = vectUnit$(dv1$) '1 pixel
                dv2u$ = vectUnit$(dv2$)
 
                ' Here is the place where code hangs, make sure at least 1 vector has a decent length to change
                If vectLen(dv1u$) > .00001 Or vectLen(dv2u$) > .00001 Then
                    Do ' this should back up the balls to kiss point thanks tsh73
                        v1$ = vectSub$(v1$, dv1u$)
                        v2$ = vectSub(v2$, dv2u$)
                    Loop While vectLen(vectSub$(v1$, v2$)) < BDia 'back up our circle i to point on kiss
                End If
 
 

The rest of the code is from that 2D Collision paper you gave us a link to.

I made 2 arrays to hold ball data one for current frame, b(i), and one for next frame, nf(i) that way all ball data gets changed at once for next frame without changing ball data of current frame, so all balls of current frame work on same set of data.

NOVARSEG · « **Reply #89 on:** May 28, 2021, 09:37:38 pm »

@bplus

Quote

I made 2 arrays to hold ball data one for current frame, b(i), and one for next frame, nf(i) that way all ball data gets changed at once for next frame without changing ball data of current frame, so all balls of current frame work on same set of data.

So for frame b(i) check every ball for collisions and if there are any calculate new data and save it in frame nf(i). At what point is the switch made to frame nf(i)?

News:

Author Topic: 2D ball collisions without trigonometry. (Read 21143 times)

NOVARSEG

Re: 2D ball collisions without trigonometry.

OldMoses

Re: 2D ball collisions without trigonometry.

NOVARSEG

Re: 2D ball collisions without trigonometry.

OldMoses

Re: 2D ball collisions without trigonometry.

SMcNeill

Re: 2D ball collisions without trigonometry.

STxAxTIC

Re: 2D ball collisions without trigonometry.

NOVARSEG

Re: 2D ball collisions without trigonometry.

OldMoses

Re: 2D ball collisions without trigonometry.

NOVARSEG

Re: 2D ball collisions without trigonometry.

STxAxTIC

Re: 2D ball collisions without trigonometry.

NOVARSEG

Re: 2D ball collisions without trigonometry.

bplus

Re: 2D ball collisions without trigonometry.

OldMoses

Re: 2D ball collisions without trigonometry.

bplus

Re: 2D ball collisions without trigonometry.

NOVARSEG

Re: 2D ball collisions without trigonometry.