Drawing Tools Subs or Functions with Demo

[bplus]

FatPALline

This is a way to draw lines from a Point x, y at an angle for a given length, fatness and color.

I used it to boldly present the Maze lines in Flipping Hex Maze code. Also included is FatLine which needs the Circle Fill sub FCirc. Here is the demo:

Code: (Select All)

_Title "FatPALline test" 'b+ 2024-11-01

Screen _NewImage(801, 590, 32): _ScreenMove 240, 60
Type BoardType
    As Single x, y, flipped, flipping, a
End Type
Dim Shared ubX, ubY
ubX = 18: ubY = 16
Dim Shared b(ubX, ubY) As BoardType
Dim Shared cellR, xspacing!, yspacing!
cellR = 25
xspacing! = 2 * cellR * Cos(_D2R(30)): yspacing! = cellR * (1 + Sin(_D2R(30)))
Dim xoffset!
Color &HFF000000, &HFFAAAAFF
Do
    m = (m + 1) Mod ubX
    Cls
    For y = 0 To ubY
        If y Mod 2 = 0 Then xoffset! = .5 * xspacing! Else xoffset! = 0
        For x = 0 To ubX
            b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing! - 20
            b(x, y).y = y * yspacing! + .5 * yspacing! - 20
            If Rnd < .002 Then b(x, y).flipping = 1
            showCell x, y
        Next
    Next
    _Display
    _Limit 60
Loop

Sub showCell (c, r)
    If b(c, r).flipping Then b(c, r).a = b(c, r).a + _Pi(1 / 90)
    If b(c, r).a >= _Pi(1 / 3) Then
        b(c, r).flipping = 0: b(c, r).a = 0
        If b(c, r).flipped Then b(c, r).flipped = 0 Else b(c, r).flipped = 1
    End If
    If b(c, r).flipped Then
        For a = _Pi(1 / 6) To _Pi(2) Step _Pi(2 / 3)
            FatPALline b(c, r).x, b(c, r).y, a + b(c, r).a, cellR, 4, &HFF000000
        Next
    Else
        For a = _Pi(.5) To _Pi(2) Step _Pi(2 / 3)
            FatPALline b(c, r).x, b(c, r).y, a + b(c, r).a, cellR, 4, &HFF000000
        Next
    End If
End Sub

'    ++++++++++++++++++ Featured Subroutines for Drawing +++++++++++++++++++++++

' needs Fcirc because needs FatLine
Sub FatPALline (BaseX, BaseY, RAngle, Lngth, Fat, K As _Unsigned Long) ' point angle length line
    Dim x2, y2
    x2 = BaseX + Lngth * Cos(RAngle)
    y2 = BaseY + Lngth * Sin(RAngle)
    FatLine BaseX, BaseY, x2, y2, Fat, K
End Sub

' 2023-09-27 000Test/Graphics/FatLine test and demo
Sub FatLine (x, y, x2, y2, wide As Integer, c As _Unsigned Long)
    ' this sub needs fcirc
    Dim dx, dy, distance, r
    dx = x2 - x
    dy = y2 - y
    distance = _Hypot(dx, dy)
    r = Int(wide / 2)
    If distance Then '  bullet proof
        dx = dx / distance
        dy = dy / distance
        If r = 0 Then
            Line (x, y)-(x2, y2), c
        Else
            Dim i As Long
            While i <= distance
                FCirc x + i * dx, y + i * dy, r, c
                i = i + 1
            Wend
        End If
    Else
        If r = 0 Then ' bullet proof
            PSet (x, y), c
        Else
            FCirc x, y, r, c
        End If
    End If
End Sub

Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Maze code Before FatPALline:
   

and after: