JB Happy St Patrick's Day
#1
Code:
'from QB64
' _TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07

global H$, XMAX, YMAX, PI, DEG, RAD
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 "     Happy St Patrick's Day by bplus 2018-03-07" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "size 2"

WHILE 1
   scan
   cc1 = RND(0) * 100 + 50
   cc2 = RND(0) * 100 + 50
   xp = RND(0) * XMAX
   yp = RND(0) * YMAX
   sz = INT(RND(0) * 40) + 10
   ang = RND(0) * PI*2
   #gr "size 2"
   call fore 0, cc1, 0
   FOR r = 1 TO sz
       scan
       call drawShamrock xp +1, yp, r, ang
       'call drawShamrock xp - 1, yp, r, ang
       'call drawShamrock xp, yp + 1, r, ang
       'call drawShamrock xp, yp - 1, r, ang
       'call drawShamrock xp + 1, yp + 1, r, ang
   NEXT
   #gr "size 1"
   call fore 0, cc2, 0
   FOR r = 1 TO sz
       scan
       call drawShamrock xp, yp, r, ang
   NEXT
WEND
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, a
   scan
   'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
   'clockwise from due East, the V
   x1 = x + r * COS(a)
   y1 = y + r * SIN(a)
   x2 = x + r * COS(a + PI / 2)
   y2 = y + r * SIN(a + PI / 2)
   x3 = x + r * COS(a + PI)
   y3 = y + r * SIN(a + PI)
   x4 = x + r * COS(a + 3 * PI / 2)
   y4 = y + r * SIN(a + 3 * PI / 2)
   x5 = (x3 + x4) / 2
   y5 = (y3 + y4) / 2
   x6 = (x4 + x1) / 2
   y6 = (y4 + y1) / 2
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x3;" ";y3
   'left hump
   call arc x5, y5, .5 * r * 2 ^ .5, DEG*a + 135, 180
   'right hump
   call arc x6, y6, .5 * r * 2 ^ .5, DEG*a + 225, 180
END SUB

SUB drawShamrock x, y, r, a
   'local x1, x2, x3, y1, y2, y3
   scan
   x1 = x + r * COS(a + 3 * PI / 2)
   y1 = y + r * SIN(a + 3 * PI / 2)
   x2 = x + r * COS(a + PI / 6)
   y2 = y + r * SIN(a + PI / 6)
   x3 = x + r * COS(a + 5 * PI / 6)
   y3 = y + r * SIN(a + 5 * PI / 6)
   call drawHeart x1, y1, r, a
   call drawHeart x2, y2, r, a + 2 * PI / 3
   call drawHeart x3, y3, r, a + 4 * PI / 3
END SUB


Append: After running for an hour or so, got a JB screen shot


Attached Files Thumbnail(s)

B += x
Reply
#2
Ah! got the time down so can see how long it takes to get lucky and get a 7 leaf shamrock without growing a beard. I got one in 14 shamrocks once!

Code:
'Shamrock 2018-03-09.bas for JB v2b2 by bplus and tsh73
' fix arc, return arc lines, space leaves evenly, dirt background
' removed need for USECIRCLE, added Andy Amaya's fill triangle for solid fill shamrocks
' mod tsh73 2018-03-09 mod with USECIRCLE, arc fix but not quite there
' mod N leafed Shamrocks from Happy St Patrick's Day 2018-03-08 < -- edit date
' from QB64: _TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from: Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07

global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 1280 '<======================================== actual drawing space needed
YMAX = 740  '<======================================== actual drawing space needed
PI = acs(-1)
DEG = 180 / PI
RAD = PI / 180
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 30
open " N Leafed Shamrocks, How Lucky Are You?    (Stops when 7 leafer is made.)    by bplus and tsh73 2018-03-09" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "fill 60 30 10"
#gr "size 1"
dim count(7)

WHILE nLeafs < 7
   scan
   #gr "discard"    'to prevent memory build-up
   luck = rnd(0)
   select case
   case luck <= 1/625 : nLeafs = 7
   case luck <= 1/125 : nLeafs = 6
   case luck <= 1/25  : nLeafs = 5
   case luck <= 1/5   : nLeafs = 4
   case else          : nLeafs = 3
   end select
   count(nLeafs) = count(nLeafs) + 1
   #gr "place 0 0"
   #gr "backcolor blue"
   #gr "color black"
   #gr "\\";right$("";100 + count(7), 2);":" _
   ;right$("";100   + count(6), 2);":" _
   ;right$("";100   + count(5), 2);":" _
   ;right$("";1000  + count(4), 3);":" _
   ;right$("";10000 + count(3), 4)
   cc1 = RND(0) * 100 + 50
   cc2 = RND(0) * 100 + 50
   while abs(cc2 - cc1) < 30 'make them substantially different
       cc2 = RND(0) * 100 + 50
   wend
   xp = RND(0) * (XMAX - 100) + 50
   yp = RND(0) * (YMAX - 100) + 50
   sz = INT(RND(0) * 20) + 10
   ang = RND(0) * PI * 2
   #gr "color ";0;" ";cc1;" ";0
   #gr "backcolor ";0;" ";int(cc1);" ";0
   #gr "size 2" 'to fill holes
   call drawShamrockN xp, yp, sz, ang, nLeafs, 1
   #gr "size 1"
   #gr "color ";0;" ";int(cc2);" ";0
   for r = 2 to sz-1 step 1
       call drawShamrockN xp, yp, r, ang, nLeafs, 0
   next
WEND
wait

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

'Fast Filled Triangle Sub by AndyAmaya
Sub ftriangle x1, y1, x2, y2, x3, y3
   scan
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1) / (x2 - x1)
       For x = 0 To length
           #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) / (x3 - x2)
       For x = 0 To length
           #gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
End Sub

sub drawShamrockN x, y, r, a, nLeafed, solid
   scan
   bigR = 2.05 * r * nLeafed / (2 * PI)  '<< EDIT for fuller leaves
   for leaf = 0 to nLeafed-1
       x1 = x + bigR * cos(a + leaf * 2 * PI / nLeafed + 3 * PI / 2 )
       y1 = y + bigR * sin(a + leaf * 2 * PI / nLeafed + 3 * PI / 2 )
       call drawHeart x1, y1, r, bigR, a + leaf * 2 * PI / nLeafed , solid
   next
end sub

sub drawHeart x, y, r, rl, a, solid
   scan
   'clockwise from due East, the V
   x1 = x + r * cos(a)
   y1 = y + r * sin(a)
   x2 = x + rl * cos(a + PI / 2)
   y2 = y + rl * sin(a + PI / 2)
   x3 = x + r * cos(a + PI)
   y3 = y + r * sin(a + PI)
   x4 = x + r * cos(a + 3 * PI / 2)
   y4 = y + r * sin(a + 3 * PI / 2)
   x5 = (x3 + x4) / 2
   y5 = (y3 + y4) / 2
   x6 = (x4 + x1) / 2
   y6 = (y4 + y1) / 2
   if solid then
       call ftriangle x1, y1, x2, y2, x3, y3
       call ftriangle x3, y3, x4, y4, x1, y1
       #gr "place ";int(x5);" ";int(y5)
       #gr "circlefilled ";int(.5 * r * 2 ^ .5)
       #gr "place ";int(x6);" ";int(y6)
       #gr "circlefilled ";int(.5 * r * 2 ^ .5)
   else
       #gr "line ";int(x1);" ";int(y1);" ";int(x2);" ";int(y2)
       #gr "line ";int(x2);" ";int(y2);" ";int(x3);" ";int(y3)
       'left hump
       call arc x5, y5, .5 * r * 2 ^ .5, DEG * a + 135, 180
       'right hump
       call arc x6, y6, .5 * r * 2 ^ .5, DEG * a + 225, 180
   end if
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
   lastX = xCenter + arcRadius * cos(rAngleStart)
   lastY = yCenter + arcRadius * sin(rAngleStart)
   #gr "set ";int(lastX);" ";int(lastY)
   for rAngle = rAngleStart+Stepper to rAngleEnd step Stepper
       nextX = xCenter + arcRadius * cos(rAngle)
       nextY = yCenter + arcRadius * sin(rAngle)
       #gr "goto ";int(nextX);" ";int(nextY)    'int speeds things up
   next
end sub

Edits: makeover and fix of the code today.
EDIT: 2018-03-10 one line of code for fuller leaves.


Attached Files Thumbnail(s)

B += x
Reply