I Finally did it. A.I.!!!

[bplus]

Code: (Select All)

_Title "AIs" 'bplus 2025-04-28
Screen _NewImage(800, 600, 32)
cx1 = 267: cx2 = 534
r = 89
stopIt = 0
_Display
Do
    Cls , &HFFFF9999
    FC3 cx1, 300, r, &HFFFFFFFF
    FC3 cx2, 300, r, &HFFFFFFFF
    FC3 cx1, 300, r - 30, &HFF0000FF
    FC3 cx2, 300, r - 30, &HFF0000FFF

    Text cx1 - 28, 300 - 60, 128, &HFF000000, "A"
    Text cx2 - 28, 300 - 60, 128, &HFF000000, "A"
    For yr = r To stopIt Step -.5
        Ellipse cx1, 300, r, yr, &HFFFF7777
        Ellipse cx2, 300, r, yr, &HFFFF7777
    Next
    _Display
    stopIt = stopIt + 1
    If stopIt = r - 30 Then
        _Delay 2
        Cls , &HFFFF9999
        FC3 cx1, 300, r, &HFFFFFFFF
        FC3 cx2, 300, r, &HFFFFFFFF
        FC3 cx1, 300, r - 30, &HFF0000FF
        FC3 cx2, 300, r - 30, &HFF0000FFF

        Text cx1 - 28, 300 - 60, 128, &HFF000000, "A"
        Text cx2 - 28, 300 - 60, 128, &HFF000000, "A"
        For yr = r To 0 Step -.25
            Ellipse cx1, 300, r, yr, &HFFFF7777
            Ellipse cx2, 300, r, yr, &HFFFF7777
        Next
        _Display
        stopIt = 0
    End If
Loop Until _KeyDown(27)

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&)
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

Sub Ellipse (CX, CY, xRadius As Long, yRadius As Long, C As _Unsigned Long)
    '  CX = center x coordinate
    '  CY = center y coordinate
    '  xRadius = x axis radius
    '  yRadius = y axis radius
    '   C = fill color
    Dim a, x, y, sq, delta, lastDelta
    If xRadius = 0 And yRadius = 0 Then Exit Sub
    If xRadius = 0 Then
        Line (CX, CY + yRadius)-(CX, CY - yRadius), C
    ElseIf yRadius = 0 Then
        Line (CX + xRadius, CY)-(CX - xRadius, CY), C
    Else
        If xRadius >= yRadius Then
            a = yRadius / xRadius: sq = xRadius * xRadius
            For x = 0 To xRadius
                If x = 0 Then
                    lastDelta = Sqr(sq - x * x) * a
                Else
                    delta = Sqr(sq - x * x) * a
                    Line (CX + (x - 1), CY + lastDelta)-(CX + x, CY + delta), C
                    Line (CX + (x - 1), CY - lastDelta)-(CX + x, CY - delta), C
                    Line (CX - (x - 1), CY + lastDelta)-(CX - x, CY + delta), C
                    Line (CX - (x - 1), CY - lastDelta)-(CX - x, CY - delta), C
                    lastDelta = delta
                End If
            Next
        Else
            a = xRadius / yRadius: sq = yRadius * yRadius
            For y = 0 To yRadius
                If y = 0 Then
                    lastDelta = Sqr(sq - y * y) * a
                Else
                    delta = Sqr(sq - y * y) * a
                    Line (CX + lastDelta, CY + (y - 1))-(CX + delta, CY + y), C
                    Line (CX - lastDelta, CY + (y - 1))-(CX - delta, CY + y), C
                    Line (CX + lastDelta, CY - (y - 1))-(CX + delta, CY - y), C
                    Line (CX - lastDelta, CY - (y - 1))-(CX - delta, CY - y), C
                    lastDelta = delta
                End If
            Next
        End If
    End If
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, bg As _Unsigned Long, cur&, i&
    fg = _DefaultColor: bg = _BackgroundColor: cur& = _Dest
    i& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest i&: Color K, _RGBA32(0, 0, 0, 0): _PrintString (0, 0), txt$
    _PutImage (x, y)-Step(Len(txt$) * textHeight / 2, textHeight), i&, cur&
    Color fg, bg: _FreeImage i&: _Dest cur&
End Sub