OK here is our Fall Banner
QB64PE FALL EDITION
The following is just the still shot (partial because my screen is not 1400 wide)
Works in QB64pe too:
Surprised the Circle Fill routine works without the QBJS fix in it.
QB64PE FALL EDITION
The following is just the still shot (partial because my screen is not 1400 wide)
Works in QB64pe too:
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
'now for full viewing enjoyment
'xmx = xmax : ymx = ymax
Const xmx = 1400
Const 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
Surprised the Circle Fill routine works without the QBJS fix in it.
b = b + ...