Happy Valentine's Day!

[bplus]

Inspired by Charlies BAM take on RR of BBC Conic Shape:
https://qb64phoenix.com/forum/showthread...3#pid39873

Code: (Select All)

_Title "Cardiac Conic Shape" '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)

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

    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

            Color pal~&(i - 1)

            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

    _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