### Author Topic: Happy St Patrick's Day  (Read 407 times)

#### B+

• Hero Member
• Posts: 775
##### Happy St Patrick's Day
« on: 07. March 2018, 20:56:47 »
SmallBASIC version
Code: [Select]
`' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07while 1  cc1 = rgb(0, rnd*100 +50, 0)  cc2 = rgb(0, rnd*100 +50, 0)  xp = rnd * xmax  yp = rnd * ymax  size = int(rnd*100) + 10  ang = rnd*2*pi  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  showpage  delay 10wendpause'draws an arc with center at xCenter, yCenter, radius from center is arcRadiussub 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    nextend subsub 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/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   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, 180end subsub 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/3end sub`
QB version
Code: [Select]
`_TITLE "Happy St Patrick's Day by bplus 2018-03-07"' from' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07CONST xmax = 1280CONST ymax = 760SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 70, 0WHILE 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 20WEND'draws an arc with center at xCenter, yCenter, radius from center is arcRadiusSUB 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    NEXTEND SUBSUB 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, 180END SUBSUB 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 / 3END SUBFUNCTION RAD (a)    RAD = _PI(a / 180)END FUNCTIONFUNCTION DEG (a)    DEG = a * 180 / _PIEND FUNCTION`
JB version
Code: [Select]
`'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-07global H\$, XMAX, YMAX, PI, DEG, RADH\$ = "gr"XMAX = 1200 '<======================================== actual drawing space neededYMAX = 720 '<======================================== actual drawing space neededPI = acs(-1)DEG = 180 / PIRAD = PI / 180nomainwinWindowWidth = XMAX + 8WindowHeight = YMAX + 32UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or aboveUpperLeftY = (720 - YMAX) / 2   'or delete if YMAX is 700 or aboveopen "     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    NEXTWENDwaitsub fore r, g, b    #gr "color ";r;" ";g;" ";bend subsub aline x0, y0, x1, y1    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end pointend sub'Need line: #gr "trapclose quit"sub quit H\$    close #H\$ '<=== this needs Global H\$ = "gr"    end       'Thanks Facundo, close graphic wo errorend sub'draws an arc with center at xCenter, yCenter, radius from center is arcRadiussub 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    nextend subSUB 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, 180END SUBSUB 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 / 3END SUB`

#### B+

• Hero Member
• Posts: 775
##### Re: Happy St Patrick's Day
« Reply #1 on: 10. March 2018, 12:36:41 »
A Shamrock Slot Machine: How many Shamrocks will it take to get a 7 leafed one with 1 in 625 chance?
Code: [Select]
`' Shamrock Luck.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-10' from: QB64 version of Shamrock 2018-03-09.bas' 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-07randomize timerdim counts(7)color 15, rgb(60, 30, 15)clswhile nLeafs < 7   luck = rnd   if luck < 1 / 625 then      nLeafs = 7   elif luck < 1 / 125 then      nLeafs = 6   elif luck < 1 / 25      nLeafs = 5   elif luck < 1 / 5      nLeafs = 4   else      nLeafs = 3   fi   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))   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 rgb(0, cc1, 0)   drawShamrockN xp + 1, yp, size, ang, nLeafs, 1   color rgb(0, cc2, 0)   for r = 1 to size      drawShamrockN xp, yp, r, ang, nLeafs, 0   next   color 15   at 1, 1 : ? stat\$ + " N Leafed Shamrocks, 1 in 625 chance for 7 Leafed Shamrock.   showpage   delay 10wendpausesub 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    drawpoly [x1, y1, x2, y2, x3, y3, x4, y4, x1, y1] filled    circle x5, y5, .5 * r * 2 ^ .5 filled    circle x6, y6, .5 * r * 2 ^ .5 filled  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) + 235, 180  end ifend subsub drawShamrockN (x, y, r, a, nleafed, solid)  local bigr, leaf, x1, y1  bigr = 2.11 * r * nleafed / (2 * pi)  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  nextend sub'draws an arc with center at xCenter, yCenter, radius from center is arcRadiussub 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   nextend sub`
SmallBASIC has an arc sub but the handmade one draws better lines here.
« Last Edit: 10. March 2018, 13:26:00 by B+ »