Valentine's Beating Heart

[SMcNeill]

Inspired by @bplus and his Valentine Heart, I had to make one as well.  

My heart beats for you guys!

Code: (Select All)

Screen _NewImage(800, 600, 32)

_Title "Valentine Heart — QB64PE"



Const TWO_PI = 6.283185307

Dim Shared Particles(1 To 300) As Particle



Type Particle

    x As Single

    y As Single

    dx As Single

    dy As Single

    life As Single

    col As _Unsigned Long

End Type





'-----------------------------------------

' Main loop

'-----------------------------------------

Dim t As Single, beat As Integer

Do

    Cls , _RGB32(10, 10, 20)



    t = t + .05

    Dim scale As Single

    scale = 8 + Sin(t) * 1.5



    ' Glow layers

    DrawHeart 400, 300, scale * 1.25, _RGBA32(255, 0, 80, 40)

    DrawHeart 400, 300, scale * 1.15, _RGBA32(255, 0, 120, 60)

    DrawHeart 400, 300, scale, _RGB32(255, 0, 180)



    ' Beat detection

    If Sin(t) > .95 And beat = 0 Then

        Burst 400, 300

        beat = 1

    End If

    If Sin(t) < .5 Then beat = 0



    UpdateParticles



    _Display

    _Limit 60

Loop



'-----------------------------------------

' Draw a parametric heart at scale S

'-----------------------------------------

Sub DrawHeart (cx As Single, cy As Single, s As Single, col As _Unsigned Long)

    Dim t As Single, x As Single, y As Single

    For t = 0 To TWO_PI Step .01

        x = 16 * Sin(t) ^ 3

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

        PSet (cx + x * s, cy + y * s), col

    Next

End Sub



'-----------------------------------------

' Spawn particle burst

'-----------------------------------------

Sub Burst (cx As Single, cy As Single)

    Dim i As Integer

    For i = 1 To 300

        Particles(i).x = cx

        Particles(i).y = cy

        Dim a As Single

        a = Rnd * TWO_PI

        Particles(i).dx = Cos(a) * (Rnd * 4)

        Particles(i).dy = Sin(a) * (Rnd * 4)

        Particles(i).life = 1

        Particles(i).col = _RGB32(255, 50 + Rnd * 150, 200)

    Next

End Sub



'-----------------------------------------

' Update and draw particles

'-----------------------------------------

Sub UpdateParticles

    Dim i As Integer

    For i = 1 To 300

        If Particles(i).life > 0 Then

            Particles(i).x = Particles(i).x + Particles(i).dx

            Particles(i).y = Particles(i).y + Particles(i).dy

            Particles(i).life = Particles(i).life - .01

            Dim a As Integer

            a = 255 * Particles(i).life

            Line (Particles(i).x, Particles(i).y)-Step(2, 2), _RGBA32(255, 100, 200, a), BF

        End If

    Next

End Sub