Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
QBJS need help again with banner
#1
@dbox 

I have it working finally in QB64 but QBJS doesn't like something, no clue what it is this time.
Code: (Select All)
'Option _Explicit
'_Title "Fall Foliage Banner"
' 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.

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

Const gravity = .003
Dim Shared totalLeaves As Long
Dim Shared horizon
Dim Shared wind

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 = 970 ' for banner
ymx = 256
Screen _NewImage(xmx, ymx, 32)

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

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

    wind = Rnd / 300

    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)
        lien 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)
    For i = 1 To trees
        y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
        r = .01 * y: h = rand&(y * .15, y * .18)
        branch rand&(0, xmx - 200), y, r, 90, h, 0
    Next
    _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
    FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00, 1
    _Display
    If scene < -1 Then _FreeImage scene
    scene = _CopyImage(0)
    tim = Timer(.01)
    'Animate scene:
    While (Timer(.01) < tim + 45) Or (tim > Timer(.01))
        _PutImage , scene
        letLeafGo
        For i = 1 To totalLeaves
            moveLeaf leaf(i)
            drawLeaf leaf(i)
        Next
        _PutImage (xmx - 150, 80)-(xmx - 20, 210), Logo, 0
        FPrint "QB64PE FALL EDITION", spattern$(), 12, 20, 5, 1, &HFFAAFF00, 0

        _Display
        _Limit 60
    Wend
Wend

Sub branch (xx, yy, startrr, angDD, lengthh, levv)
    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(30 + 24 * lev, 15 + 12 * lev, 5 + 8 * lev)
    For i = 0 To length
        fCirc x + dx * i, y + dy * i, startr, bc~&
    Next
    If lev > 1 Then createLeaf x2, y2
    If .8 * startr < .1 Or lev > 7 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
    branch x2, y2, .8 * startr, angD - 22 - rand&(-10, 19), rand&(.75 * length, .9 * length), lev
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 fRect (x1, y1, x2, y2, c&)
    Line (x1, y1)-(x2, y2), c&, BF
End Sub

Sub fRectStep (x1, y1, x2, y2)
    Line (x1, y1)-Step(x2, y2), , BF
End Sub

Sub lien (x1, y1, x2, y2)
    Line (x1, y1)-(x2, y2)
End Sub

Sub createLeaf (x, y)
    Dim sp, leafs, n, xoff, yoff, woff, hoff
    sp = 15: leafs = rand&(0, 2)
    For n = 1 To leafs
        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&(50, 250), rand&(25, 255), rand&(0, 40))
    Next
End Sub

Sub moveLeaf (idx As new_Leaf)
    If idx.isFree Then
        'leaves falling
        If idx.y < horizon Then
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
        Else
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y >= horizon Then idx.isFree = 0
        End If

        idx.xacc = idx.xacc + wind
        idx.xvel = idx.xvel + idx.xacc
        idx.x = idx.x + idx.xvel
    Else
        'leaves waving in their branch
        If idx.y < horizon Then
            If idx.randomMove = 1 Then
                idx.randomMove = -1
            Else
                idx.randomMove = 1
            End If
            If Rnd <= .1 Then idx.x = idx.x + idx.randomMove
            If Rnd <= .1 Then idx.y = idx.y + idx.randomMove
        End If
    End If
End Sub

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

Sub letLeafGo
    Static lastLeaf As Single
    Dim which&
    If Timer - lastLeaf > .005 Then
        which& = rand&(1, totalLeaves)
        If which& < 1 Then which& = 1
        If which& > totalLeaves Then which& = totalLeaves
        leaf(which&).isFree = -1
        lastLeaf = Timer
    End If
End Sub

Sub drawLeaf (idx As new_Leaf)
    Color idx.c
    fRectStep idx.x, idx.y, idx.w, idx.h
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~&, pause)
    ' 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 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
                            If pause Then _Delay .04: _Display
                        End If
                    Next
                Next
            Next
        End If
    Next
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) + "...122..."
    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.....2."
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    SPattern(a) = SPattern(a) + "1.......2"
    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) + "..22222.."
    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) + "..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....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) + "........2"
    SPattern(a) = SPattern(a) + "........2"
    SPattern(a) = SPattern(a) + "........2"
    SPattern(a) = SPattern(a) + "........2"

    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
b = b + ...
Reply
#2
Wow, this is very nice @bplus!  The falling leaves are very cool.

All I had to do to get it working was to change the static variable in the letLeafGo to be a global shared one.  Static variables are not supported in the current version but will be in the next.

Reply
#3
Oh man! I thought I got all the Statics out of the Subs. Oh well...

Thank you again @dbox!
b = b + ...
Reply
#4
Beautiful work @bplus - can we try too? lol. You set the bar very high!
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#5
What a beautiful banner b. Has me reaching for my 3d glasses to pile some fallen leaves and have my avatar jump in them.
Reply
#6
(09-01-2023, 07:02 PM)grymmjack Wrote: Beautiful work @bplus - can we try too? lol. You set the bar very high!

Yeah go for it!  heh-heh
Plus you can practice posting banners at forum with QBJS so no surprises when one is selected.

I am just tweaking numbers now. Trying with symmetric logo's again, sorry KP ;-))
b = b + ...
Reply
#7
Reply
#8
Thumbs Up 
Nice scroller, throw some QB64 Logo's on those buildings ;-))
b = b + ...
Reply
#9
I knew this was possible in QuickBASIC, but QBJS is taking things to a new dimension! (No pun intended.)

I would have liked Heitor to finish "his" game that was similar to this. Even for one level. Tongue
Reply
#10
(09-01-2023, 08:52 PM)bplus Wrote: Nice scroller, throw some QB64 Logo's on those buildings ;-))
Sure thing, here you go:

Reply




Users browsing this thread: 1 Guest(s)