Happy Valentine's Day!

[bplus]

Here is my mod that fills colors inside the lines

Code: (Select All)

_Title "Cardiac Conic Shape 2" 'b+ 2026-02-14

' 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)

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

Color &HFFFF0000

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

    For i = 1 To blades

        Line (CX, CY)-(hX(i), hY(i))

        ' and line from heart point to outer circle

        Line (hX(i), hY(i))-(OCX(i), OCY(i))

        If (i Mod 2 = 0) Then

            Line (hX(i), hY(i))-(hX(i - 1), hY(i - 1))

            Line (OCX(i), OCY(i))-(OCX(i - 1), OCY(i - 1))

        End If

    Next

    i = 0

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

        i = i + 1

        If i Mod 2 = 0 Then

            px = CX + (BigCircRadius - 3) * Cos(a1 - _Pi(2 / (2 * blades)))

            py = CY + (BigCircRadius - 3) * Sin(a1 - _Pi(2 / (2 * blades)))

            'Circle (px, py), 2, &HFFFF0000

            Paint (px, py), &HFFFFFFFF, &HFFFF0000

            ftri CX, CY, hX(i), hY(i), hX(i - 1), hY(i - 1), &HFFFF0000

        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



Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    Dim D As Long

    Static a&

    D = _Dest

    If a& = 0 Then a& = _NewImage(1, 1, 32)

    _Dest a&

    _DontBlend a& '  '<<<< new 2019-12-16 fix

    PSet (0, 0), K

    _Blend a& '<<<< new 2019-12-16 fix

    _Dest D

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

End Sub