Author Topic: Shamrocks  (Read 2080 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Shamrocks
« on: March 17, 2021, 10:53:20 am »
Happy St Pat's, this is like a slot machine you keep playing (drawing shamrocks) until a 7 leafed one is drawn.

Good luck!

Code: QB64: [Select]
  1. _Title "N Leafed Shamrocks, How many shamrocks until you get a 7 leafed one?    by bplus 2018-03-09"
  2. ' Shamrock 2018-03-09 mod to lessons learned with JB version 2018-03-09 tsh tips
  3. ' from N Leafed Shamrocks 2018-03-08
  4. ' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
  5. Const xmax = 1280
  6. Const ymax = 740
  7. Screen _NewImage(xmax, ymax, 32)
  8. Dim counts(7)
  9. Cls , _RGB32(60, 30, 15)
  10. While nLeafs < 7
  11.     luck = Rnd
  12.     Select Case luck
  13.         Case Is < 1 / 625: nLeafs = 7
  14.         Case Is < 1 / 125: nLeafs = 6
  15.         Case Is < 1 / 25: nLeafs = 5
  16.         Case Is < 1 / 5: nLeafs = 4
  17.         Case Else: nLeafs = 3
  18.     End Select
  19.     counts(nLeafs) = counts(nLeafs) + 1
  20.     counts(1) = counts(1) + 1
  21.     stat$ = Str$(counts(3))
  22.     For i = 4 To 7
  23.         stat$ = stat$ + " :" + Str$(counts(i))
  24.     Next
  25.     stat$ = stat$ + " =" + Str$(counts(1))
  26.     _Title stat$ + " N Leafed Shamrocks, How many shamrocks until you get a 7 leafed one? (1 in 625 chance)  by bplus 2018-03-09"
  27.     cc1% = Rnd * 100 + 50
  28.     cc2% = Rnd * 100 + 50
  29.     While Abs(cc1% - cc2%) < 30 'for contrast of 2 colors
  30.         cc2% = Rnd * 100 + 50
  31.     Wend
  32.     xp = Rnd * (xmax - 100) + 50
  33.     yp = Rnd * (ymax - 100) + 50
  34.     size = Int(Rnd * 40) + 10
  35.     ang = Rnd * _Pi(2)
  36.     Color _RGB32(0, cc1%, 0)
  37.     drawShamrockN xp + 1, yp, size, ang, nLeafs, 1
  38.     Color _RGB32(0, cc2%, 0)
  39.     For r = 1 To size Step 1
  40.         drawShamrockN xp, yp, r, ang, nLeafs, 0
  41.     Next
  42.     _Display
  43.     _Limit 10
  44.  
  45. 'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
  46. Sub myArc (xCenter, yCenter, arcRadius, dAStart, dAMeasure)
  47.     'notes:
  48.     'you may want to adjust size and color for line drawing
  49.     'using angle measures in degrees to match Just Basic ways with pie and piefilled
  50.     'this sub assumes drawing in a CW direction if dAMeasure positive
  51.  
  52.     'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
  53.  
  54.     'dAStart is degrees to start Angle, due East is 0 degrees
  55.  
  56.     'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
  57.  
  58.     rAngleStart = RAD(dAStart)
  59.     rAngleEnd = RAD(dAMeasure) + rAngleStart
  60.     Stepper = RAD(1 / (.1 * arcRadius)) 'fixed
  61.     For rAngle = rAngleStart To rAngleEnd Step Stepper
  62.         If rAngle = rAngleStart Then
  63.             lastX = xCenter + arcRadius * Cos(rAngle)
  64.             lastY = yCenter + arcRadius * Sin(rAngle)
  65.         Else
  66.             nextX = xCenter + arcRadius * Cos(rAngle)
  67.             If nextX <= lastX Then useX = nextX - 1 Else useX = nextX + 1
  68.             nextY = yCenter + arcRadius * Sin(rAngle)
  69.             If nextY <= lastY Then useY = nextY - 1 Else useY = nextY + 1
  70.             Line (lastX, lastY)-(nextX, nextY)
  71.             lastX = nextX
  72.             lastY = nextY
  73.         End If
  74.     Next
  75.  
  76. Function RAD (a)
  77.     RAD = _Pi(a / 180)
  78.  
  79. Function DEG (a)
  80.     DEG = a * 180 / _Pi
  81.  
  82. Sub drawHeart (x, y, r, rl, a, solid)
  83.     'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
  84.     'clockwise from due East, the V
  85.     x1 = x + r * Cos(a)
  86.     y1 = y + r * Sin(a)
  87.     x2 = x + rl * Cos(a + _Pi / 2)
  88.     y2 = y + rl * Sin(a + _Pi / 2)
  89.     x3 = x + r * Cos(a + _Pi)
  90.     y3 = y + r * Sin(a + _Pi)
  91.     x4 = x + r * Cos(a + 3 * _Pi / 2)
  92.     y4 = y + r * Sin(a + 3 * _Pi / 2)
  93.     x5 = (x3 + x4) / 2
  94.     y5 = (y3 + y4) / 2
  95.     x6 = (x4 + x1) / 2
  96.     y6 = (y4 + y1) / 2
  97.     If solid Then
  98.         filltri x1, y1, x2, y2, x3, y3
  99.         filltri x2, y2, x3, y3, x4, y4
  100.         fcirc x5, y5, .5 * r * 2 ^ .5
  101.         fcirc x6, y6, .5 * r * 2 ^ .5
  102.     Else
  103.         Line (x1, y1)-(x2, y2)
  104.         Line (x2, y2)-(x3, y3)
  105.         'left hump
  106.         myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
  107.         'right hump
  108.         myArc x6, y6, .5 * r * 2 ^ .5, DEG(a) + 225, 180
  109.     End If
  110.  
  111. Sub drawShamrockN (x, y, r, a, nLeafed, solid)
  112.     bigR = 2.05 * r * nLeafed / (2 * _Pi) '<<<<<<<<<<<< EDIT for fuller leaves
  113.     For leaf = 0 To nLeafed - 1
  114.         x1 = x + bigR * Cos(a + leaf * 2 * _Pi / nLeafed + 3 * _Pi / 2)
  115.         y1 = y + bigR * Sin(a + leaf * 2 * _Pi / nLeafed + 3 * _Pi / 2)
  116.         drawHeart x1, y1, r, bigR, a + leaf * 2 * _Pi / nLeafed, solid
  117.     Next
  118.  
  119. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  120. Sub fcirc (CX As Long, CY As Long, R As Long)
  121.     Dim subRadius As Long, RadiusError As Long
  122.     Dim X As Long, Y As Long
  123.  
  124.     subRadius = Abs(R)
  125.     RadiusError = -subRadius
  126.     X = subRadius
  127.     Y = 0
  128.  
  129.     If subRadius = 0 Then PSet (CX, CY): Exit Sub
  130.  
  131.     ' Draw the middle span here so we don't draw it twice in the main loop,
  132.     ' which would be a problem with blending turned on.
  133.     Line (CX - X, CY)-(CX + X, CY), , BF
  134.  
  135.     While X > Y
  136.         RadiusError = RadiusError + Y * 2 + 1
  137.         If RadiusError >= 0 Then
  138.             If X <> Y + 1 Then
  139.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  140.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  141.             End If
  142.             X = X - 1
  143.             RadiusError = RadiusError - X * 2
  144.         End If
  145.         Y = Y + 1
  146.         Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  147.         Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  148.     Wend
  149.  
  150. Sub filltri (xx1, yy1, xx2, yy2, xx3, yy3)
  151.     'make copies before swapping
  152.     x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
  153.     'thanks Andy Amaya!
  154.     'triangle coordinates must be ordered: where x1 < x2 < x3
  155.     If x2 < x1 Then Swap x1, x2: Swap y1, y2
  156.     If x3 < x1 Then Swap x1, x3: Swap y1, y3
  157.     If x3 < x2 Then Swap x2, x3: Swap y2, y3
  158.     If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)
  159.  
  160.     'draw the first half of the triangle
  161.     length = x2 - x1
  162.     If length <> 0 Then
  163.         slope2 = (y2 - y1) / (x2 - x1)
  164.         For x = 0 To length
  165.             Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1))
  166.             'lastx2% = lastx%
  167.             lastx% = Int(x + x1)
  168.         Next
  169.     End If
  170.  
  171.     'draw the second half of the triangle
  172.     y = length * slope1 + y1: length = x3 - x2
  173.     If length <> 0 Then
  174.         slope3 = (y3 - y2) / (x3 - x2)
  175.         For x = 0 To length
  176.             'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
  177.             If Int(x + x2) <> lastx% Then
  178.                 Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2))
  179.             End If
  180.         Next
  181.     End If
  182.  
  183.  
« Last Edit: March 17, 2021, 11:02:19 am by bplus »

Offline 191Brian

  • Newbie
  • Posts: 91
    • View Profile
    • My Itch page
Re: Shamrocks
« Reply #1 on: March 17, 2021, 06:27:48 pm »
Nice and topical like how they appear to shine.
Brian ...

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Shamrocks
« Reply #2 on: March 17, 2021, 08:47:35 pm »
Nice, of course bplus would know how to draw them.

Wow, what's with the oddly capitalized code, ie End Sub?  Is this the cool thing now?  Reminds me of VB.NET.  freebasic is also commonly done like that, at least in the wiki.  I've always preferred lower case whenever possible, personally

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Shamrocks
« Reply #3 on: March 17, 2021, 08:54:51 pm »
Hi @_vince

The camel code is the new look for QB64 v1.5, NO MORE SHOUTING! I like it.

Oh and in any case check this out:
https://www.qb64.org/forum/index.php?topic=3723.0

Oh also check this out, my color scheme for IDE "Forest":

Shamrock Forest.PNG
* Shamrock Forest.PNG (Filesize: 33.94 KB, Dimensions: 1128x664, Views: 204)
« Last Edit: March 17, 2021, 09:02:22 pm by bplus »

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Shamrocks
« Reply #4 on: March 17, 2021, 09:20:12 pm »
Yes, green is nice to code in, easy on the eyes.  I should try and play with my colour scheme, here is my IDE
qb64ide.png
* qb64ide.png (Filesize: 31.17 KB, Dimensions: 1029x851, Views: 209)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Shamrocks
« Reply #5 on: March 17, 2021, 09:23:59 pm »
Yeah the white print kind of burns your eyes, hey is that a Linux title bar? it looks nice!