Draw Olympic Hearts
#1
Code:
' Draw heart experiment.bas SmallBASIC 0.12.11 (B+=MGA) 2018-02-26
wide = 24
w2 = wide/2

color 0, 15: cls

for dr = wide to 0 step -1
 if dr >= w2 then
   color rgb( (wide-dr) / w2 * 100, (wide-dr) / w2 * 100, (wide-dr) / w2 * 100)
 else
   color rgb(100 - (wide - dr - w2)/w2* 100,100 - (wide - dr - w2)/w2* 100,100 - (wide - dr - w2)/w2* 100)
 fi
 DrawHeart xmax/2, ymax/2-50, 100 + dr
 if dr >= w2 then
   color rgb( (wide-dr) / w2 * 50, (wide-dr) / w2 * 50, (wide-dr) / w2 * 255)
 else
   color rgb(100 - (wide - dr - w2)/w2* 100, 100- (wide - dr - w2)/w2* 100, 255 - (wide - dr - w2)/w2* 255)
 fi
 DrawHeart xmax/2-300, ymax/2-50, 100 + dr
 if dr >= w2 then
   color rgb( (wide-dr) / w2 * 255, 0, 0)
 else
   color rgb(255 - (wide - dr - w2)/w2* 255, 0, 0)
 fi
 DrawHeart xmax/2+300, ymax/2-50, 100 + dr
next
color 15
DrawHeart xmax/2, ymax/2-50, 100
DrawHeart xmax/2-300, ymax/2-50, 100
DrawHeart xmax/2+300, ymax/2-50, 100
for dr = wide to 0 step -1
 if dr >= w2 then
   color rgb( (wide-dr) / w2 * 255, (wide-dr) / w2 * 255, 0)
 else
   color rgb(255 - (wide - dr - w2)/w2* 255,255 - (wide - dr - w2)/w2* 255, 0)
 fi
 DrawHeart xmax/2-150, ymax/2+150, 100 + dr
 if dr >= w2 then
   color rgb( 0, (wide-dr) / w2 * 155, (wide-dr) / w2 * 100)
 else
   color rgb(0, 155 - (wide - dr - w2)/w2* 155, 100 - (wide - dr - w2)/w2* 100)
 fi
 DrawHeart xmax/2+150, ymax/2+150, 100 + dr
next
color 15
DrawHeart xmax/2-150, ymax/2+150, 100
DrawHeart xmax/2+150, ymax/2+150, 100

sub DrawHeart(x, y, r)
 'x, y designates center of square turned 45 degrees
 '2*r at widest at x-r, y to x+r, y
 '2 cicles should fit in middle of 2 top sides of square
 ' y = -x*r + r
 for dx = 0 to r
   gy = -dx + r
   line x + dx, y + gy, x + dx, y - gy
   line x - dx, y + gy, x - dx, y - gy
 next
 '2 circles
 circle x - .5*r, y - .5*r, .5*r * 2^.5 filled
 circle x + .5*r, y - .5*r, .5*r * 2^.5 filled
end

I didn't get the hearts to interlock but still not bad for a fun exercise.


Attached Files Thumbnail(s)

B += x
Reply