Proggies

[bplus]

Shamrocks!

Code: (Select All)

_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