Proggies

[bplus]

Code: (Select All)

_Title "Infinite Heart" ' b+ 2022-02-14 trans from 2015
Const xmax = 698, ymax = 698, pi = 3.1415926
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 20

Color , &HFFFFFFFF: Cls
x = (xmax - 600) / 2 - 1: y = (ymax - 1.15 * 600) / 2: wide = 600
drawdblheart x, y, wide
drawdblheart x + wide / 2 - wide / 32, y + 1.15 * wide / 4 + wide / 8, wide / 16
Color _RGB32(255, 0, 0)
PSet (x + wide / 2, y + 1.15 * wide / 4 + wide / 8 + wide / 32 - 3)
PSet (x + wide / 2 - 1, y + 1.15 * wide / 4 + wide / 8 + wide / 32 - 3)
PSet (x + wide / 2 - 2, y + 1.15 * wide / 4 + wide / 8 + wide / 32 - 3)
PSet (x + wide / 2 - 1, y + 1.15 * wide / 4 + wide / 8 + wide / 32 - 2)
Sleep

Sub drawblade (x, y, wide)
    scale = wide / 200
    sz = wide / 4
    yax = x + wide / 2
    lasty = y
    steps = 230 * scale - sz
    For da = 0 To 180 Step 180 / steps
        Line (yax - (1 - Cos(_D2R(da))) * sz, lasty)-(yax + (1 - Cos(_D2R(da))) * sz, lasty)
        lasty = lasty + 1
    Next
    fcirc yax - sz, y + 230 * scale - sz, sz, _RGB32(255, 255, 255)
    fcirc yax + sz, y + 230 * scale - sz, sz, _RGB32(255, 255, 255)
End Sub

Sub drawdblheart (x, y, wide)
    'for this heart height=wide*1.15
    scale = wide / 200
    sz = wide / 4
    yax = x + wide / 2
    lasty = y + 230 * scale
    steps = 230 * scale - sz
    For da = 0 To 180 Step 180 / steps
        Line (yax - (1 - Cos(_D2R(da))) * sz, lasty)-(yax + (1 - Cos(_D2R(da))) * sz, lasty), _RGB32(255, 0, 0)
        lasty = lasty - 1
    Next
    fcirc yax - sz, y + sz, sz, _RGB32(255, 0, 0)
    fcirc yax + sz, y + sz, sz, _RGB32(255, 0, 0)
    drawblade x + sz + sz / 2, y + sz, wide / 4
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

Imagined very early on and drawn in SnallBASIC first I think.