'Draw heart.bas FreeBASIC [B+=MGA] 2107-02-13
' orig from SmallBASIC version 2017-02-13
Const As Double PI = ACos(-1)
'Set screen size here
dim as integer xmax = 800, ymax = 720, depth = 32
screenres xmax, ymax, depth, 2
WindowTitle "Draw Heart - Press esc to exit"
Sub drawHeart(x As Double, y As double, angle As double, height As Double)
'below 50 not so good over 300 outgrows height box
'height x height is approximately the square the heart fits inside
'x, y is bottom point of upright heart
Dim As Double k, r
k = 3*pi/2 'when angle = 0 then you have standard upright heart
For r = 0 to height/6
Circle(x + 5*r*cos(k + angle - pi/11), y + 5*r*sin(k + angle - pi/11)), r^1.2, , , , , F
Circle(x + 5*r*cos(k + angle + pi/11), y + 5*r*sin(k + angle + pi/11)), r^1.2, , , , , F
Next
'fix bottom point
for r = -pi/9 to pi/9 step .02
Line(x, y)-(x + .8*height*cos(k + angle + r), y + .8*height*sin(k + angle + r))
Next
End Sub
Dim As Integer page, notpage
Dim As Integer a = 127
Dim As Double hmax = 590/760*ymax
Dim As Double red, green, blue, h
Dim As UInteger cc
Dim ky as String
notpage = 1
While ky <> Chr(27)
If page = 0 THEN page = 1 ELSE page = 0 'These two lines flip the page and the
If notpage = 1 THEN notpage = 0 ELSE notpage = 1 'backpage
SCREENSET page, notpage 'This flips the page
red = rnd^2 : green = rnd^2 : blue = rnd^2
for h = hmax to 15 step -1
Color rgb(a+a*sin(red*h*.1), a+a*sin(green*h*.1), a+a*sin(blue*h*.1) )
drawHeart(xmax/2, ymax - 20, 0, h)
Next
ky = InKey
Wend
