Fall Banner Contest?

[bplus]

@dbox I think I got this right, but please check my work!

You could also use _ResizeWidth and _ResizeHeight to get the size of the current canvas before you call Screen without the need to Import the web library...

That does not seem to resize to fit the content to the IFRAME though, like without scroll bars, etc.

Yeah the resize thing is funky! But this works from grymmjack:

Code: (Select All)

'Option _Explicit
'_Title "Fall Foliage 2017-10-21 by bplus"
'fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
'test landscape and portrait views for Android
'xmx = min(xmax, 400) : ymx = min(700, ymax) 'portrait
'OK it's just plain better in landscape view

' 2023-08-30 start of QBJS Banner

$If WEB Then
        Import Dom From "lib/web/dom.bas"
        Dom.GetImage(0).style.width = "700px"
        Dom.GetImage(0).style.height = "128px"
        Dom.Container().style.width = "700px"
        Dom.Container().style.height = "128px"
        Dom.Container().style.overflow = "hidden"
$End If

'now for full viewing enjoyment
'xmx = xmax : ymx = ymax
Dim Shared xmx, ymx
xmx = 1400
ymx = 256

Screen _NewImage(xmx, ymx, 32)
Dim spattern$(0 To 255)
LoadPatterns9x9 spattern$()
Dim n, horizon, i, trees, y, r, h
'_ScreenMove 100, 20 'adjust as needed _MIDDLE needs a delay .5 or more for me

n = 3
While 1
    If n < 15 Then n = n + 3
    horizon = rand%(.8 * ymx, .9 * ymx)
    For i = 0 To horizon
        midInk 0, 0, 128, 10, 120, 128, i / horizon
        lien 0, i, xmx, i
    Next
    For i = horizon To ymx
        midInk 70, 108, 30, 60, 10, 5, (i - horizon) / (ymx - horizon)
        lien 0, i, xmx, i
    Next
    For i = 1 To xmx * ymx * .00018
        leaf rand%(0, xmx), rand%(horizon * 1.002, ymx)
    Next
    If n < .01 * xmx Then trees = n Else trees = rand%(.002 * xmx, .03 * xmx)
    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%(10, xmx - 10), y, r, 90, h, 0
    Next
    FPrint "QB64PE FALL EDITION", spattern$(), 80, 10, 6, 2, &HFFFFFFFF
    Sleep 10
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& = _RGB(30 + 6 * lev, 15 + 3 * lev, 5 + 2 * lev)
    For i = 0 To length
        Color bc&
        fCirc x + dx * i, y + dy * i, startr
    Next
    If lev > 1 Then leaf 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

'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 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 leaf (x, y)
    Dim sp, leafs, n, xoff, yoff, woff, hoff
    sp = 15: leafs = rand%(xmx * ymx * .00001, xmx * ymx * .00002)
    For n = 1 To leafs
        Color _RGB(rand%(50, 250), rand%(25, 255), rand%(0, 40))
        xoff = x + Rnd * sp - Rnd * sp
        yoff = y + Rnd * sp - Rnd * sp
        woff = 3 + Rnd * 3
        hoff = 3 + Rnd * 3
        fRectStep xoff, yoff, woff, hoff
    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 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 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%, y% + r * scale%)-Step(scale% - 1, scale% - 1), colr~&, BF
                            _Delay .04
                        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) + ".2222222."
    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) + ".3333333."
    a = Asc("G")
    SPattern(a) = SPattern(a) + ".11111111"
    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

But my question is: Will that mini QBJS version in QBJS work for the banner? I guess that question goes to @grymmjack because he is the one who needs to get it working in server. Also I am not understanding what was wrong with original Const xmx, ymx at 1400, 256? It won't fit my screen but I can move the screen around in both QB64 and QBJS to see all of it.

PS I really want to work code out in QB64 editor and test code there first but the $IF WEB ... works for me too.