Happy Valentine's Day!

[bplus]

Cardiac Conic Shape 1B FatLine

Code: (Select All)

_Title "Cardiac Conic Shape 1B Fat Line" 'b+ 2026-02-15

' inspired by CharlieJV BAM version of Richard Russle

' also inspired by today being Valentine's Day



Const xmax = 800, ymax = 600

Screen _NewImage(xmax, ymax, 32)

_ScreenMove 150, 50

Dim Shared blades: blades = 48

Dim Shared hX(1 To blades), hY(1 To blades)

Dim Shared OCX(1 To blades), OCY(1 To blades)

Dim pal~&(1 To blades)

For i = 1 To blades

    pal~&(i) = _RGB32(255, (blades - i) / blades * 64 + 64, i / blades * 255)

Next

i = 0

' BIG outer circle map points from bottom of screen like heart is mapped

CX = xmax / 2

CY = ymax / 2

BigCircRadius = ymax / 2 - 10

'map the outer circle OCX, OCY points  once and for all time!

For a = _Pi(.5) To _Pi(2.5) - .001 Step _Pi(2 / blades)

    i = i + 1

    OCX(i) = CX + BigCircRadius * Cos(a)

    OCY(i) = CY + BigCircRadius * Sin(a)

Next



' heart

hCircRadius = .15 * BigCircRadius

a = -_Pi

While _KeyDown(27) = 0

    Cls

    ' recalc heart points from new position

    hOrigX = CX + hCircRadius * Cos(a)

    hOrigY = CY + hCircRadius * Sin(a)

    MapHeart hOrigX, hOrigY, 12

    ' draw line from center to heart point

    Color pal~&(1)

    For i = 1 To blades



        FatLine CX, CY, hX(i), hY(i), 5

        ' and line from heart point to outer circle

        FatLine hX(i), hY(i), OCX(i), OCY(i), 5

        If (i Mod 2 = 0) Then

            Color pal~&(i - 1)

            FatLine hX(i), hY(i), hX(i - 1), hY(i - 1), 5

            FatLine OCX(i), OCY(i), OCX(i - 1), OCY(i - 1), 5

        End If

    Next

    _Display

    _Limit 30

    a = a + _Pi(1 / 45)

    If a > _Pi Then a = -_Pi

Wend





'Reference and thanks to:

' http://mathworld.wolfram.com/HeartCurve.html

' find the 6th heart curve equations #7, 8

Function xCard (t)

    xCard = 16 * Sin(t) ^ 3

End Function



Function yCard (t)

    yCard = 13 * Cos(t) - 5 * Cos(2 * t) - 2 * Cos(3 * t) - Cos(4 * t)

End Function



Sub MapHeart (cx, cy, magnify)

    ' dim shared hX, hY 1 to blades

    For a = -_Pi To _Pi - .001 Step _Pi(2 / blades)

        i = i + 1

        hX(i) = cx + magnify * xCard(a)

        hY(i) = cy - magnify * yCard(a)

    Next

End Sub



' 2023-09-27 000Test/Graphics/FatLine test and demo

Sub FatLine (x, y, x2, y2, wide As Integer)

    ' 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

                i = i + 1

            Wend

        End If

    Else

        If r = 0 Then ' bullet proof

            PSet (x, y), c

        Else

            FCirc x, y, r

        End If

    End If

End Sub



Sub FCirc (CX As Long, CY As Long, R As 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): Exit Sub

    Line (CX - X, CY)-(CX + X, CY), , 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), , BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF

    Wend

End Sub

   

[Kernelpanic]

@bplus - the red heart looks really good! The arrangement makes it look three-dimensional.

Happy Valentine's Day! 

[bplus]

Thanks KP!

OK I did try more blades with red heart. 

Cardiac Conic Shapes 2B More Blades,
its the same code only 96 blades instead of 48 ie double the amount.
You get so many blades like 200 and the red starts to bleed out around the top of the heart. 100 is good limit.