Olympic Hearts in JB
#1
Made some mods to improve this compared to first SmallBASIC version posted.
Code:
'Draw Heart revisit.bas for JB v2.0b1, 2018-02-26 B+=MGA

global H$, XMAX, YMAX, PI, DEG, RAD, goON
H$ = "gr"
XMAX = 1200 '<======================================== actual drawing space needed
YMAX = 720 '<======================================== actual drawing space needed
PI = acs(-1)
DEG = 180 / PI
RAD = PI / 180

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (720 - YMAX) / 2   'or delete if YMAX is 700 or above

open "     Olympic Hearts" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "size 2"

wide = 30
w2 = wide/2
s = 160
'============================== main code note: to text need min 10 in y value, text width(6-16) height 16
for dr = wide to 0 step -1
  if dr >= w2 then
    call fore  (wide-dr) / w2 * 100, (wide-dr) / w2 * 100, (wide-dr) / w2 * 100
  else
    call fore 100 - (wide - dr - w2)/w2* 100,100 - (wide - dr - w2)/w2* 100,100 - (wide - dr - w2)/w2* 100
  end if
  call DrawHeart XMAX/2, YMAX/2-.5*s, s + dr
  if dr >= w2 then
    call fore  (wide-dr) / w2 * 50, (wide-dr) / w2 * 50, (wide-dr) / w2 * 255
  else
    call fore 100 - (wide - dr - w2)/w2* 100, 100- (wide - dr - w2)/w2* 100, 255 - (wide - dr - w2)/w2* 255
  end if
  call DrawHeart XMAX/2-2*s, YMAX/2-.5*s, s + dr
  if dr >= w2 then
    call fore  (wide-dr) / w2 * 255, 0, 0
  else
    call fore 255 - (wide - dr - w2)/w2* 255, 0, 0
  end if
  call DrawHeart XMAX/2+2*s, YMAX/2-.5*s, s + dr
    if dr >= w2 then
    call fore (wide-dr) / w2 * 255, (wide-dr) / w2 * 255, 0
  else
    call fore 255 - (wide - dr - w2)/w2* 255,255 - (wide - dr - w2)/w2* 255, 0
  end if
  call DrawHeart XMAX/2-s, YMAX/2 + s, s + dr
  if dr >= w2 then
    call fore 0, (wide-dr) / w2 * 155, (wide-dr) / w2 * 100
  else
    call fore 0, 155 - (wide - dr - w2)/w2* 155, 100 - (wide - dr - w2)/w2* 100
  end if
  call DrawHeart XMAX/2+s, YMAX/2+ s, s + dr
next

#gr "flush"
wait

sub fore r, g, b
    #gr "color ";r;" ";g;" ";b
end sub

sub aline x0, y0, x1, y1
    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

'Need line: #gr "trapclose quit"
sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub

'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub arc xCenter, yCenter, arcRadius, dAStart, dAMeasure
    'notes:
    'you may want to adjust size and color for line drawing
    'using angle measures in degrees to match Just Basic ways with pie and piefilled
    'this sub assumes drawing in a CW direction if dAMeasure positive

    'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South

    'dAStart is degrees to start Angle, due East is 0 degrees

    'dAMeasure is degrees added (Clockwise) to dAstart for end of arc

    rAngleStart = RAD * dAStart
    rAngleEnd = RAD * dAMeasure + rAngleStart
    Stepper = RAD / (.1 * arcRadius) 'fixed
    for rAngle = rAngleStart to rAngleEnd step Stepper
        if rAngle = rAngleStart then
            lastX = xCenter + arcRadius * cos(rAngle)
            lastY = yCenter + arcRadius * sin(rAngle)
        else
            nextX = xCenter + arcRadius * cos(rAngle)
            if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
            nextY = yCenter + arcRadius * sin(rAngle)
            if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
            #gr "line ";lastX;" ";lastY;" ";nextX;" ";nextY
            lastX = nextX
            lastY = nextY
        end if
    next
end sub

sub DrawHeart x, y, r
'clockwise from due East, the V
    call aline x + r, y, x, y + r
    call aline x, y + r, x - r, y
    'left hump
    call arc x - .5 * r, y - .5 * r, .5 * r * 2 ^ .5, 135, 180
    'right hump
    call arc x + .5 * r, y - .5 * r, .5 * r * 2 ^ .5, 225, 180
end sub

As you can see I was able to interlock and overlap these.


Attached Files Thumbnail(s)

B += x
Reply
#2
Very nicely done, Mark
I like to program in BASIC
With code that is simple and slick
I learnt it in school
And it is still cool
So it is my number one pick
Reply
#3
Thanks Adrian, 

I think our new member, thedaemon, is a graphics fan too from what I picked up at IRC. But I will try and let him tell his story. 

Try, trying not to blabber everything I hear from somewhere else unless all good!
B += x
Reply