QB Happy St Patrick's Day
#1
Code:
_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
CONST xmax = 1280
CONST ymax = 760
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 70, 0


WHILE 1
   cc1&& = _RGB32(0, RND * 100 + 50, 0)
   cc2&& = _RGB32(0, RND * 100 + 50, 0)
   xp = RND * xmax
   yp = RND * ymax
   size = INT(RND * 100) + 10
   ang = RND * _PI(2)
   COLOR cc1&&
   FOR r = 1 TO size
       drawShamrock xp + 1, yp, r, ang
       drawShamrock xp - 1, yp, r, ang
       drawShamrock xp, yp + 1, r, ang
       drawShamrock xp, yp - 1, r, ang
       drawShamrock xp + 1, yp + 1, r, ang
   NEXT
   COLOR cc2&&
   FOR r = 1 TO size
       drawShamrock xp, yp, r, ang
   NEXT
   _DISPLAY
   _LIMIT 20
WEND


'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
SUB myArc (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 / (.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
           LINE (lastX, lastY)-(nextX, nextY)
           lastX = nextX
           lastY = nextY
       END IF
   NEXT
END SUB

SUB drawHeart (x, y, r, a)
   '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(1 / 2))
   y2 = y + r * SIN(a + _PI(1 / 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
   LINE (x1, y1)-(x2, y2)
   LINE (x2, y2)-(x3, y3)
   'left hump
   myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
   'right hump
   myArc 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
   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)
   drawHeart x1, y1, r, a
   drawHeart x2, y2, r, a + 2 * _PI / 3
   drawHeart x3, y3, r, a + 4 * _PI / 3
END SUB

FUNCTION RAD (a)
   RAD = _PI(a / 180)
END FUNCTION

FUNCTION DEG (a)
   DEG = a * 180 / _PI
END FUNCTION


Attached Files Thumbnail(s)

B += x
Reply
#2
OK someone asked for Lucky 4 Leafer Shamrock.

I said why stop at 4 and made a game:
Code:
_TITLE "N Leafed Shamrocks, How Lucky Are You? (Find the 7 Leafer when this stops drawing.)   by bplus 2018-03-08"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
RANDOMIZE TIMER
CONST xmax = 1280
CONST ymax = 740
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 70, 0


WHILE nLeafs < 7
   IF RND < .2 THEN
       IF RND < .2 THEN
           IF RND < .2 THEN
               IF RND < .2 THEN
                   nLeafs = 7
               ELSE
                   nLeafs = 6
               END IF
           ELSE
               nLeafs = 5
           END IF
       ELSE
           nLeafs = 4
       END IF
   ELSE
       nLeafs = 3
   END IF

   cc1&& = _RGB32(0, RND * 100 + 50, 0)
   cc2&& = _RGB32(0, RND * 100 + 50, 0)
   xp = RND * (xmax - 100) + 50
   yp = RND * (ymax - 100) + 50
   size = INT(RND * 40) + 10
   ang = RND * _PI(2)
   COLOR cc1&&
   FOR r = 1 TO size STEP .3
       drawShamrockN xp + 1, yp, r, ang, nLeafs
       drawShamrockN xp - 1, yp, r, ang, nLeafs
       drawShamrockN xp, yp + 1, r, ang, nLeafs
       drawShamrockN xp, yp - 1, r, ang, nLeafs
       drawShamrockN xp + 1, yp + 1, r, ang, nLeafs
   NEXT
   COLOR cc2&&
   FOR r = 1 TO size STEP 1
       drawShamrockN xp, yp, r, ang, nLeafs
   NEXT
   ns = ns + 1
   _TITLE STR$(ns) + " N Leafed Shamrocks, How Lucky Are You? (Find the 7 Leafer when this stops drawing.)   by bplus 2018-03-08"
   _DISPLAY
   _LIMIT 20
WEND


'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
SUB myArc (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 / (.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
           LINE (lastX, lastY)-(nextX, nextY)
           lastX = nextX
           lastY = nextY
       END IF
   NEXT
END SUB

FUNCTION RAD (a)
   RAD = _PI(a / 180)
END FUNCTION

FUNCTION DEG (a)
   DEG = a * 180 / _PI
END FUNCTION


SUB drawSqueezedHeart (x, y, r, rl, a)
   '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 + 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
   LINE (x1, y1)-(x2, y2)
   LINE (x2, y2)-(x3, y3)
   'left hump
   myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
   'right hump
   myArc x6, y6, .5 * r * 2 ^ .5, DEG(a) + 225, 180
END SUB

SUB drawShamrockN (x, y, r, a, nLeafed)
   'local bigR, x1, x2, x3, y1, y2, y3
   np1 = nLeafed + 1
   noLeaf = INT(np1 / 2)
   bigR = 2.2 * r * np1 / (2 * _PI)
   IF nLeafed MOD 2 = 0 THEN aoff = _PI / np1
   FOR leaf = 0 TO nLeafed
       IF leaf <> noLeaf THEN
           x1 = x + bigR * COS(a + leaf * 2 * _PI / np1 + 3 * _PI / 2 + aoff)
           y1 = y + bigR * SIN(a + leaf * 2 * _PI / np1 + 3 * _PI / 2 + aoff)
           drawSqueezedHeart x1, y1, r, bigR, a + leaf * 2 * _PI / np1 + aoff
       END IF
   NEXT
END SUB


Attached Files Thumbnail(s)

B += x
Reply
#3
Applying all lessons learned while improving JB version of Shamrock Luck:
Code:
_TITLE "N Leafed Shamrocks, How many shamrocks until you get a 7 leafed one?    by bplus 2018-03-09"
' Shamrock 2018-03-09 mod to lessons learned with JB version 2018-03-09 tsh tips
' from N Leafed Shamrocks 2018-03-08
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
RANDOMIZE TIMER
CONST xmax = 1280
CONST ymax = 740
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 70, 0
DIM counts(7)
CLS , _RGB32(60, 30, 15)
WHILE nLeafs < 7
   luck = RND
   SELECT CASE luck
       CASE IS < 1 / 625: nLeafs = 7
       CASE IS < 1 / 125: nLeafs = 6
       CASE IS < 1 / 25: nLeafs = 5
       CASE IS < 1 / 5: nLeafs = 4
       CASE ELSE: nLeafs = 3
   END SELECT
   counts(nLeafs) = counts(nLeafs) + 1
   counts(1) = counts(1) + 1
   stat$ = STR$(counts(3))
   FOR i = 4 TO 7
       stat$ = stat$ + " :" + STR$(counts(i))
   NEXT
   stat$ = stat$ + " =" + STR$(counts(1))
   _TITLE stat$ + " N Leafed Shamrocks, How many shamrocks until you get a 7 leafed one? (1 in 625 chance)  by bplus 2018-03-09"
   cc1% = RND * 100 + 50
   cc2% = RND * 100 + 50
   WHILE ABS(cc1% - cc2%) < 30 'for contrast of 2 colors
       cc2% = RND * 100 + 50
   WEND
   xp = RND * (xmax - 100) + 50
   yp = RND * (ymax - 100) + 50
   size = INT(RND * 40) + 10
   ang = RND * _PI(2)
   COLOR _RGB32(0, cc1%, 0)
   drawShamrockN xp + 1, yp, size, ang, nLeafs, 1
   COLOR _RGB32(0, cc2%, 0)
   FOR r = 1 TO size STEP 1
       drawShamrockN xp, yp, r, ang, nLeafs, 0
   NEXT
   _DISPLAY
   _LIMIT 10
WEND
SLEEP

'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
SUB myArc (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 / (.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
           LINE (lastX, lastY)-(nextX, nextY)
           lastX = nextX
           lastY = nextY
       END IF
   NEXT
END SUB

FUNCTION RAD (a)
   RAD = _PI(a / 180)
END FUNCTION

FUNCTION DEG (a)
   DEG = a * 180 / _PI
END FUNCTION

SUB drawHeart (x, y, r, rl, a, solid)
   '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 + 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
       filltri x1, y1, x2, y2, x3, y3
       filltri x2, y2, x3, y3, x4, y4
       fcirc x5, y5, .5 * r * 2 ^ .5
       fcirc x6, y6, .5 * r * 2 ^ .5
   ELSE
       LINE (x1, y1)-(x2, y2)
       LINE (x2, y2)-(x3, y3)
       'left hump
       myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
       'right hump
       myArc x6, y6, .5 * r * 2 ^ .5, DEG(a) + 225, 180
   END IF
END SUB

SUB drawShamrockN (x, y, r, a, nLeafed, solid)
   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)
       drawHeart x1, y1, r, bigR, a + leaf * 2 * _PI / nLeafed, solid
   NEXT
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
   DIM subRadius AS LONG, RadiusError AS LONG
   DIM X AS LONG, Y AS LONG

   subRadius = ABS(R)
   RadiusError = -subRadius
   X = subRadius
   Y = 0

   IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

   ' Draw the middle span here so we don't draw it twice in the main loop,
   ' which would be a problem with blending turned on.
   LINE (CX - X, CY)-(CX + X, CY), , BF

   WHILE X > Y
       RadiusError = RadiusError + Y * 2 + 1
       IF RadiusError >= 0 THEN
           IF X <> Y + 1 THEN
               LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
               LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
           END IF
           X = X - 1
           RadiusError = RadiusError - X * 2
       END IF
       Y = Y + 1
       LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
       LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
   WEND
END SUB

SUB filltri (xx1, yy1, xx2, yy2, xx3, yy3)
   'make copies before swapping
   x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
   'thanks Andy Amaya!
   'triangle coordinates must be ordered: where x1 < x2 < x3
   IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
   IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
   IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
   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
           LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
           'lastx2% = lastx%
           lastx% = INT(x + x1)
       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
           'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
           IF INT(x + x2) <> lastx% THEN
               LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
           END IF
       NEXT
   END IF
END SUB

Right after I change black background to a dirt color, I hit my best Shamrock count ever!

Right after that fixing the stats display, I hit my worst Shamrock count ever!

EDIT: 2018-03-10 changed one line to get fuller leaves.


Attached Files Thumbnail(s)

B += x
Reply