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

B+

  • Hero Member
  • *****
  • Posts: 775
    • View Profile
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-07

while 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 10
wend
pause

'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/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, 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

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-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

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-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


B+

  • Hero Member
  • *****
  • Posts: 775
    • View Profile
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-07
randomize timer
dim counts(7)
color 15, rgb(60, 30, 15)
cls
while 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 10
wend
pause

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
    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 if
end sub

sub 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
  next
end sub

'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


SmallBASIC has an arc sub but the handmade one draws better lines here.
« Last Edit: 10. March 2018, 13:26:00 by B+ »