OldMoses' Ark of the Codenant
#1
Given this new clean slate fresh start, I envision this as a place to repost some of my programs and/or links from the old forum. Maybe someone can get some ideas, or at least be amused by my random toddlings. Keeping things neat and contained in one thread to reduce clutter on the new forum.

This first one is my passion/obsession, years in the crafting and stumbling, which has grown in scope and support files/directories beyond just posting a code block. Made possible by QB64 as QBasic/4.5 just couldn't do it. While mostly still a work in progress, it's complete enough to call a "program".

CT Vector, is my turn based space flight vector tracker, a utility attempting to rescue the old Traveller RPG tabletop spaceship combat rules from obscurity. Likely no one who plays the game cares as no one bothered to use them for long, but I always wanted this sort of tool back in the day, and thought it would work, so I wrote one anyway. I'm funny that way...Wink Even used it over the holidays, with somewhat mixed results. Many of the coding concepts I regularly use arose out of this mess, and many folks here will find their influence in it too.

A gamemaster can create and edit stellar systems [sysinput042.bas], whereupon the players can fly spacecraft through them. The system creator is still rather cryptic to use with some knowledge of the game and its canon concepts being helpful, but it does function with a few minor boogers. In lieu of that the tracker will default to the Sol system for demo purposes and the editor ap can be skipped. That's the easiest way to just "play around" with it. There are a couple of other systems included in the systems\ directory. I give a big "thank you" to Spriggsy for his pipecom API for making the loading process much more intuitive.

The tracker [CTvector052.bas] models game rules and is in no way an actual astrophysics or gravity simulator. "Damn it Jim, I'm a farmer, not an astrophysicist!" That said, large planets will attract nearby ships, so you gotta keep 'em flying or they'll crash. It can also take maneuvers to 3D, and resize and zoom in/out, which tabletop plotting could not do. Dates can optionally be input to track planetary ephemeris as the planets will move dynamically during play.

It's been a very long time since I posted any updates to it. My pièce de la résistance, which I have moved to Github. I added some OS metacommands to (hopefully) allow it to skip those commands that are not supported in Mac and Linux. Maybe it will run under those platforms now as well, with only a slight loss in mouse functionality. If anyone does try that, I'd appreciate a shout as to how it went.

In the tracker application, left click actuates controls, while right click & hold opens a context bubble explaining the controls function and hotkey access or moves ships in the sensor display. There is a badly "dated" user guide pdf included.

https://github.com/OldMoses/CT-Vector
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#2
Hi Old...were you not working on a snooker or pool game? If so was it abandoned?
Reply
#3
(04-24-2022, 10:33 PM)Dimster Wrote: Hi Old...were you not working on a snooker or pool game? If so was it abandoned?

I take it out and dust it off once in a while, then keep running into levels of frustration where I have to put it back on the shelf. It has a fairly nice looking ball action, but I know the math is wrong and the break always looks weird.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#4
I guess it would make a difference if you were heading to a snooker game v's a pool game. I can appreciate the math must be very tricky. Anyway, as I recall, you had some nice action on those balls.
Reply
#5
I found that billiards work in progress. It wasn't working because I used Steve's MBS routine and hadn't updated it for 2.1. There's no table yet, but you can swat the balls around the table. It works best with a three button mouse. Right click re-racks, left click strikes the cue and the mousewheel sets the strike force. Clicking the mousewheel sets a maximum force, from which the wheel can fine tune.

Code: (Select All)
$COLOR:32
$CONSOLE
'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

TYPE pylon '                                                    pocket throat radii 2 per pocket
    'poc as _byte '                                              'pocket #
    p AS V2 '                                                   pylon position
    vert AS V2 '                                                bumper vertex
END TYPE


DIM SHARED xtable AS INTEGER '                                  x & y limits of screen/table
DIM SHARED ytable AS INTEGER
DIM SHARED xt5 AS INTEGER '                                     table border depth (5% of xtable)
DIM SHARED bsiz AS INTEGER '                                    radius of ball
DIM SHARED bsiz2 AS INTEGER '                                   ball diameter or sphere of contact
DIM SHARED psiz AS INTEGER '                                    pocket radius
DIM SHARED bl(15) AS ball '                                     ball data
DIM SHARED pl(12) AS pylon '                                    pocket throat bumpers
DIM SHARED bnum(15) AS LONG '                                   ball image handles
DIM SHARED tbl AS LONG '                                        table image handle
DIM SHARED origin AS V2 '                                       zero vector
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
_ECHO STR$(bsiz)
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
        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

        _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
            'but what if a ball penetrates past the other balls center?
        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##
            'disabc## = Ray_Trace##(bl(var).p, bl(var).d, bl(x).p, bsiz2)
            IF disabc## > 0 THEN '                          ray intersects ball x position
                '''still need an impact point, or balls deflect while their still out a ways
                'DIM AS ball vball, xball
                'DIM AS V2 neari
                'vball = bl(var) '                               use temporary balls for B2BCollision call
                'xball = bl(x)
                '''// near intersect quadratic returns percentage of displacement to contact point
                't## = (-B## - ((B## * B##) - 4 * A## * C##) ^ .5) / (2 * A##)
                '''// contact point- because bsiz2 is twice radius we have ball var coordinate as impact point, not
                '''// the actual surface point of impact- we may deflect the var from this point
                'neari.x = bl(var).p.x + t## * bl(var).d.x: neari.y = bl(var).p.y + t## * bl(var).d.y
                '''// now that we have a contact point, we can proceed to deflect the displacements of var and x
                '''// omitting this makes it crash readily, but we have to do something with remaining motion {1-t##} if
                '''// we retain it. We also must use that portion to move ball x
                'vball.p = neari

                B2BCollision bl(var), bl(x) 'USE THIS ALONE IN THE IF BLOCK FOR GOOD, BUT NOT MATHEMATICAL ACTION
                'B2BCollision vball, xball
                'f## = 1 - t##
                'vball.p.x = vball.p.x + f## + vball.d.x: vball.p.y = vball.p.y + f## + vball.d.y
                'bl(var) = vball
                'bl(x) = xball

            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
    'LEFT/RIGHT
    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
    'TOP/BOTTOM
    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: tempMBS = tempMBS OR 512
            CASE -1: tempMBS = tempMBS OR 1024
        END SELECT
    WEND

    IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
    IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
    IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS 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 tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
        ELSE
            IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
                tempMBS = 0: ButtonDown = 0: StartTimer = 0
                Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
            ELSE 'We've now started the hold event
                tempMBS = tempMBS OR 32 * 2 ^ ButtonDown
            END IF
        END IF
    END IF
    MBS% = tempMBS
END FUNCTION 'MBS%


SUB PylonPosition

    'UNDER CONSTRUCTION
    'side pocket width = bsiz * 2.28
    'corner pocket width = bsiz2 * 2 throat width

    'FOR x = 1 TO 12
    'NEXT x

END SUB 'PylonPosition


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


FUNCTION Ray_Trace## (var1 AS V2, var2 AS V2, var3 AS V2, var4 AS _INTEGER64)

    'var1= ball initial position, var2= ball displacement, var3= target ball position, var4= strike radius

    'typical syntax: result = Ray_Trace##(bl(var).p, bl(var).d, bl(x).p, bsiz2)

    dx## = var2.x: dy## = var2.y '                              displacement of ball
    A## = (dx## * dx##) + (dy## * dy##) '                       displacement magnitude squared
    B## = 2 * dx## * (var1.x - var3.x) + 2 * dy## * (var1.y - var3.y)
    C## = (var3.x * var3.x) + (var3.y * var3.y) + (var1.x * var1.x) + (var1.y * var1.y) + -2 * (var3.x * var1.x + var3.y * var1.y) - (var4 * var4)
    Ray_Trace## = (B## * B##) - 4 * A## * C## ' if disabc## < 0 then no intersection =0 tangent >0 intersects two points

END FUNCTION 'Ray_Trace##


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
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#6
Oh that's smart using mouse wheel to set power!
b = b + ...
Reply
#7
Another trope that I used for striking from the edge of the table, was to position the mouse AHEAD of the cueball and use negative power to "pull" the cueball ahead. It helps with the issue of fine tuning the aim when the mouse is constrained close to the cueball.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#8
Hi OldMoses,

I solved the cue stick problem, I think, very well. Basically I eliminated it and just used an aiming line. You never have to worry about being behind the cue with a stick. I also put a ball at the end of aiming line so you can see where exactly the cue ball will contact the object ball.

Did you see my version of pool?
https://staging.qb64phoenix.com/showthread.php?tid=178
b = b + ...
Reply
#9
Yep, in fact I was playing it the other day. It's a lot of fun. Now I have to figure out how to do the pockets on mine.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#10
@OldMoses you are welcome to post your Pool updates in that Corner of Forum to have one place to look for Pool apps.

Man I loved 9 ball, use to go after work and blow off steam and have fun with friends for hours!

Now I have QB64 for that Smile
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)