Fall Banner bplus WIP

[bplus]

OK lot's of little things including fixing font prints, adding treeType to fix leaves sticking to trees 2 feet up the trunk. I tried Point first to detect tree trunk color. It did not work all that great in QB64 and QBJS did not like at all. So I found another way around by redrawing the tree trunks.

So here is latest:
[Broken link error #413]
Hey is the QBJS Server is giving me an error when I try to test the Shared Code link from this forum. I retried 3 times. The code works fine in QBJS but the shared code link 413's an Error???

Code: (Select All)

'Option _Explicit
'_Title "Fall Foliage Banner Move Leaves"  2023-09-03 bak copy
' started 2017-10-21 by bplus as: fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21

' 2023-08-30 start of QBJS Banner
' 2023-08-31 Logo and Hills added

' 2023-09-01 Fellippe I see contributed allot to orig code with moving leaves
' Also thanks to grymmjack for getting me starting of PFont and font patterns.
' Also thanks to dbox for catching all my errors with QBJS.

' 2023-09-03 try to fix font print to print while leaves are falling
' tweak numbers for falling leaves for more and not too leaden.

' 2023-09-03 FontFlag to signal FPrint is done

' 2023-09-04 do not stop leaves falling when on a tree trunk
' Ran into problems with QBJS handling Point see commented code in MoveLeaf
' So this keeps moving leaves without Point
' Clean up code a bit fix letters shadows, toss junk subs
' Aha! found a way to get leaves off tree trunks = redraw trunks!
' New Type Tree

Type treeType
    x As Single
    y As Single
    r As Single
    h As Single
End Type

Type new_Leaf
    x As Single
    y As Single
    w As Single
    h As Single
    c As _Unsigned Long
    isFree As Integer
    rx As Integer
    ry As Integer
    yvel As Single
    xvel As Single
    yacc As Single
    xacc As Single
End Type

Const gravity = .0010

Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind
Dim Shared stopFrame As Long
Dim Shared FontFlag As Long ' to signal Font has been finished
'Dim Shared TreeTrunkClr As _Unsigned Long
' TreeTrunkClr = _RGB32(60, 30, 15) ' lev 0 color  QBJS Point not working

Dim As Long Logo
$If WEB Then
        Logo = _LoadImage("https://qb64phoenix.com/forum/attachment.php?aid=2206", 32)
$Else
    Logo = _LoadImage("peLogo.png", 32)
$End If

'now for full viewing enjoyment xmx = screen width, ymx = screen height
Dim Shared xmx, ymx
xmx = 1200 ' for banner 1400 doesn't fit my screen so using 1200 for broader expanse look
ymx = 256
Screen _NewImage(xmx, ymx, 32) ' grymmjack set on making this 1400 it appears OK

Dim spattern$(0 To 255) ' for 9x9 fonts from string patterns some reworked or added for banner
LoadPatterns9x9 spattern$()
Dim As Long i, scene, trees

While 1
    'Draw scene:
    ReDim Shared leaf(30000) As new_Leaf
    totalLeaves = 0
    stopFrame = 0
    FontFlag = 0
    Cls

    horizon = rand&(.8 * ymx, .9 * ymx)

    'sky and hill background
    drawLandscape
    For i = horizon To ymx
        midInk 160, 188, 50, 100, 60, 25, (i - horizon) / (ymx - horizon)
        Line (0, i)-(xmx, i)
    Next

    'fallen leaves:
    For i = 1 To 50 'less of these at start, as they'll grow in number anyway
        createLeaf rand&(0, xmx), rand&(horizon * 1.002, ymx)
    Next

    ' trees
    trees = rand&(5, 12)
    ReDim tree(1 To trees) As treeType
    For i = 1 To trees
        tree(i).x = rand&(50, xmx - 50)
        tree(i).y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
        tree(i).r = .01 * tree(i).y
        tree(i).h = rand&(tree(i).y * .15, tree(i).y * .18)
        branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, 7
    Next

    If scene < -1 Then _FreeImage scene
    scene = _CopyImage(0) ' take a picture of bare trees before they are clothed with leaves

    'Animate scene:
    While FontFlag < 1500 ' keep going 1500 more loops to drop allot of leaves
        If Rnd < .4 Then wind = Rnd / 50 - Rnd / 800 Else wind = 0
        _PutImage , scene
        letLeafGo
        For i = 1 To totalLeaves
            moveLeaf leaf(i)
            Line (leaf(i).x, leaf(i).y)-Step(leaf(i).w, leaf(i).h), leaf(i).c, BF
        Next
        _PutImage (20, 80)-(150, 210), Logo, 0
        _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0

        ' this draws one letter squares at a time until title is complete
        ' the FontFlag is increased by 1 for 1500 loops after letters are complete
        FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00

        ' draw tree trunks again
        For i = 1 To trees
            branch tree(i).x, tree(i).y, tree(i).r, 90, tree(i).h, 0, -1
        Next
        _Display
        _Limit 30
    Wend
Wend

Sub branch (xx, yy, startrr, angDD, lengthh, levv, stopLev)
    Dim x, y, lev, length, angD, startr, x2, y2, dx, dy, i
    Dim bc~&
    x = xx: y = yy
    lev = levv
    length = lengthh
    angD = angDD
    startr = startrr
    x2 = x + Cos(_D2R(angD)) * length
    y2 = y - Sin(_D2R(angD)) * length
    dx = (x2 - x) / length
    dy = (y2 - y) / length
    bc~& = _RGB32(60 + 12 * lev, 30 + 7 * lev, 15 + 5 * lev)
    If 2 * startr <= 1 Then
        Line (x, y)-(x2, y2), bc~&
    Else
        For i = 0 To length
            fCirc x + dx * i, y + dy * i, startr, bc~&
        Next
    End If
    If lev > 1 Then createLeaf x2, y2
    If .8 * startr < .1 Or lev > stopLev Or length < 3 Then Exit Sub
    lev = lev + 1
    branch x2, y2, .8 * startr, angD + 22 + rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
    branch x2, y2, .8 * startr, angD - 22 - rand&(-10, 19), rand&(.75 * length, .9 * length), lev, stopLev
End Sub

Sub fCirc (CX As Long, CY As Long, R As Long, c As _Unsigned 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), c, 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), c, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), c, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), c, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), c, BF
    Wend
End Sub

Sub createLeaf (x, y)
    Dim sp, xoff, yoff, woff, hoff
    sp = 15
    xoff = x + Rnd * sp - Rnd * sp
    yoff = y + Rnd * sp - Rnd * sp
    woff = 3 + Rnd * 3
    hoff = 3 + Rnd * 3
    totalLeaves = totalLeaves + 1
    If totalLeaves > UBound(leaf) Then ReDim _Preserve leaf(1 To UBound(leaf) + 5000) As new_Leaf
    leaf(totalLeaves).x = xoff
    leaf(totalLeaves).y = yoff
    leaf(totalLeaves).w = woff
    leaf(totalLeaves).h = hoff
    leaf(totalLeaves).c = _RGB32(rand&(100, 250), rand&(50, 255), rand&(0, 40))
    If Rnd < .5 Then leaf(totalLeaves).rx = -2 Else leaf(totalLeaves).rx = 2
    If Rnd < .5 Then leaf(totalLeaves).ry = -1 Else leaf(totalLeaves).ry = 1
End Sub

Sub moveLeaf (idx As new_Leaf)

    If idx.isFree Then 'leaves falling
        If idx.y < horizon Then ' above ground
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
        Else ' below hor  and falling
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y >= horizon Then ' dont stop on tree trunk

                ' QBJS doesn't like point  it's OK it wasn't working very well anyway
                'If Point(idx.x, idx.y) <> TreeTrunkClr Then
                '    If Point(idx.x + idx.w, idx.y + idx.h) <> TreeTrunkClr Then
                '        If Point(idx.x + .5 * idx.w, idx.y + .5 * idx.h) <> TreeTrunkClr Then

                idx.isFree = 0

                '        End If
                '    End If
                'End If

            End If
        End If

        idx.xacc = idx.xacc + wind
        idx.xvel = idx.xvel + idx.xacc
        idx.x = idx.x + idx.xvel
        If Rnd <= .1 Then idx.x = idx.x + idx.ry: idx.rx = -idx.rx
        If Rnd <= .1 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry

    Else
        'leaves waving in their branch
        If idx.y < horizon Then
            If Rnd <= .02 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            If Rnd <= .02 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry

        Else 'leaves are on ground but can move too  down and to right only
            If Rnd <= .025 Then idx.x = idx.x + 1
            If Rnd <= .0025 Then idx.y = idx.y + 1

            ' QBJS doesn't like Point  it wasn't working very well anyway
            'If Point(idx.x + 1, idx.y) <> TreeTrunkClr Then
            '    If Point(idx.x + 1 + idx.w, idx.y + idx.h) <> TreeTrunkClr Then
            '        If Point(idx.x + 1 + .5 * idx.w, idx.y + .5 * idx.h) <> TreeTrunkClr Then
            '            idx.isFree = 0
            '        End If
            '    End If
            'End If

        End If
    End If
End Sub

Sub allFree
    Dim i&
    For i& = 1 To totalLeaves
        leaf(i&).isFree = -1
    Next
End Sub

Sub letLeafGo
    Dim which&, i&
    For i& = 1 To 5
        which& = rand&(1, totalLeaves)
        If which& < 1 Then which& = 1
        If which& > totalLeaves Then which& = totalLeaves
        leaf(which&).isFree = -1
    Next
End Sub

Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub

Function rand& (lo%, hi%)
    rand& = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function

Sub drawLandscape
    'needs midInk, rand&

    Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
    Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
    Dim lastx As Single, X As Long
    'the sky
    For i = 0 To ymx
        midInk 150, 150, 220, 255, 255, 255, i / ymx
        Line (0, i)-(xmx, i)
    Next
    'the land
    startH = ymx - 200
    rr = 125: gg = 140: bb = 120
    For mountain = 1 To 4
        Xright = 0
        y = startH
        While Xright < xmx
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (Rnd * .8 - .35) * (mountain * .5)
            range = Xright + rand(15, 25) * 2.5 / mountain
            lastx = Xright - 1
            For X = Xright To range
                y = y + upDown
                Color _RGB(rr, gg, bb)
                Line (lastx, y)-(X, ymx), , BF 'just lines weren't filling right
                lastx = X
            Next
            Xright = range
        Wend
        rr = rand&(rr + 65, rr): gg = rand&(gg + 45, gg): bb = rand&(bb - 25, bb)
        If rr < 0 Then rr = 0
        If gg < 0 Then gg = 0
        If bb < 0 Then bb = 0
        startH = startH + rand&(5, 20)
    Next
End Sub

Sub FPrint (s$, PA$(), x%, y%, scale%, spacing%, colr~&)
    ' s$ is string to "print" out
    ' PA$() is the array of string holding the font THE SQUARE pattern (must be NxN pattern)
    ' x, y top, left corner of print just like _PrintString
    ' scale is multiplier of pixeled font at NxN so now is Scale * N x Scale * N
    ' spacing is amount of pixels * scale between letters
    ' color~& type allows up to _RGB32() colors
    Dim As Integer ls, l, a, sq, r, c, i, digi
    Dim As Long frame
    Dim d$

    ls = Len(s$)
    For l = 1 To ls
        a = Asc(s$, l)
        If Len(PA$(a)) Then ' do we have a pattern
            sq = Sqr(Len(PA$(a)))
            'Print Chr$(a), sq  'debug
            For digi = 1 To 9
                d$ = _Trim$(Str$(digi))
                For r = 0 To sq - 1 ' row and col of letter block
                    For c = 0 To sq - 1
                        i = (r * sq) + c + 1
                        $If WEB Then
                                i = i + 1
                        $End If
                        If Mid$(PA$(a), i, 1) = d$ Then
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% + 4, y% + r * scale% + 4)-Step(scale% - 1, scale% - 1), &HFF000000, BF
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale% - 1, y% + r * scale% - 1)-Step(scale% - 1, scale% - 1), &HFFFFFFFF, BF
                            Line (x% + ((l - 1) * (sq + spacing%) + c) * scale%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
                            frame = frame + 1
                            If frame >= stopFrame Then
                                stopFrame = stopFrame + 1
                                Exit Sub
                            End If
                        End If
                    Next
                Next
            Next
        End If
    Next
    FontFlag = FontFlag + 1
    ' _Title Str$(FontFlag) ' checking how long it needs to cycle after letters are complete
End Sub

Sub LoadPatterns9x9 (SPattern() As String)
    Dim As Integer a
    a = Asc("S")
    SPattern(a) = SPattern(a) + "..111111."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "..3......"
    SPattern(a) = SPattern(a) + "...333..."
    SPattern(a) = SPattern(a) + "......4.."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + ".......4."
    SPattern(a) = SPattern(a) + "5555555.."
    a = Asc("T")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    a = Asc("A")
    SPattern(a) = SPattern(a) + "...133..."
    SPattern(a) = SPattern(a) + "..1...3.."
    SPattern(a) = SPattern(a) + "..1...3.."
    SPattern(a) = SPattern(a) + ".1.....3."
    SPattern(a) = SPattern(a) + ".1222223."
    SPattern(a) = SPattern(a) + ".1.....3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    a = Asc("F")
    SPattern(a) = SPattern(a) + "122222222"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("I")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "....2...."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("G")
    SPattern(a) = SPattern(a) + ".1111111."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2....4444"
    SPattern(a) = SPattern(a) + "2.......5"
    SPattern(a) = SPattern(a) + "2......35"
    SPattern(a) = SPattern(a) + "2.....3.5"
    SPattern(a) = SPattern(a) + ".33333..5"
    a = Asc("Q")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2....5..4"
    SPattern(a) = SPattern(a) + "2.....5.4"
    SPattern(a) = SPattern(a) + ".2....55."
    SPattern(a) = SPattern(a) + "..33333.5"
    a = Asc("O")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("D")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1444444.."

    a = Asc("6")
    SPattern(a) = SPattern(a) + "..11111.."
    SPattern(a) = SPattern(a) + ".2......."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2.444444."
    SPattern(a) = SPattern(a) + "24......4"
    SPattern(a) = SPattern(a) + "2.......4"
    SPattern(a) = SPattern(a) + ".2.....4."
    SPattern(a) = SPattern(a) + "..33333.."
    a = Asc("H")
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "133333332"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    a = Asc("4")
    SPattern(a) = SPattern(a) + "...1....3"
    SPattern(a) = SPattern(a) + "..1.....3"
    SPattern(a) = SPattern(a) + ".1......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "122222223"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"
    SPattern(a) = SPattern(a) + "........3"

    a = Asc("E")
    SPattern(a) = SPattern(a) + "111111111"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2444444.."
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "2........"
    SPattern(a) = SPattern(a) + "233333333"
    a = Asc("N")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "12......3"
    SPattern(a) = SPattern(a) + "1.2.....3"
    SPattern(a) = SPattern(a) + "1..2....3"
    SPattern(a) = SPattern(a) + "1...2...3"
    SPattern(a) = SPattern(a) + "1....2..3"
    SPattern(a) = SPattern(a) + "1.....2.3"
    SPattern(a) = SPattern(a) + "1......23"
    SPattern(a) = SPattern(a) + "1.......3"
    a = Asc("B")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1......3."
    SPattern(a) = SPattern(a) + "1333333.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1444444.."
    a = Asc("L")
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "122222222"
    a = Asc("U")
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + "1.......3"
    SPattern(a) = SPattern(a) + ".2222222."
    a = Asc("P")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    SPattern(a) = SPattern(a) + "1........"
    a = Asc("R")
    SPattern(a) = SPattern(a) + "1222222.."
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1......2."
    SPattern(a) = SPattern(a) + "1333332.."
    SPattern(a) = SPattern(a) + "1.....4.."
    SPattern(a) = SPattern(a) + "1......4."
    SPattern(a) = SPattern(a) + "1.......4"
    SPattern(a) = SPattern(a) + "1.......4"
End Sub