QB64 Phoenix Edition v3.8.0!

https://github.com/QB64-Phoenix-Edition/...tag/v3.8.0

Enhancements

• #338 - C/C++ compiler update. - @a740g
  • Updates the MinGW toolchain to v12.2.0 r2.
    
• #339 - Improvements on the various dialog functions. - @a740g
  • Many mandatory dialog parameters are now optional.
    
  • Parsable option string arguments are case-insensitive now (required lower case before).
    
• #341 - Adds _UCHARPOS() to the _U* functions family. - @a740g
  • Ideally, this should have been added in v3.7.0 but was not due to an oversight. This function calculates the pixel distance of every character in a string from the origin and is especially helpful for variable width fonts.
    
• #347 - Audio enhancements. - @a740g
  • Updates miniaudio to v0.11.17, which adds support for Apple AIFF and AIFC audio formats. So, we get those too.
    
  • PLAY has been extended to:
    • Select waveforms @n (square = 1, sawtooth = 2, triangle = 3 (default), sine = 4, noise = 5).
      
    • Adjust volume ramping Qn (0ms to 100ms).
      
  • SOUND has been extended to use the following syntax:
    • SOUND frequency#, duration#[, volume#][, panning#][, waveform&]
      
• #346 - Improves the IDE code export abilities. - @RhoSigma-QB64
  • Added ability to export into a [ q b = e x p o r t ] Forum codebox.
    • Thanks to @grymmjack for implementing all these new codeboxes: https://staging.qb64phoenix.com/showthread.php?tid=1740
      
  • The Forum/Wiki exports now go to the clipboard instead of a file and can directly be pasted into the Forum post or Wiki page.
    
  • Progress of export is shown in the status line and you'll get a message upon export completion.
    

• #341 - Fixing the cut-off on certain letters in conjunction with _LOADFONT and PRINT. - @a740g
  • Issue was reported here: https://staging.qb64phoenix.com/showthread.php?tid=1691
    
• #347 - Fixing issues with PLAY statement. - @a740g
  • PLAY is now feature complete supporting "X" + VARPTR$()
    

HI,
I have a problem. When I enter my program, the first thing I do is find out what my external IP is.  For that I use a function that I saw from another programmer.
The problem is that depending on the computer, connection, times you enter the program......, sometimes it does it instantly and sometimes it takes a long time to get it (1 minute or more).
Can anyone think of how to set a timer so that if it hasn't responded in, say, 3 seconds, then program continues at another line? or by presing a key if is more easy?
Tanks

Dim miip As String
Cls: Locate 10, 20: Print "COSULTING PUBLIC IP ...."
 
miip = GetPublicIP
Locate 10, 20: Print "PUBLIC IP: "; miip
 
continue:
'----- Program
 
End
 
 
Function GetPublicIP$
    Dim URL As String
    Dim URLFile As String
    Dim publicip As String
    Dim a%
    URLFile = "publicip"
    URL = "https://api.ipify.org/"
    a% = FileDownload(URL, URLFile)
    Dim U As Integer
    U = FreeFile
    Open URLFile For Binary As #U
    If LOF(U) <> 0 Then
        Line Input #U, publicip
    Else
        Close #U
        Kill URLFile
        GetPublicIP = ""
        Exit Function
    End If
    Close #U
    Kill URLFile
    GetPublicIP = publicip
End Function
 
Declare Dynamic Library "urlmon"
    Function URLDownloadToFileA (ByVal pCaller As Long, szURL As String, szFileName As String, Byval dwReserved As Long, Byval lpfnCB As Long)
End Declare
 
Function FileDownload (URL As String, File As String)
    FileDownload = URLDownloadToFileA(0, URL, File, 0, 0)
End Function

Help!
For all coders like me that are too old to abandon the old Qbasic Keywords vs new QB63pe keywords, it should be a warning AI in the parser!

run this code and you can experimenting what I'm saying.

In this video I walk through the simple PLAY music grid wiki example by JP, to learn and understand the way it works. 

Check out the QB64PE Wiki Example here:
https://qb64phoenix.com/qb64wiki/index.php/PLAY

The commented source is here:
https://gist.github.com/grymmjack/d7fdcd...5a7da9b765

Experimentation and dissection as usual!

I'm still uploading the video - it should be up in an hour.

Thanks for watching!


https://youtu.be/8vCHnr1MAU4

This is an awesome example!

DIM SHARED grid(16, 16), grid2(16, 16), cur
CONST maxx = 512
CONST maxy = 512
SCREEN _NEWIMAGE(maxx, maxy, 32)
_TITLE "MusicGrid"
cleargrid
DO
    IF TIMER - t# > 1 / 8 THEN cur = (cur + 1) AND 15: t# = TIMER
    IF cur <> oldcur THEN
        figuregrid
        drawgrid
        playgrid
        oldcur = cur
    END IF
    domousestuff
    in$ = INKEY$
    IF in$ = "C" OR in$ = "c" THEN cleargrid
LOOP UNTIL in$ = CHR$(27)
 
SUB drawgrid
scale! = maxx / 16
scale2 = maxx \ 16 - 2
FOR y = 0 TO 15
    y1 = y * scale!
    FOR x = 0 TO 15
        x1 = x * scale!
        c& = _RGB32(grid2(x, y) * 64 + 64, 0, 0)
        LINE (x1, y1)-(x1 + scale2, y1 + scale2), c&, BF
    NEXT x
NEXT y
END SUB
 
SUB figuregrid
FOR y = 0 TO 15
    FOR x = 0 TO 15
        grid2(x, y) = grid(x, y)
    NEXT x
NEXT y
FOR y = 1 TO 14
    FOR x = 1 TO 14
        IF grid(x, y) = 1 AND cur = x THEN
            grid2(x, y) = 2
            IF grid(x - 1, y) = 0 THEN grid2(x - 1, y) = 1
            IF grid(x + 1, y) = 0 THEN grid2(x + 1, y) = 1
            IF grid(x, y - 1) = 0 THEN grid2(x, y - 1) = 1
            IF grid(x, y + 1) = 0 THEN grid2(x, y + 1) = 1
        END IF
    NEXT x
NEXT y
END SUB
 
SUB domousestuff
DO WHILE _MOUSEINPUT
    IF _MOUSEBUTTON(1) THEN
        x = _MOUSEX \ (maxx \ 16)
        y = _MOUSEY \ (maxy \ 16)
        grid(x, y) = 1 - grid(x, y)
    END IF
LOOP
END SUB
 
SUB playgrid
n$ = "L16 "
'scale$ = "O1CO1DO1EO1FO1GO1AO1BO2CO2DO2EO2FO2GO2AO2BO3CO3D"
scale$ = "o1fo1go1ao2co2do2fo2go2ao3co3do3fo3go3ao4co4do4fo"
FOR y = 15 TO 0 STEP -1
    IF grid(cur, y) = 1 THEN
        note$ = MID$(scale$, 1 + (15 - y) * 3, 3)
        n$ = n$ + note$ + ","  'comma plays 2 or more column notes simultaneously
    END IF
NEXT y
n$ = LEFT$(n$, LEN(n$) - 1)
PLAY n$
END SUB
 
SUB cleargrid
FOR y = 0 TO 15
    FOR x = 0 TO 15
        grid(x, y) = 0
    NEXT x
NEXT y
END SUB

Couldn't find the exotic landscape background mod but found this for a sun:

 
Screen _NewImage(800, 600, 32)
Do
    For r = 0 To 500 Step .25
        Circle (400, 300), r, Ink~&(&HFFFFFF44, &HFF220088, r / 500)
    Next
    For i = 1 To 100
        a = Rnd * _Pi(2)
        r1 = 20 + Rnd * 100
        r2 = r1 + 20 + Rnd * 260
        midx = _Width / 2 + (r1 + (r2 - r1) / 2) * Cos(a): midy = _Height / 2 + (r1 + (r2 - r1) / 2) * Sin(a)
        ray& = _NewImage(r2 - r1, 1, 32)
        _PutImage , 0, ray&, (400, 300)-Step(r2 - r1, 1)
        RotoZoom midx, midy, ray&, 1, _R2D(a)
        _FreeImage ray&
    Next
    _Display
    _Limit 10
Loop Until _KeyDown(27)
 
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub
 
Function Ink~& (c1 As _Unsigned Long, c2 As _Unsigned Long, fr##)
    Dim R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
End Function
 
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
    For i& = 0 To 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

Over the past few months I've made a few attempts at creating a 2D physics library for QB64 but have failed miserably. My first few attempts were writing something from scratch. I quickly realized that while I have a fair grasp on basic trig and vector math I have nowhere near the knowledge to implement such things as angular momentum, raytracing, and 2D collision physics. Even after trying to tutor myself on the subject I seem to still be just as confused (if not more).

I then decided to follow a few video tutorials I found on Youtube related to creating a 2D physics engine. Of course these are all either meant for C++, Java, or JavaScript using OOP. I figured the process of converting the Java OOP code to functions and procedures would be fairly straight forward ... not so much. (Below I provide a link to the video series I am following along with the code I created so far).

My next thought was to incorporate the Box2D physics engine (the engine that Rovio used to create Angry Birds) into QB64. The Library is written in C++ and I figured by using DECLARE LIBRARY I could get this done. However, my C++ knowledge is lacking as well. Trying to figure out where pointers are used versus variables, their types, and when I need _OFFSETs is just confusing this old thick headed brain of mine. Here is a link to the Box2D physics engine:

https://box2d.org/about/

I feel QB64 needs a 2D physics engine to help attract more users. I know my games would be vastly improved if I had access to something that could create Angry Birds style game physics.

Is anyone with more knowledge on either subject, importing Box2D into QB64, or tutoring and helping me build an engine, willing to help? Box2D also has a light version, Box2D_Lite, that may be a good start if porting the engine is an option.

Below is a link to the video series I was following. I got to the end of Lesson 9 and am totally confused on what the presenter did when introducing the FOR loop.

The video series:

https://www.youtube.com/watch?v=vcgtwY39...iO&index=2

And the code I hacked together so far trying to follow along and convert OOP to QB64 on the fly.

'https://www.youtube.com/watch?v=XG6yOtEpRSw&list=PLtrSb4XxIVbpZpV65kk73OoUcIrBzoSiO&index=2
 
 
OPTION _EXPLICIT
 
CONST MIN_VALUE = -2.802597E-45
 
 
TYPE Type_Vector2
    x AS SINGLE
    y AS SINGLE
END TYPE
 
TYPE Type_Ray2D
    origin AS Type_Vector2
    direction AS Type_Vector2
END TYPE
 
TYPE Type_RaycastResult
    ppoint AS Type_Vector2
    normal AS Type_Vector2
    t AS SINGLE
    hit AS INTEGER
 
END TYPE
 
TYPE Type_Line2D
    from AS Type_Vector2
    too AS Type_Vector2
    colour AS _UNSIGNED LONG
    lifetime AS INTEGER
END TYPE
 
TYPE Type_Rigidbody2D
    position AS Type_Vector2
    rotation AS SINGLE
END TYPE
 
TYPE Type_Box2D '              rotated bounding box
    size AS Type_Vector2
    halfSize AS Type_Vector2
    rigidbody AS Type_Rigidbody2D
END TYPE
 
TYPE Type_AABB '              axis aligned bounding box (not rotated)
    size AS Type_Vector2
    halfSize AS Type_Vector2
    rigidbody AS Type_Rigidbody2D
END TYPE
 
TYPE Type_Circle
    Radius AS SINGLE
    rigidbody AS Type_Rigidbody2D
END TYPE
 
 
DIM __AABB AS Type_AABB
DIM __Circle AS Type_Circle
DIM __rigidbody2D AS Type_Rigidbody2D
DIM Vertices(4) AS Type_Vector2
 
 
 
 
 
SUB Line2D.setFromToo (__line2D AS Type_Line2D, from AS Type_Vector2, too AS Type_Vector2)
 
    __line2D.from = from
    __line2D.too = too
 
END SUB
 
 
SUB Line2D (__line2D AS Type_Line2D, from AS Type_Vector2, too AS Type_Vector2, colour AS _UNSIGNED LONG, lifetime AS INTEGER)
 
    __line2D.from = from
    __line2D.too = too
    __line2D.colour = colour
    __line2D.lifetime = lifetime
 
END SUB
 
 
FUNCTION Line2D.beginFrame (__line2d AS Type_Line2D)
 
    __line2d.lifetime = __line2d.lifetime - 1
    Line2D.beginFrame = __line2d.lifetime
 
END FUNCTION
 
 
SUB Line2D.getFrom (__line2d AS Type_Line2D, from AS Type_Vector2)
 
    from = __line2d.from
 
END SUB
 
SUB Line2D.getToo (__line2d AS Type_Line2D, too AS Type_Vector2)
 
    too = __line2d.too
 
END SUB
 
 
SUB Line2D.getStart (__line2d AS Type_Line2D, start AS Type_Vector2)
 
    start = __line2d.from
 
END SUB
 
SUB Line2D.getEnd (__line2d AS Type_Line2D, endd AS Type_Vector2)
 
    endd = __line2d.too
 
END SUB
 
 
FUNCTION Line2D.getColour (__line2d AS Type_Line2D)
 
    Line2D.getColour = __line2d.colour
 
END FUNCTION
 
 
FUNCTION Line2D.lengthSquared (__line2d AS Type_Line2D)
 
    DIM from AS Type_Vector2
    DIM too AS Type_Vector2
    DIM length AS Type_Vector2
 
    Line2D.getFrom __line2d, from
    Line2D.getToo __line2d, too
 
    length.x = too.x - from.x
    length.y = too.y - from.y
 
    Line2D.lengthSquared = lengthSquared(length)
 
END FUNCTION
 
 
 
 
 
'********************************
'*          RIGIDBODY          * <-----------------------------------------------------------------------
'********************************
 
 
'--------------------------------
'---- IntersectionDetector2D ----
'--------------------------------
 
FUNCTION PointOnLine (TestPoint AS Type_Vector2, __line2D AS Type_Line2D)
 
    ' based on the Slope Intercept Form of the equation of a straight line
    '
    '
    '  |                                      S = Line Start = (0,1)
    '  |                            (8,5)    E = Line End  = (8,5)
    ' 5+                            __ù      Need to get values of this formula: y = m * x + b
    '  |                          _-          Solve for m:
    '  |                        _--              - dy = Ey - Sy = 5 - 1 = 4
    ' 4+                    __-                - dx = Ex - Sx = 8 - 0 = 8
    '  |                  _-                          dy    4    1
    '  |      P        _--                      - m = ---- = --- = --- (m solved)
    ' 3+      ù      __-                                dx    8    2
    '  |    (2,3)  _-                          Solve for b:
    '  |        _--                              - b = y - mx  (plug in x (0) and y (1) from line start)
    ' 2+    __-                                            1
    '  |  _-                                    - b = 1 - --- * 0 = 1 - 0 = 1 (b solved)
    '  |_--                                                2
    ' 1ù                                      Plug in values from Px along with solved m and b to compare y result with Py
    '(0,1)                                              1
    '  |                                        - y = --- * x + 1 = y = .5 * 2 + 1 = y = 2 (FALSE) 2 is not equal to Py (3)
    '  +---+---+---+---+---+---+---+---+---            2
    ' 0    1  2  3  4  5  6  7  8
    '
 
    DIM lineStart AS Type_Vector2 ' start vector of line (x,y)
    DIM lineEnd AS Type_Vector2 '  end  vector of line (x,y)
    DIM dx AS SINGLE '              run  (delta in the x direction)
    DIM dy AS SINGLE '              rise (delta in the y direction)
    DIM m AS SINGLE '              slope (rise over run)
    DIM b AS SINGLE '              the y intercept
 
    PointOnLine = 0 '                                            assume point not on line
 
    '----------
    lineStart = __line2D.from
    lineEnd = __line2D.too
    'Line2D.getStart __line2D, lineStart '                        get line start vector (x,y)
    'Line2D.getEnd __line2D, lineEnd '                            get line end  vector (x,y)
    '----------
 
    dy = lineEnd.y - lineStart.y '                              calculate rise
    dx = lineEnd.x - lineStart.x '                              calculate run
    IF dx = 0 THEN '                                            vertical line? (avoid divide by 0)
        IF TestPoint.x = lineStart.x THEN '                      yes, do x values match?
            PointOnLine = -1 '                                  yes, must be on the line
            EXIT FUNCTION '                                      leave
        END IF
    END IF
    m = dy / dx '                                                calculate slope
    b = lineStart.y - (m * lineStart.x) '                        calculate y intercept
    IF TestPoint.y = m * TestPoint.x + b THEN PointOnLine = -1 ' point on line if y = mx + b
 
END FUNCTION
 
 
FUNCTION PointInCircle (TestPoint AS Type_Vector2, __circle AS Type_Circle)
 
    ' Check for point within circle.
    '
    '
    '              *********                      - Simply use Pythagoras to solve.
    '          ****        ****
    '      ***\                ***                - Calculate x and y sides from point to center
    '    **    \                  **              - if x side * x side + y side * y side <= radius * radius then point within circle
    '    *      \            x2    *              - (this method negates having to use square root)
    '  *  Radius\    +--------------*---__ù p2
    '  *          \ y2|              _*--          p1: x1 = p1.x - center.x
    '  *            \  |          __-- *                y1 = p1.y - center.y
    ' *              \ |      __--      *              x1 * x1 + y1 * y1 <= radius * radius (TRUE - point within circle)
    ' *              \|  __--  L2      *
    ' *    Center x,y ù--              *          p2: x2 = p2.x - center.x
    ' *                |\              *              y2 = p2.y - center.y
    ' *                | \ L1          *              x2 * x2 + y2 * y2 <= radius * radius (FALSE - point NOT within circle)
    '  *            y1|  \            *
    '  *              |  \          *
    '  *              +----ù        *
    '    *              x1  p1      *
    '    **                      **
    '      ***                ***
    '          ****        ****
    '              *********
 
    DIM circleCenter AS Type_Vector2 '  center coordinate of circle (x,y)
    DIM centerToPoint AS Type_Vector2 ' x,y lengths
    DIM radius AS SINGLE '              radius of circle
 
    PointInCircle = 0 '                                                          assume point not within circle
 
    '----------
    circleCenter = __circle.rigidbody.position
    'Circle.getCenter __circle, circleCenter '                                    get center coordinate of circle (x,y)
    '----------
 
    '----------
    radius = __circle.Radius
    'radius = Circle.getRadius(__circle) '                                        get radius of circle
    '----------
 
    centerToPoint.x = TestPoint.x - circleCenter.x '                            calculate x distance from point to center of circle
    centerToPoint.y = TestPoint.y - circleCenter.y '                            calculate y distance from point to center of circle
    IF lengthSquared(centerToPoint) <= radius * radius THEN PointInCircle = -1 ' return true if length <= radus of circle
 
END FUNCTION
 
 
FUNCTION PointInAABB (TestPoint AS Type_Vector2, box AS Type_AABB)
 
    ' Check for a point inside standard rectangle (AABB axis aligned bounding box)
    '
    '      .                              .          Four simple checks needed to see if point is within a non rotated rectangle
    '      .                              .
    '      .                              .          p1: p1.x <= max.x (TRUE) AND
    ' ..... +-------------------------------+ .....        min.x <= p1.x (TRUE) AND
    '      |min(x,y)                      |              p1.y <= max.y (TRUE) AND
    '      |                              |              min.y <= p1.y (TRUE) = All TRUE means within rectangle
    '      |                              |
    '      |                      p1      |          p2: p2.x <= max.x (FALSE) AND
    '      |                      .      |              min.x <= p2.x (TRUE) AND
    '      |                              |  p2        p2.y <= max.y (TRUE) AND
    '      |                              |  .          min.y <= p2.y (TRUE) = Any FALSE means NOT within rectangle
    '      |                              |
    '      |                              |
    '      |                              |
    '      |                      max(x,y)|
    ' ..... +-------------------------------+ .....
    '      .                              .
    '      .                              .
    '      .                              .
 
    DIM min AS Type_Vector2 ' upper left  rectangular coordinate (x,y)
    DIM max AS Type_Vector2 ' lower right rectangular coordinate (x,y)
 
    AABB.getMin box, min '                    get upper left  coordinate
    AABB.getMax box, max '                    get lower right coordinate
    PointInAABB = 0 '                          assume point not within AABB
    IF TestPoint.x <= max.x THEN '            perform the four checks
        IF min.x <= TestPoint.x THEN
            IF TestPoint.y <= max.y THEN
                IF min.y <= TestPoint.y THEN
                    PointInAABB = -1 '        if all true report point within
                END IF
            END IF
        END IF
    END IF
 
END FUNCTION
 
 
FUNCTION PointInBox2D (TestPoint AS Type_Vector2, box AS Type_Box2D)
    '
    ' Test for a point in a rotated 2D box by rotating the point into the box's local space
    '
    '              _-\
    '            _-  \        P
    '          _-      \      _ù rotated position
    '        _-        \  _-
    '      _-            \_-
    '    _-            _-\      - Rotate point P around origin C the same degree as rotated box
    '  -  Rotated    _-  \    - Point P is now in the local boxe's space
    '  \  AABB    _-      \    - From here it's just a simple AABB min/max check
    '    \        Cù        \
    '    \        \      _-
    '      \        \    _-    
    '      \        \ _-      |
    '        \        _\        /
    '        \    _-  \      /
    '          \  _-    \    _-
    '          \-        \ _-
    '                      ù original position
    '                      P
 
    DIM pointLocalBoxSpace AS Type_Vector2
    DIM min AS Type_Vector2
    DIM max AS Type_Vector2
 
    PointInBox2D = 0 '                                                          assume point not within
    Box2D.getMin box, min '                                                    get upper left coordinate
    Box2D.getMax box, max '                                                    get lower right coordinate
    pointLocalBoxSpace = TestPoint '                                            copy test point
 
    '+------------------------------------------------+
    '| Translate the point into the box's local space |
    '+------------------------------------------------+
 
    Rotate pointLocalBoxSpace, box.rigidbody.rotation, box.rigidbody.position ' rotate point into box's local space
 
    '+-----------------------------------------+
    '| Perform standard point within AABB test |
    '+-----------------------------------------+
 
    IF pointLocalBoxSpace.x <= max.x THEN '                                    perform the four AABB checks
        IF min.x <= pointLocalBoxSpace.x THEN
            IF pointLocalBoxSpace.y <= max.y THEN
                IF min.y <= pointLocalBoxSpace.y THEN
                    PointInBox2D = -1 '                                        if all true report point within
                END IF
            END IF
        END IF
    END IF
 
END FUNCTION
 
 
FUNCTION lineAndCircle (__line2D AS Type_Line2D, __circle AS Type_Circle)
    '
    ' Use projection to determine if a line is intersecting a circle
    '
    '                                  *********                  Determine if line B is intersecting circle:
    '                              ****        ****              - Line B end points are outside circle (check points within circle)
    '                          ***                ***              - If either end point within circle then line B is intersecting (return TRUE)
    '                        **                      **          - Get line segment x and y lengths and store in ab.x and ab.y
    '                        *                          *        - Get vector x and y lengths from center of circle to start of line segment
    '                      *                            *          - Store in centerToLineStart.x and centerToLineStart.y
    '                      *                              *      - Perform dot product of vectors to get a percentage of line segment
    '                      *                              *        -      centerToLineStart ù ab
    '                    *              Center            *          t = ------------------------  t = 0 to 1 (percentage of A to B)
    '                    *              x,y              *                      ab        ù ab
    '                    *            __+                *      - Add (ab * t) to Start to get point C (closest point to center)
    '                    *        __---  |                *      - check for point C within circle
    '                    *  ___---        |                *      - (this method negates the need to use square root)
    '              A    ___--              |              *
    '              __---  *              |              *
    '        ___---        *                            *
    ' Start ù------------------------------ù-----------------------------ù End
    '                        **          C          **
    '              B            ***  closest point  ***
    '                              ****        ****
    '      |                          *********                        |
    '      |---------------------------- ab --------------------------|
    '      |                                                            |
 
    DIM LineStart AS Type_Vector2 '          start line vector      (x,y)
    DIM LineEnd AS Type_Vector2 '            end  line vector      (x,y)
    DIM ab AS Type_Vector2 '                  line segment            (ex-sx,ey-sy)
    DIM circleCenter AS Type_Vector2 '        center of circle        (x,y)
    DIM centerToLineStart AS Type_Vector2 '  start of line to center (cx-sx,cy-sy)
    DIM t AS SINGLE '                        percentage of the line  (0 to 1)
    DIM closestPoint AS Type_Vector2 '        closest point on line to center
 
    lineAndCircle = 0 '                                                              assume no intersection
 
    '----------
    LineStart = __line2D.from
    LineEnd = __line2D.too
    'Line2D.getStart __line2D, LineStart '                                            get start vector of line (x,y)
    'Line2D.getEnd __line2D, LineEnd '                                                get end  vector of line (x,y)
    '----------
 
    IF PointInCircle(LineStart, __circle) OR PointInCircle(LineEnd, __circle) THEN ' is either line end point within circle?
        lineAndCircle = -1 '                                                        yes, then line must be intersecting circle
        EXIT FUNCTION '                                                              leave
    END IF
    ab.x = LineEnd.x - LineStart.x '                                                calculate line segment length
    ab.y = LineEnd.y - LineStart.y
 
    '+--------------------------------------------------------+
    '| Project point (circle position) onto ab (line segment) |
    '| result = parameterized position t                      |
    '+--------------------------------------------------------+
 
    '----------
    circleCenter = __circle.rigidbody.position
    'Circle.getCenter __circle, circleCenter '                                        get center of circle
    '----------
 
    centerToLineStart.x = circleCenter.x - LineStart.x '                            calculate length from center to start of line segment
    centerToLineStart.y = circleCenter.y - LineStart.y
    t = Dot(centerToLineStart, ab) / Dot(ab, ab) '                                  perform dot product on vectors to get percentage
    IF t < 0 OR t > 1 THEN EXIT FUNCTION '                                          leave if not between the line segment, no intersection
 
    '+--------------------------------------------+
    '| Find the closest point to the line segment |
    '+--------------------------------------------+
 
    closestPoint.x = LineStart.x + ab.x * t '                                        calculate closest line point to center of circle
    closestPoint.y = LineStart.y + ab.y * t
    lineAndCircle = PointInCircle(closestPoint, __circle) '                          return result of closest point within circle
 
END FUNCTION
 
 
FUNCTION lineAndAABB (__line2D AS Type_Line2D, box AS Type_AABB)
 
    'Raycasting
 
    DIM lineStart AS Type_Vector2
    DIM lineEnd AS Type_Vector2
    DIM unitVector AS Type_Vector2
    DIM min AS Type_Vector2
    DIM max AS Type_Vector2
    DIM tmin AS SINGLE
    DIM tmax AS SINGLE
    DIM t AS SINGLE
 
    lineAndAABB = 0
    Line2D.getStart __line2D, lineStart
    Line2D.getEnd __line2D, lineEnd
 
    IF PointInAABB(lineStart, box) OR PointInAABB(lineEnd, box) THEN
        lineAndAABB = -1
        EXIT FUNCTION
    END IF
 
    unitVector.x = lineEnd.x - lineStart.x
    unitVector.y = lineEnd.y - lineEnd.y
 
    Normalize unitVector
 
    IF unitVector.x <> 0 THEN unitVector.x = 1 / unitVector.x
    IF unitVector.y <> 0 THEN unitVector.y = 1 / unitVector.y
 
    AABB.getMin box, min
    min.x = min.x - lineStart.x * unitVector.x
    min.y = min.y - lineStart.y * unitVector.y
    AABB.getMax box, max
    max.x = max.x - lineStart.x * unitVector.x
    max.y = max.y - lineStart.y * unitVector.y
 
    tmin = MathMax(MathMin(min.x, max.x), MathMin(min.y, max.y))
    tmax = MathMin(MathMax(min.x, max.x), MathMax(min.y, max.y))
 
    IF tmax < 0 OR tmin > tmax THEN EXIT FUNCTION
 
    IF tmin < 0 THEN t = tmax ELSE t = tmin
 
    IF t > 0 AND t * t < Line2D.lengthSquared(__line2D) THEN lineAndAABB = -1
 
 
END FUNCTION
 
 
FUNCTION lineAndBox2D (__line2d AS Type_Line2D, box AS Type_Box2D)
 
    'Rotate the line into the box's local space
 
    DIM theta AS SINGLE
    DIM center AS Type_Vector2
    DIM localStart AS Type_Vector2
    DIM localEnd AS Type_Vector2
    DIM localLine AS Type_Line2D
    DIM min AS Type_Vector2
    DIM max AS Type_Vector2
    DIM __aabb AS Type_AABB
 
    theta = -box.rigidbody.rotation
    center = box.rigidbody.position
 
    Line2D.getStart __line2d, localStart
    Line2D.getEnd __line2d, localEnd
    Rotate localStart, theta, center
    Rotate localEnd, theta, center
 
    'Line2D localLine, localStart, localEnd, _RGB32(255, 255, 255), 1  (instead of 2 lines below)
 
    localLine.from = localStart
    localLine.too = localEnd
 
    Box2D.getMin box, min
    Box2D.getMax box, max
 
    AABB __aabb, min, max
 
    lineAndBox2D = lineAndAABB(localLine, __aabb)
 
END FUNCTION
 
' +----------+
' | Raycasts |
' +----------+
 
 
FUNCTION RaycastCircle (__circle AS Type_Circle, ray AS Type_Ray2D, result AS Type_RaycastResult)
 
    DIM originToCircle AS Type_Vector2
    DIM center AS Type_Vector2
    DIM origin AS Type_Vector2
    DIM radius AS SINGLE
    DIM radiusSquared AS SINGLE
    DIM originToCircleLengthSquared AS SINGLE
    DIM direction AS Type_Vector2
    DIM a AS SINGLE
    DIM bSq AS SINGLE
    DIM f AS SINGLE
    DIM t AS SINGLE
    DIM ppoint AS Type_Vector2
    DIM normal AS Type_Vector2
 
    RaycastCircle = 0
 
    RaycastResult.reset result
 
    Circle.getCenter __circle, center
    Ray2D.getOrigin ray, origin
 
    originToCircle.x = center.x - origin.x
    originToCircle.y = center.y - origin.y
 
    radius = Circle.getRadius(__circle)
 
    radiusSquared = radius * radius
 
    originToCircleLengthSquared = lengthSquared(originToCircle)
 
    ' Project the vector from the ray origin onto the direction of the ray
 
    Ray2D.getDirection ray, direction
 
    a = Dot(originToCircle, direction)
 
    bSq = originToCircleLengthSquared - (a * a)
 
    IF radiusSquared - bSq < 0 THEN EXIT FUNCTION
 
    f = SQR(radiusSquared - bSq)
 
    t = 0
    IF originToCircleLengthSquared < radiusSquared THEN
        t = a + f ' ray starts inside the circle
    ELSE
        t = a - f ' ray starts outside the circle
    END IF
 
    IF result.ppoint.x + result.ppoint.y = 0 THEN
 
        ppoint.x = origin.x + direction.x * t
        ppoint.y = origin.y + direction.y * t
 
        normal.x = ppoint.x - center.x
        normal.y = ppoint.y - center.y
 
        Normalize normal
 
        result.ppoint = ppoint
        result.normal = normal
        result.t = t
        result.hit = -1
 
    END IF
 
    RaycastCircle = -1
 
END FUNCTION
 
 
FUNCTION RaycastAABB (box AS Type_AABB, __Ray2D AS Type_Ray2D, result AS Type_RaycastResult)
 
    'DIM lineStart AS Type_Vector2
    'DIM lineEnd AS Type_Vector2
    DIM unitVector AS Type_Vector2
    DIM min AS Type_Vector2
    DIM max AS Type_Vector2
    DIM tmin AS SINGLE
    DIM tmax AS SINGLE
    DIM t AS SINGLE
    DIM hit AS INTEGER
    DIM ppoint AS Type_Vector2
    DIM normal AS Type_Vector2
 
    RaycastAABB = 0
    RaycastResult.reset result
 
    unitVector.x = __Ray2D.direction.x ' lineEnd.x - lineStart.x
    unitVector.y = __Ray2D.direction.y 'lineEnd.y - lineEnd.y
 
    Normalize unitVector
 
    IF unitVector.x <> 0 THEN unitVector.x = 1 / unitVector.x
    IF unitVector.y <> 0 THEN unitVector.y = 1 / unitVector.y
 
    AABB.getMin box, min
    min.x = min.x - __Ray2D.origin.x 'lineStart.x * unitVector.x
    min.y = min.y - __Ray2D.origin.y 'lineStart.y * unitVector.y
    AABB.getMax box, max
    max.x = max.x - __Ray2D.origin.x 'lineStart.x * unitVector.x
    max.y = max.y - __Ray2D.origin.y 'lineStart.y * unitVector.y
 
    tmin = MathMax(MathMin(min.x, max.x), MathMin(min.y, max.y))
    tmax = MathMin(MathMax(min.x, max.x), MathMax(min.y, max.y))
 
    IF tmax < 0 OR tmin > tmax THEN EXIT FUNCTION
 
    IF tmin < 0 THEN t = tmax ELSE t = tmin
 
    IF t > 0 THEN hit = -1
 
    IF NOT hit THEN EXIT FUNCTION
 
    IF result.ppoint.x = 0 AND result.ppoint.y = 0 THEN
        ppoint.x = __Ray2D.origin.x + __Ray2D.direction.x * t
        ppoint.y = __Ray2D.origin.y + __Ray2D.direction.y * t
 
        normal.x = __Ray2D.origin.x - ppoint.x
        normal.y = __Ray2D.origin.y - ppoint.y
 
        Normalize normal
 
        result.ppoint = ppoint
        result.normal = normal
        result.t = t
        result.hit = -1
 
 
    END IF
 
    RaycastAABB = -1
 
 
END FUNCTION
 
 
FUNCTION RaycastBox2D (box AS Type_Box2D, __Ray2D AS Type_Ray2D, result AS Type_RaycastResult)
 
    DIM xAxis AS Type_Vector2
    DIM yAxis AS Type_Vector2
    DIM zerozero AS Type_Vector2
    DIM p AS Type_Vector2
    DIM f AS Type_Vector2
    DIM e AS Type_Vector2
    DIM size AS Type_Vector2
 
    RaycastBox2D = 0
    RaycastResult.reset result
 
    Box2D.halfSize box, size
 
    xAxis.x = 1
    xAxis.y = 0
    yAxis.x = 0
    yAxis.y = 1
 
    Rotate xAxis, -box.rigidbody.rotation, zerozero
    Rotate yAxis, -box.rigidbody.rotation, zerozero
 
    p.x = box.rigidbody.position.x - __Ray2D.origin.x
    p.y = box.rigidbody.position.y - __Ray2D.origin.y
 
    ' Project the direction of the ray onto each axis of the box
 
    f.x = Dot(xAxis, __Ray2D.direction)
    f.y = Dot(yAxis, __Ray2D.direction)
 
    ' Next, project p onto every axis of the box
 
    e.x = Dot(xAxis, p)
    e.y = Dot(yAxis, p)
 
 
 
 
 
    RaycastBox2D = -1
 
END FUNCTION
 
 
 
 
 
 
 
 
'--------------------------------
'--------- RIGIDBODY2D ----------
'--------------------------------
 
SUB RigidBody2D.getPosition (__rigidbody2D AS Type_Rigidbody2D, position AS Type_Vector2)
 
    position.x = __rigidbody2D.position.x
    position.y = __rigidbody2D.position.y
 
END SUB
 
SUB RigidBody2D.setPosition (__rigidbody2D AS Type_Rigidbody2D, position AS Type_Vector2)
 
    __rigidbody2D.position.x = position.x
    __rigidbody2D.position.y = position.y
 
END SUB
 
FUNCTION RigidBody2D.getRotation (__rigidbody2D AS Type_Rigidbody2D)
 
    RigidBody2D.getRotation = __rigidbody2D.rotation
 
END FUNCTION
 
SUB RigidBody2D.setRotation (__rigidbody2D AS Type_Rigidbody2D, rotation AS SINGLE)
 
    __rigidbody2D.rotation = rotation
 
END SUB
 
 
 
'********************************
'*    PHYSICS2D PRIMATIVES    * <-----------------------------------------------------------------------
'********************************
 
'--------------------------------
'------------ AABB --------------
'--------------------------------
 
SUB AABB (__AABB AS Type_AABB, min AS Type_Vector2, max AS Type_Vector2)
 
    __AABB.size.x = max.x - min.x '                        set size of object
    __AABB.size.y = max.y - min.y
    __AABB.halfSize.x = __AABB.size.x * .5
    __AABB.halfSize.y = __AABB.size.y * .5
 
END SUB
 
 
SUB AABB.halfSize (__AABB AS Type_AABB, halfSize AS Type_Vector2)
 
    halfSize.x = __AABB.size.x * .5
    halfSize.y = __AABB.size.y * .5
 
END SUB
 
 
SUB AABB.getMin (__AABB AS Type_AABB, min AS Type_Vector2)
 
    DIM halfSize AS Type_Vector2
 
    AABB.halfSize __AABB, halfSize
    min.x = __AABB.rigidbody.position.x - halfSize.x
    min.y = __AABB.rigidbody.position.y - halfSize.y
 
END SUB
 
 
SUB AABB.getMax (__AABB AS Type_AABB, max AS Type_Vector2)
 
    DIM halfSize AS Type_Vector2
 
    AABB.halfSize __AABB, halfSize
    max.x = __AABB.rigidbody.position.x + halfSize.x
    max.y = __AABB.rigidbody.position.y + halfSize.y
 
END SUB
 
'--------------------------------
'----------- Box2D --------------
'--------------------------------
 
SUB Box2D (__box2D AS Type_Box2D, min AS Type_Vector2, max AS Type_Vector2)
 
    __box2D.size.x = max.x - min.x '                        set size of object
    __box2D.size.y = max.y - min.y
    __box2D.halfSize.x = __box2D.size.x * .5
    __box2D.halfSize.y = __box2D.size.y * .5
 
END SUB
 
 
SUB Box2D.halfSize (__box2D AS Type_Box2D, halfSize AS Type_Vector2)
 
    halfSize.x = __box2D.size.x * .5
    halfSize.y = __box2D.size.y * .5
 
END SUB
 
 
SUB Box2D.getMin (__box2D AS Type_Box2D, min AS Type_Vector2)
 
    DIM halfSize AS Type_Vector2
 
    Box2D.halfSize __box2D, halfSize
    min.x = __box2D.rigidbody.position.x - halfSize.x
    min.y = __box2D.rigidbody.position.y - halfSize.y
 
END SUB
 
 
SUB Box2D.getMax (__box2D AS Type_Box2D, max AS Type_Vector2)
 
    DIM halfSize AS Type_Vector2
 
    Box2D.halfSize __box2D, halfSize
    max.x = __box2D.rigidbody.position.x + halfSize.x
    max.y = __box2D.rigidbody.position.y + halfSize.y
 
END SUB
 
 
SUB Box2D.getVertices (__box2d AS Type_Box2D, Vertices() AS Type_Vector2)
 
    DIM min AS Type_Vector2
    DIM max AS Type_Vector2
    DIM vert AS Type_Vector2
    DIM vCount AS INTEGER
 
    Box2D.getMin __box2d, min
    Box2D.getMax __box2d, max
 
    Vertices(1).x = min.x
    Vertices(1).y = min.y
    Vertices(2).x = min.x
    Vertices(2).y = max.y
    Vertices(3).x = max.x
    Vertices(3).y = min.y
    Vertices(4).x = max.x
    Vertices(4).y = max.y
 
    IF __box2d.rigidbody.rotation <> 0 THEN
        vCount = 0
        DO
            vert = Vertices(vCount)
            Rotate vert, __box2d.rigidbody.rotation, __box2d.rigidbody.position
        LOOP UNTIL vCount = 4
    END IF
 
END SUB
 
 
'--------------------------------
'----------- Circle -------------
'--------------------------------
 
FUNCTION Circle.getRadius (__circle AS Type_Circle)
 
    Circle.getRadius = __circle.Radius
 
END FUNCTION
 
SUB Circle.setRadius (__circle AS Type_Circle, radius AS SINGLE)
 
    __circle.Radius = radius
 
END SUB
 
 
SUB Circle.getCenter (__circle AS Type_Circle, center AS Type_Vector2)
 
    center = __circle.rigidbody.position
 
END SUB
 
 
'--------------------------------
'--------- Collider2D -----------
'--------------------------------
 
 
 
 
 
'--------------------------------
'------------ Ray2D -------------
'--------------------------------
 
 
SUB Ray2D (__Ray2D AS Type_Ray2D, origin AS Type_Vector2, direction AS Type_Vector2)
 
    __Ray2D.origin = origin
    __Ray2D.direction = direction
    Normalize __Ray2D.direction
 
END SUB
 
SUB Ray2D.getOrigin (__ray2D AS Type_Ray2D, origin AS Type_Vector2)
 
    origin = __ray2D.origin
 
END SUB
 
 
SUB Ray2D.getDirection (__ray2D AS Type_Ray2D, direction AS Type_Vector2)
 
    direction = __ray2D.direction
 
END SUB
 
 
'--------------------------------
'--------- RaycastResult --------
'--------------------------------
 
SUB RaycastResult (__RaycastResult AS Type_RaycastResult)
 
    __RaycastResult.ppoint.x = 0
    __RaycastResult.ppoint.y = 0
    __RaycastResult.normal.x = 0
    __RaycastResult.normal.y = 0
    __RaycastResult.t = -1
    __RaycastResult.hit = 0
 
END SUB
 
SUB RaycastResult.init (__RaycastResult AS Type_RaycastResult, ppoint AS Type_Vector2, normal AS Type_Vector2, t AS SINGLE, hit AS INTEGER)
 
    __RaycastResult.ppoint = ppoint
    __RaycastResult.normal = normal
    __RaycastResult.t = t
    __RaycastResult.hit = hit
 
END SUB
 
SUB RaycastResult.reset (result AS Type_RaycastResult)
 
    IF result.ppoint.x OR result.ppoint.y THEN
        result.ppoint.x = 0
        result.ppoint.y = 0
        result.normal.x = 0
        result.normal.y = 0
        result.t = -1
        result.hit = 0
    END IF
 
END SUB
 
 
 
 
SUB AddVectors (V1 AS Type_Vector2, V2 AS Type_Vector2, Vout AS Type_Vector2)
 
    '          -  -
    ' Formula: V1 + V2 = (V1.x, v1.y) + (V2.x, V2.y) = (V1.x + V2.x, V1.y + V2.y)
 
    ' V1  - input : Vector 1
    ' V2  - input : Vector 2
    ' Vout - output: the new vector
 
    Vout.x = V1.x + V2.x ' x value of vector 2 gets added to x value of vector 1
    Vout.y = V1.y + V2.y ' y value of vector 2 gets added to y value of vector 1
 
END SUB
 
 
SUB SubtractVectors (V1 AS Type_Vector2, V2 AS Type_Vector2, Vout AS Type_Vector2)
 
    '          -  -
    ' Formula: V1 + V2 = (V1.x, v1.y) - (V2.x, V2.y) = (V1.x - V2.x, V1.y - V2.y)
 
    ' V1  - input : Vector 1
    ' V2  - input : Vector 2
    ' Vout - output: the new vector
 
    Vout.x = V1.x - V2.x ' x value of vector 2 gets subtracted from x value of vector 1
    Vout.y = V1.y - V2.y ' y value of vector 2 gets subtracted from y value of vector 1
 
END SUB
 
 
SUB ScalarMultiplyVector (V AS Type_Vector2, Scalar AS SINGLE, Vout AS Type_Vector2)
 
    ' "Scaling the vector"
 
    '          
    ' Formula: V * Scalar = (Vx, Vy) * Scalar = (Vx * Scalar, Vy * Scalar)
 
    ' V      - input : Vector
    ' Scalar - input : scalar multiplication value
    ' Vout  - output: the new vector
 
    Vout.x = V.x * Scalar ' x value of vector gets multiplied by scalar
    Vout.y = V.y * Scalar ' y value of vector gets multiplied by scalar
 
END SUB
 
 
FUNCTION Dot (V1 AS Type_Vector2, V2 AS Type_Vector2)
 
    ' Dot product of vectors
    '          -  -
    ' Formula: V1 ù V2 = (V1.x, V1.y) ù (V2.x, V2.y) = (V1.x * v2.x) + (V1.y * V2.y)
 
    Dot = V1.x * V2.x + V1.y * V2.y ' multiply vector x values then add multiplied vector y values
 
END FUNCTION
 
 
FUNCTION CrossProductVectors (V1 AS Type_Vector2, V2 AS Type_Vector2)
 
    ' Also known as a "Wedge Product" or "Perp Product" for 2D vectors
 
    '          -  -                                ³  x  y  ³
    ' Formula: V1 * V2 = (V1.x, V1.y) * (V2.x, V2.y) = ³V1.x V1.y³ = (V1.x * V2.y) - (V1.y * V2.x)
    '                                                  ³V2.x V2.y³
 
    CrossProductVectors = V1.x * V2.y - V1.y * V2.x
 
END FUNCTION
 
 
FUNCTION VectorLength (V AS Type_Vector2)
 
    '                  _______________________
    ' Formula: º V º = û V.x * V.x + V.y * V.y
 
    VectorLength = _HYPOT(V.x, V.y)
 
END FUNCTION
 
 
SUB Normalize (v AS Type_Vector2)
 
    ' Also known as a unit vector
 
    '                                  _______________________
    ' Formula: V / º V º = (V1.x, V1.y) / û V.x * V.x + V.y * v.y
 
    DIM VecLength AS SINGLE
 
    VecLength = _HYPOT(v.x, v.y) ' length of vector
    v.x = v.x / VecLength '        normalized x length
    v.y = v.y / VecLength '        normalized y length
 
END SUB
 
 
SUB Rotate (vec AS Type_Vector2, angleDeg AS SINGLE, origin AS Type_Vector2)
 
    ' Rotate a point around an origin using linear transformations.
    '
    '                                                       Rotating from (x,y) to (x',y')          |
    ' |                    (x',y')                            : L = R cosé                          | All of this shows how to get to this
    ' |                      ù                              : A = x'                              |                          -----------
    ' |                      /.\                              : B = L cosè = R cosè cosé = x cosé    |                                |
    ' |                    / .è\                            : (note - * opposite angles are equal) |                                |
    ' |                    /  .  \                            : C = R siné                          |                          +----+
    ' |                  /  .  \                          : D = C sinè = R sinè siné = y siné    |                          |
    ' |                  /    .    \                          : Y = R sinè                          |                          |
    ' |                /    .    \C                        : X = r cosè                          |                          
    ' |                /      .      \                                    __                          |                  -----------------
    ' |              /      .      \  L stops            : x' = B - |AB| = X cosé - Y siné      |                          
    ' |              /        .        \  here
    ' |            /        .        \  |                All of this just to show how to get from x to x' using      (X cosé - Y siné)
    ' |            /          .          \  |                Use the same linear transformation methods to get y' using  (X siné + Y cosé)
    ' |          R/          .          \ |
    ' |          /            .¿    D      \                Change the origin point of all rotations to (0,0) by subtracting the current
    ' |        /            .------------âù_--ù (x,y)      origin point from the current vector length. Add it back when rotation is
    ' |        /              .        __--.  .            completed.
    ' |      /              . *  __--    .  .
    ' |      /                . __--        .  .
    ' |    /            L __--            .  .
    ' |    /            __--  .            .  .Y
    ' |  /        __--    * .            .  .
    ' |  /      __--          .            .  .
    ' | / é __--              .            .  .
    ' |/__-- è              â.            .  .
    ' ù-----------------------ù-------------ù---ù------------
    '                        A            B
    ' |------------------- X -------------------|
 
    DIM x AS SINGLE
    DIM y AS SINGLE
    DIM __cos AS SINGLE
    DIM __sin AS SINGLE
    DIM xPrime AS SINGLE
    DIM yPrime AS SINGLE
 
    x = vec.x - origin.x '                move rotation vector origin to 0
    y = vec.y - origin.y
    __cos = COS(_D2R(angleDeg)) '        get cosine and sine of angle
    __sin = SIN(_D2R(angleDeg))
    xPrime = (x * __cos) - (y * __sin) '  calculate rotated location of vector
    yPrime = (x * __sin) + (y * __cos)
    xPrime = xPrime + origin.x '          move back to original origin
    yPrime = yPrime + origin.y
    vec.x = xPrime '                      pass back rotated vector
    vec.y = yPrime
 
END SUB
 
 
FUNCTION compareXYEpsilon (x AS SINGLE, y AS SINGLE, epsilon AS SINGLE)
 
    compareXYEpsilon = 0
    IF ABS(x - y) <= epsilon * MathMax(1, MathMax(ABS(x), ABS(y))) THEN compareXYEpsilon = -1
 
END FUNCTION
 
FUNCTION compareVecEpsilon (vec1 AS Type_Vector2, vec2 AS Type_Vector2, epsilon AS SINGLE)
 
    compareVecEpsilon = 0
    IF compareXYEpsilon(vec1.x, vec2.x, epsilon) AND compareXYEpsilon(vec1.y, vec2.y, epsilon) THEN compareVecEpsilon = -1
 
END FUNCTION
 
FUNCTION compareXY (x AS SINGLE, y AS SINGLE)
 
    compareXY = 0
    IF ABS(x - y) <= MIN_VALUE * MathMax(1, MathMax(ABS(x), ABS(y))) THEN compareXY = -1
 
END FUNCTION
 
FUNCTION compareVec (vec1 AS Type_Vector2, vec2 AS Type_Vector2)
 
    compareVec = 0
    IF compareXY(vec1.x, vec2.x) AND compareXY(vec1.y, vec2.y) THEN compareVec = -1
 
END FUNCTION
 
 
FUNCTION lengthSquared (length AS Type_Vector2)
 
    lengthSquared = length.x * length.x + length.y + length.y
 
END FUNCTION
 
 
 
 
FUNCTION MathMax (num1 AS SINGLE, num2 AS SINGLE)
 
    IF num1 >= num2 THEN MathMax = num1 ELSE MathMax = num2
 
END FUNCTION
 
 
FUNCTION MathMin (num1 AS SINGLE, num2 AS SINGLE)
 
    IF num1 <= num2 THEN MathMin = num1 ELSE MathMin = num2
 
END FUNCTION
 
 
 

Hi,

I have a link here that points to some of my shared projects:

https://www.keepandshare.com/doc/show.ph...at=0&all=y

I have found it does not fit in my signature even if I Bitly it.

My link is at: https://bit.ly/Erikskeepshar

Could some administrator increase the length of the signature??

Thanks,

Erik.

I'm going through this old BASIC book to sanity-check BAM's implementation of BASIC statements and functions.

From the Handbook of BASIC: for the IBM PC, XT, AT, PS/2, and compatibles (chapter starting on page 42), 1988
( https://archive.org/details/handbookofbasicf00schn ), I'm happy to find that the code samples work A-1 in BAM:

ReDim and assign an array within a SUB and pass through the SUB's parameters 
.......
getarray z%()
print ubound(z%), z%(5)
end
SUB getarray( x() as integer)
n%= 25
ReDim as ineger x(0 to n%-1)
for p%= 0 to  n%-1
x%(p%)= p%*p%
next
end sub

This game is generalized to do any number of columns and rows, I think. I have it setup for Standard Board Game at 7 columns and 6 Rows. This has been proven to be a certain winner but I forget, the first or 2nd player.

Don't worry AI aint that good but OK. 

 
Option _Explicit ' Connect 4 NumRows X NumCols 2020_12_16.bas update bplus
DefLng A-Z
Const SQ = 60 '      square or grid cell
Const NumCols = 7 '  number of columns  7 across 6 down is standard for board game
Const NumRows = 6 '  you guessed it
Const NCM1 = NumCols - 1 ' NumCols minus 1
Const NRM1 = NumRows - 1 ' you can guess surely
Const SW = SQ * (NumCols + 2) '  screen width
Const SH = SQ * (NumRows + 3) '  screen height
Const P = 1 '      Player is 1 on grid
Const AI = -1 '    AI is -1 on grid
Const XO = SQ '    x offset for grid
Const YO = 2 * SQ ' y offset for grid
 
ReDim Shared Grid(NCM1, NRM1) ' 0 = empty  P=1 for Player,  AI=-1  for AI so -4 is win for AI..
ReDim Shared DX(7), DY(7) ' Directions
DX(0) = 1: DY(0) = 0 ': DString$(0) = "East"
DX(1) = 1: DY(1) = 1 ': DString$(1) = "South East"
DX(2) = 0: DY(2) = 1 ': DString$(2) = "South"
DX(3) = -1: DY(3) = 1 ': DString$(3) = "South West"
DX(4) = -1: DY(4) = 0 ': DString$(4) = "West"
DX(5) = -1: DY(5) = -1 ': DString$(5) = "North West"
DX(6) = 0: DY(6) = -1 ': DString$(6) = "North"
DX(7) = 1: DY(7) = -1 ' : DString$(7) = "North East"
ReDim Shared Scores(NCM1) ' rating column for AI and displaying them
ReDim Shared AIX, AIY ' last move of AI for highlighting in display
ReDim Shared WinX, WinY, WinD ' display Winning Connect 4
ReDim Shared GameOn, Turn, GoFirst, PlayerLastMoveCol, PlayerLastMoveRow, MoveNum ' game tracking
ReDim Shared Record$(NCM1, NRM1)
 
Screen _NewImage(SW, SH, 32)
_ScreenMove 360, 60
Dim mb, mx, my, row, col, r
_Title "Connect 4: " + _Trim$(Str$(NumCols)) + "x" + _Trim$(Str$(NumRows)) + " with AI"
GameOn = -1: GoFirst = AI: Turn = AI: MoveNum = 0
ShowGrid
While GameOn
    If Turn = P Then
        While _MouseInput: Wend
        mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        If mb Then 'get last place mouse button was down
            _Delay .25 'for mouse release
            row = ((my - YO) / SQ - .5): col = ((mx - XO) / SQ - .5)
            If col >= 0 And col <= NCM1 And row >= 0 And row < 8 Then
                r = GetOpenRow(col)
                If r <> NumRows Then
                    Grid(col, r) = P: Turn = AI: PlayerLastMoveCol = col: PlayerLastMoveRow = r: MoveNum = MoveNum + 1
                End If
            Else
                Beep
            End If
        End If
    Else
        AIMove
        Turn = P: MoveNum = MoveNum + 1
    End If
    ShowGrid
    _PrintString (10, 10), Space$(50)
    _PrintString (10, 10), Str$(AIX) + Str$(AIY)
    _Display
    _Limit 60
Wend
 
Sub AIMove
    ' What this sub does in English:
    ' This sub assigns the value to playing each column, then plays the best value with following caveats:
    ' + If it finds a winning move, it will play that immediately.
    ' + If it finds a spoiler move, it will play that if no winning move was found.
    ' + It will poisen the column's scoring, if opponent can play a winning move if AI plays this column,
    '  but it might be the only legal move left.  We will have to play it if no better score was found.
 
    Dim c, r, d, cntA, cntP, bestScore, startR, startC, iStep, test, goodF, i
    Dim openRow(NCM1) ' find open rows once
    ReDim Scores(NCM1) ' evaluate each column's potential
    AIX = -1: AIY = -1 ' set these when AI makes move, they are signal to display procedure AI's move.
    For c = 0 To NCM1
        openRow(c) = GetOpenRow(c)
        r = openRow(c)
        If r <> NumRows Then
            For d = 0 To 3 ' 4 directions to build connect 4's that use cell c, r
                startC = c + -3 * DX(d): startR = r + -3 * DY(d)
                For i = 0 To 3 ' here we backup from the potential connect 4 in opposite build direction of c, r
                    cntA = 0: cntP = 0: goodF = -1 ' reset counts and flag for good connect 4
                    'from this start position run 4 steps forward to count all connects involving cell c, r
                    For iStep = 0 To 3 ' process a potential connect 4
                        test = GR(startC + i * DX(d) + iStep * DX(d), startR + i * DY(d) + iStep * DY(d))
                        If test = NumRows Then goodF = 0: Exit For 'cant get connect4 from here
                        If test = AI Then cntA = cntA + 1
                        If test = P Then cntP = cntP + 1
                    Next iStep
                    If goodF Then 'evaluate the Legal Connect4 we could build with c, r
                        If cntA = 3 Then ' we are done!  winner!
                            AIX = c: AIY = r ' <<< this is the needed 4th cell to win tell ShowGrid last cell
                            Grid(c, r) = AI '  <<< this is the needed 4th cell to win, add to grid this is AI move
                            Scores(c) = Scores(c) + 1000
                            Exit Sub
                        ElseIf cntP = 3 Then 'next best move spoiler!
                            AIX = c: AIY = r 'set the move but don't exit there might be a winner
                            Scores(c) = Scores(c) + 900
                        ElseIf cntA = 0 And cntP = 2 Then
                            Scores(c) = Scores(c) + 8
                        ElseIf cntA = 2 And cntP = 0 Then ' very good offense or defense
                            Scores(c) = Scores(c) + 4 'play this to connect 3 or prevent player from Connect 3
                        ElseIf cntA = 0 And cntP = 1 Then
                            Scores(c) = Scores(c) + 4
                        ElseIf (cntA = 1 And cntP = 0) Then 'good offense or defense
                            Scores(c) = Scores(c) + 2 ' play this to connect 2 or prevent player from Connect 2
                        ElseIf (cntA = 0 And cntP = 0) Then ' OK it's not a wasted move as it has potential for connect4
                            Scores(c) = Scores(c) + 1 ' this is good move because this can still be a Connect 4
                        End If
                    End If ' in the board
                Next i
            Next d
            If Stupid(c, r) Then Scores(c) = -1000 + Scores(c) ' poison because if played the human can win
        End If
    Next
    If AIX <> -1 Then ' we found a spoiler so move there since we haven't found a winner
        Grid(AIX, AIY) = AI ' make move on grid and done!
        Exit Sub
    Else
        If GetOpenRow(PlayerLastMoveCol) < NumRows Then 'all things being equal play on top of player's last move
            bestScore = Scores(PlayerLastMoveCol): AIY = PlayerLastMoveRow - 1: AIX = PlayerLastMoveCol
        Else
            bestScore = -1000 ' a negative score indicates that the player can beat AI with their next move
        End If
        For c = 0 To NCM1
            r = openRow(c)
            If r <> NumRows Then
                If Scores(c) > bestScore Then bestScore = Scores(c): AIY = r: AIX = c
            End If
        Next
        If AIX <> -1 Then
            Grid(AIX, AIY) = AI ' make first best score move we found
        Else 'We have trouble!  Oh but it could be there are no moves!!!
            ' checkWin is run after every move by AI or Player if there were no legal moves left it should have caught that.
            ' Just in case it didn't here is an error stop!
            Beep: Locate 4, 2: Print "AI has failed to find a proper move, press any to end..."
            Sleep ' <<< pause until user presses a key
            End
        End If
    End If
End Sub
 
Function GetOpenRow (forCol)
    Dim i
    GetOpenRow = NumRows 'assume none open
    If forCol < 0 Or forCol > NCM1 Then Exit Function
    For i = NRM1 To 0 Step -1
        If Grid(forCol, i) = 0 Then GetOpenRow = i: Exit Function
    Next
End Function
 
Function Stupid (c, r)
    Dim pr
    Grid(c, r) = AI
    pr = GetOpenRow(c)
    If pr <> NumRows Then
        Grid(c, pr) = P
        If CheckWin = 4 Then Stupid = -1
        Grid(c, pr) = 0
    End If
    Grid(c, r) = 0
End Function
 
Function GR (c, r) ' if c, r are out of bounds returns N else returns grid(c, r)
    ' need to check the grid(c, r) but only if c, r is on the board
    If c < 0 Or c > NCM1 Or r < 0 Or r > NRM1 Then GR = NumRows Else GR = Grid(c, r)
End Function
 
Sub ShowGrid
    Static lastMoveNum
    Dim i, r, c, check, s$, k$
    If MoveNum <> lastMoveNum Then ' file newest move
        If MoveNum = 1 Then ReDim Record$(NCM1, NRM1)
        If Turn = -1 Then
            Record$(PlayerLastMoveCol, PlayerLastMoveRow) = _Trim$(Str$(MoveNum)) + " " + "P"
        Else
            Record$(AIX, AIY) = _Trim$(Str$(MoveNum)) + " " + "A"
        End If
        lastMoveNum = MoveNum
    End If
    Cls
    Line (XO, YO)-Step(NumCols * SQ, NumRows * SQ), &HFF004400, BF
    For i = 0 To NumCols 'grid
        Line (SQ * i + XO, YO)-Step(0, NumRows * SQ), &HFFFFFFFF
    Next
    For i = 0 To NumRows
        Line (XO, SQ * i + YO)-Step(NumCols * SQ, 0), &HFFFFFFFF
    Next
    For r = NRM1 To 0 Step -1 ''in grid rows are reversed 0 is top row
        For c = 0 To NCM1
            If Grid(c, r) = P Then
                Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFFFF2200, BF
            ElseIf Grid(c, r) = AI Then
                If c = AIX And r = AIY Then 'highlite last AI move
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF680044, BF
                Else
                    Line (c * SQ + XO + 3, r * SQ + YO + 3)-Step(SQ - 6, SQ - 6), &HFF390027, BF
                End If
            End If
            s$ = _Trim$(Str$(Scores(c)))
            _PrintString (XO + c * SQ + (60 - Len(s$) * 8) / 2, YO + SQ * NumRows + 22), s$
        Next
    Next
    _Display
    check = CheckWin
    If check Then 'report end of round ad see if want to play again
        If check = 4 Or check = -4 Then
            For i = 0 To 3
                Line ((WinX + i * DX(WinD)) * SQ + XO + 5, (WinY + i * DY(WinD)) * SQ + YO + 5)-Step(SQ - 10, SQ - 10), &HFFFFFF00, B
            Next
        End If
        For r = 0 To NRM1
            For c = 0 To NCM1
                If Record$(c, r) <> "" Then
                    s$ = Mid$(Record$(c, r), 1, InStr(Record$(c, r), " ") - 1)
                    If Right$(Record$(c, r), 1) = "A" Then Color , &HFF390027 Else Color , &HFFFF2200
                    _PrintString (SQ * c + XO + (SQ - Len(s$) * 8) / 2, SQ * r + YO + 22), s$
                End If
            Next
            Color , &HFF000000
        Next
        If check = -4 Then
            s$ = " AI is Winner!"
        ElseIf check = 4 Then
            s$ = " Human is Winner!"
        ElseIf check = NumRows Then
            s$ = " Board is full, no winner." ' keep Turn the same
        End If
        Locate 2, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        s$ = " Play again? press spacebar, any other to quit... "
        Locate 4, ((SW - Len(s$) * 8) / 2) / 8: Print s$
        _Display
        While Len(k$) = 0
            k$ = InKey$
            _Limit 200
        Wend
        If k$ = " " Then
            ReDim Grid(NCM1, NRM1), Scores(NCM1)
            If GoFirst = P Then GoFirst = AI Else GoFirst = P
            Turn = GoFirst: MoveNum = 0
        Else
            GameOn = 0
        End If
    End If
End Sub
 
Function CheckWin ' return WinX, WinY, WinD along with +/- 4, returns NumRows if grid full, 0 if no win and grid not full
    Dim gridFull, r, c, s, i
    gridFull = NumRows
    For r = NRM1 To 0 Step -1 'bottom to top
        For c = 0 To NCM1
            If Grid(c, r) Then ' check if c starts a row
                If c < NCM1 - 2 Then
                    s = 0
                    For i = 0 To 3 ' east
                        s = s + Grid(c + i, r)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 0: CheckWin = s: Exit Function
                End If
                If r > 2 Then ' check if c starts a col
                    s = 0
                    For i = 0 To 3 ' north
                        s = s + Grid(c, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 6: CheckWin = s: Exit Function
                End If
                If r > 2 And c < NCM1 - 2 Then 'check if c starts diagonal up to right
                    s = 0
                    For i = 0 To 3 ' north  east
                        s = s + Grid(c + i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 7: CheckWin = s: Exit Function
                End If
                If r > 2 And c > 2 Then 'check if c starts a diagonal up to left
                    s = 0
                    For i = 0 To 3 ' north west
                        s = s + Grid(c - i, r - i)
                    Next
                    If s = 4 Or s = -4 Then WinX = c: WinY = r: WinD = 5: CheckWin = s: Exit Function
                End If
            Else
                gridFull = 0 ' at least one enpty cell left
            End If 'grid is something
        Next
    Next
    CheckWin = gridFull
End Function