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

Any Summer Banner contest on the run already? Only 2 weeks left.   (YES!   Yes there is!  See my post below by The Amazing Steve(tm)!!)

Would like to see Ocean, Beaches, Palm trees and lots of cool Drinks and Girls wearing skimpy Bikinies

So all QB64 artists, ready - set - go.

You can now use [ q b = e x p o r t ] {pasted export from QB64 IDE} [ / q b ] to embed QB64 exported source code.

This method of sharing includes hyperlinks to the wiki for keywords, etc.

I could not get the line numbers to be added at this time. I have successfully added them, but I cannot get them to not be selected with the code in the Code (select all) function above the embed.

Better than nothing for now.

@RhoSigma made this feature in QB64 and it's awesome!

To be clear, let's review how we can embed QB64 code in this forum:

1. Using [ q b ] - This will take any QB64 source and share it with highlighting and line numbers.
   
2. Using [ q b = e x p o r t ] - This explicitly takes QB64 source that is Exported to embed bbcode in the code itself and the keywords are linked to the wiki!
   
3. Using [ q b j s ] - This allows you to share QB64 source and immediately edit it and run it in an in-thread QBJS IDE embed.
   

Hello all, 

 Sayu is a 2 player  abstract strategy tile placing game. 

Donald

   




  Sayu Description.pdf (Size: 41.36 KB / Downloads: 34)

I am back playing with comm ports again.  Way back in the old days it was possible to talk using inp and outp  to twiddle RTS n DTR.  As well as read DTR n CLS.  Nowadays it's not possible to get to those signals.  It's all because of VCSP (virtual comm serial port).  It's possible to have 255 serial ports in windows.  In the original PC comm ports maxed at 4 physical ports.  Now the VCSP port could be a alternative to a 8250 comm chip.  Or even not a comm port but a Ethernet serial interface device.

I am trying to test the above control signals, to identify bad ports (combination of loop back and such).  I need a way to set and read the control signals.

I suck at DLL interfacing with QB64.  Which is where I assume be VCSP signals need to be accessed.

Any help here maybe ?