QBJS Color Problem (Solved!)

[bplus]

@dbox another QB64 to QBJS translation problem.

In attempts to fix the ellipse drawing in QBJS I had to use QBJS ellipse sub because QBJS was messing up my own in QB64.

I WAS using Color statement to change color for drawing triangles in this code:

Code: (Select All)

Option _Explicit

'_Title "Fall Foliage Banner Move Leaves" ' work file for updating

' 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



' 2023-09-05A fix wind and make (less) leaves more responsive to wind

' 2023-09-05 1:40P added pumpkin but cheeky in QBJS



' 2023-09-06 add ships



' 2023-09-07 another attempt to fix ellipse drawing in pumpkin with QBJS

' remove ships, QNJS having a problem with that too!

' to use the damn ellipse draw function in QBJS because it screws up mine in QB64

' chaneg color and everything drawn with it old color is changed too



$If WEB Then

        Import G2D From "lib/graphics/2d.bas"

$End If



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

    yacc 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 sx





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, windChange, pumpkinImage, lp, pr, d

Dim gust

pr = 100

While 1

    'Draw scene:

    ReDim Shared leaf(30000) As new_Leaf

    totalLeaves = 0

    stopFrame = 0

    FontFlag = 0

    windChange = 1

    gust = .01



    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 300 'less of these at start, as they'll grow in number anyway

        createLeaf rand&(0, xmx), rand&(horizon + 5, 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 < 2500 ' keep going more loops to drop allot of leaves allow trees to become bare

        lp = (lp + 1) Mod 10

        If lp = 1 Then

            If pumpkinImage < -1 Then _FreeImage pumpkinImage

            pumpkinImage = _NewImage(300, 200, 32)

            _Dest pumpkinImage

            sx = sx + rand&(-4, 4)

            If sx > .7 * pr / 10 Then d = -1 * d: sx = 0

            If sx < -.7 * pr / 10 Then d = -1 * d: sx = 0



            pumpkin 149, 100, pr, 2

            _Dest 0

        End If

        If wind + windChange * gust < 0 Then windChange = -windChange

        If wind + windChange * gust > 5 Then windChange = -windChange

        wind = wind + windChange * gust

        _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



        ' hey pumpkin!

        _PutImage (690, 80), pumpkinImage, 0

        ' debugging wind and changes

        '_Title "Wind:" + Str$(wind) + "  WindChange:" + Str$(windChange)



        _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

    If Rnd < .6 Then

        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 If

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 horizon  and falling time to stop

            idx.yacc = idx.yacc + 3 * gravity

            idx.yvel = idx.yvel + idx.yacc

            idx.y = idx.y + idx.yvel

            If idx.y > horizon Then ' stop leaves from going to bottom of screen

                idx.isFree = 0

            End If

        End If

        idx.x = idx.x + wind



    Else



        If idx.y < horizon Then 'leaves waving in their branch

            If Rnd <= wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx

            If Rnd <= wind / 500 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 <= wind / 500 Then ' move down wind

                idx.x = idx.x + 2

            Else

                If Rnd < wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx

            End If

            If Rnd <= wind / 500 Then ' move down wind

                idx.y = idx.y + 1

            Else

                If Rnd < wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry

            End If

        End If

    End If

End Sub



Sub letLeafGo

    Dim which&, i&

    For i& = 1 To 5

        If Rnd <= wind / 30 Then

            which& = rand&(1, totalLeaves)

            'If which& < 1 Then which& = 1

            'If which& > totalLeaves Then which& = totalLeaves

            leaf(which&).isFree = -1

        End If

    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 pumpkin (cx, cy, pr, limit)

    Dim As Long u, i

    Dim lastr, dx, tx1, tx2, tx3, ty1, ty3, ty2, ty22, sxs



    'carve this!

    fEllipse cx, cy, pr, 29 / 35 * pr, &HFFFF5500

    lastr = 2 / 7 * pr

    If limit = 2 Then

        Do

            $If WEB Then

                    G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, &HFF000000

            $Else

                ellipse cx, cy, lastr, 29 / 35 * pr, &HFF000000

            $End If

            lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr

            If pr - lastr < 1 / 80 * pr Then Exit Do

        Loop

    End If

    ' 'flickering candle light

    Color _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)



    ' eye sockets

    ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12

    ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12

    ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12

    ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12



    ' nose

    ftri cx, cy - rand&(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand&(1, 2) * pr / 12, cy + 2 * pr / 12



    ' evil grin

    ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12

    ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12



    ' moving teeth/talk/grrrr..

    u = rand&(4, 8)

    dx = pr / u

    For i = 1 To u

        tx1 = cx - 6 * pr / 12 + (i - 1) * dx

        tx2 = tx1 + .5 * dx

        tx3 = tx1 + dx

        ty1 = cy + 5 * pr / 12

        ty3 = cy + 5 * pr / 12

        ty2 = cy + (4 - Rnd) * pr / 12

        ty22 = cy + (6 + Rnd) * pr / 12

        ftri tx1, ty1, tx2, ty2, tx3, ty3

        ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3

    Next

    If limit Then



        'shifty eyes

        If limit = 2 Then sxs = sx Else sxs = .1 * sx

        pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)

        pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)

    End If

End Sub



'Andy Amaya's triangle fill modified for QB64, use if color already set

Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3)

    Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single

    Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single

    Dim slope3 As Single

    'make copies before swapping

    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3



    '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) / length

        For x = 0 To length

            Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1))

            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) / length

        For x = 0 To length

            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



Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)

    Dim scale As Single, x As Long, y As Long

    scale = yRadius / xRadius

    Line (CX, CY - yRadius)-(CX, CY + yRadius), c, BF

    For x = 1 To xRadius

        y = scale * Sqr(xRadius * xRadius - x * x)

        Line (CX + x, CY - y)-(CX + x, CY + y), c

        Line (CX - x, CY - y)-(CX - x, CY + y), c

    Next

End Sub



Sub drawShip (x, y, scale, ls, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30

    Dim light As Long, r As Long, g As Long, b As Long

    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)

    fEllipse x, y, 6 * scale, 15 * scale, _RGB32(r, g - 120, b - 100)

    fEllipse x, y, 18 * scale, 11 * scale, _RGB32(r, g - 60, b - 50)

    fEllipse x, y, 30 * scale, 7 * scale, _RGB32(r, g, b)

    For light = 0 To 5

        fCirc x - 30 * scale + 11 * scale * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)

    Next

    ls = ls + 1

    If ls > 5 Then ls = 0

End Sub



Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)

    Dim scale As Single, xs As Single, x As Single, y As Single

    Dim lastx As Single, lasty As Single

    scale = yRadius / xRadius: xs = xRadius * xRadius

    PSet (CX, CY - yRadius), c: PSet (CX, CY + yRadius), c

    lastx = 0: lasty = yRadius

    For x = 0 To xRadius

        y = scale * Sqr(xs - x * x)

        $If WEB Then

                y = y + 1

        $End If



        Line (CX + lastx, CY - lasty)-(CX + x, CY - y), c

        Line (CX + lastx, CY + lasty)-(CX + x, CY + y), c

        Line (CX - lastx, CY - lasty)-(CX - x, CY - y), c

        Line (CX - lastx, CY + lasty)-(CX - x, CY + y), c



        lastx = x: lasty = y

    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) + "...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

BUT QBJS starts changing the color of the ellipse line in the pumpkin to the Color statements color value completely ignoring the color I used in ellipse call???
Its supposed to be Black and remain Black. When I change the Color value, the ellipse line changes with it. But finally the correct line shape is showing.

Color glitch using QBJS Ellipse

Getting this stupid ellipse to draw correctly is getting frustrating! I wasted so much time trying to get it working as it does in QB64.

I was able to fix it for QB64 and QBJS by adding a color parameter to fTri sub but are all the 2d graphics from QBJS going to react that way to Color changes ie using a General Color changeValue~& statement?
Or maybe just the ellipse sub?

[dbox]

Hey @blus, I think I see the problem...

The G2D.FillEllipse method takes 6 parameters:

G2D.FillEllipse x&, y&, radiusX&, radiusY& [, rotation& ][, clr~&]

The last two parameters are optional.  But if you want to specify color you should just use 0 for rotation or leave that parameter blank.

Code: (Select All)

G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, 0, &HFF000000

OR

Code: (Select All)

G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, , &HFF000000

[bplus]

Hey @blus, I think I see the problem...

The G2D.FillEllipse method takes 6 parameters:

G2D.FillEllipse x&, y&, radiusX&, radiusY& [, rotation& ][, clr~&]

The last two parameters are optional.  But if you want to specify color you should just use 0 for rotation or leave that parameter blank.

Code: (Select All)

G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, 0, &HFF000000

OR

Code: (Select All)

G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, , &HFF000000

OK thanks, but it is odd it draws the ellipse once but changes that color to Color value updated in Color statement. Could be an asset as well as a glitch.

I will try ellipse with black as 6th argument but already changed drawing with Color value ink.

Never did figure out why my own ellipse code didn't draw correctly, I tested the sub independent of all the other code and it worked fine in QBJS.

[dbox]

OK thanks, but it is odd it draws the ellipse once but changes that color to Color value updated in Color statement. Could be an asset as well as a glitch.

I'm not sure I understand where the issue is.  I tried to follow the precedent of other drawing commands in QBasic for all of the relevant G2D library drawing commands: if the optional color parameter is left blank it uses the last value set with a Color statement.  Is this not the behavior you are seeing?  Or, perhaps, not the behavior you were expecting?

[bplus]

OK thanks, but it is odd it draws the ellipse once but changes that color to Color value updated in Color statement. Could be an asset as well as a glitch.

I'm not sure I understand where the issue is.  I tried to follow the precedent of other drawing commands in QBasic for all of the relevant G2D library drawing commands: if the optional color parameter is left blank it uses the last value set with a Color statement.  Is this not the behavior you are seeing?  Or, perhaps, not the behavior you were expecting?

Hi @dbox every time I changed Color colorValue2, every ellipse drawn using Color colorVlaue1 switched to ColorValue2 as well, without any redraw. You can see it in the pumpkin lines in my last QBJS code link. The Color statement was used to change the light inside eyes, nose, mouth like a candle flicker but the ellipse lines supposed to be and remain black were switching color to same value as the Candle Light Color for eyes, nose and mouth. Update: they were being redrawn, my mistake!

I don't know maybe it was remembering the last Color change and redrawing the ellipse with that color. It wasn't black but I might have misdiagnosed what was happening. Yes I bet! it was using the last color change to redraw the ellipses. OK my bad on that.

But what was wrong with my ellipse code that QBJS couldn't complete the ellipse lines of the pumpkin and I had to resort to G2D.Ellipse in the first place. See old code in banners where I just started drawing the pumpkins. The ellipse lines would not complete along the x axis of ellipse in QBJS.
   

My ellipse code I tried all kinds of +/- 1 to get it to complete the lines

sample of attempted fix

Code: (Select All)

Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)
    Dim scale As Single, xs As Single, x As Single, y As Single
    Dim lastx As Single, lasty As Single
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius), c: PSet (CX, CY + yRadius), c
    lastx = 0: lasty = yRadius
    For x = 0 To xRadius
        y = scale * Sqr(xs - x * x)
        $If WEB Then
                y = y + 1 ' tried -1 too I think
        $End If

        Line (CX + lastx, CY - lasty)-(CX + x, CY - y), c
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y), c
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y), c
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y), c

        lastx = x: lasty = y
    Next
End Sub

[dbox]

Interesting, your ellipse method seems to work fine in qbjs:



Looking at the screenshots it looks like there were a couple of orange filled ellipses being drawn on top of the pumpkin at each cheek.

[bplus]

I took out the recursive calling of pumpkin in case some rogue extra call was being made and then even the carving, just the ellipse fill and ellipsi for pumpkin sections and still get something strange in QBJS:

Code: (Select All)

Option _Explicit
'_Title "Fall Foliage Banner Move Leaves" ' work file for updating
' 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

' 2023-09-05A fix wind and make (less) leaves more responsive to wind
' 2023-09-05 1:40P added pumpkin but cheeky in QBJS

' 2023-09-06 add ships

' 2023-09-07 another attempt to fix ellipse drawing in pumpkin with QBJS
' remove ships.
' To use the  2d ellipse draw function in QBJS because it screws up my QB64
' change color and everything drawn with it old color is changed too.
' Fixed my fTri function with a Color parameter.

$If WEB Then
        Import G2D From "lib/graphics/2d.bas"
$End If

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
    yacc 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 sx


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, windChange, pumpkinImage, lp, pr, d
Dim gust
pr = 100
While 1
    'Draw scene:
    ReDim Shared leaf(30000) As new_Leaf
    totalLeaves = 0
    stopFrame = 0
    FontFlag = 0
    windChange = 1
    gust = .01

    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 300 'less of these at start, as they'll grow in number anyway
        createLeaf rand&(0, xmx), rand&(horizon + 5, 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 < 2500 ' keep going more loops to drop allot of leaves allow trees to become bare
        lp = (lp + 1) Mod 10
        If lp = 1 Then
            If pumpkinImage < -1 Then _FreeImage pumpkinImage
            pumpkinImage = _NewImage(300, 200, 32)
            _Dest pumpkinImage
            sx = sx + rand&(-4, 4)
            If sx > .7 * pr / 10 Then d = -1 * d: sx = 0
            If sx < -.7 * pr / 10 Then d = -1 * d: sx = 0

            pumpkin 149, 100, pr, 2
            _Dest 0
        End If
        If wind + windChange * gust < 0 Then windChange = -windChange
        If wind + windChange * gust > 5 Then windChange = -windChange
        wind = wind + windChange * gust
        _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

        ' hey pumpkin!
        _PutImage (690, 80), pumpkinImage, 0
        ' debugging wind and changes
        '_Title "Wind:" + Str$(wind) + "  WindChange:" + Str$(windChange)

        _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
    If Rnd < .6 Then
        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 If
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 horizon  and falling time to stop
            idx.yacc = idx.yacc + 3 * gravity
            idx.yvel = idx.yvel + idx.yacc
            idx.y = idx.y + idx.yvel
            If idx.y > horizon Then ' stop leaves from going to bottom of screen
                idx.isFree = 0
            End If
        End If
        idx.x = idx.x + wind

    Else

        If idx.y < horizon Then 'leaves waving in their branch
            If Rnd <= wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            If Rnd <= wind / 500 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 <= wind / 500 Then ' move down wind
                idx.x = idx.x + 2
            Else
                If Rnd < wind / 500 Then idx.x = idx.x + idx.rx: idx.rx = -idx.rx
            End If
            If Rnd <= wind / 500 Then ' move down wind
                idx.y = idx.y + 1
            Else
                If Rnd < wind / 500 Then idx.y = idx.y + idx.ry: idx.ry = -idx.ry
            End If
        End If
    End If
End Sub

Sub letLeafGo
    Dim which&, i&
    For i& = 1 To 5
        If Rnd <= wind / 30 Then
            which& = rand&(1, totalLeaves)
            'If which& < 1 Then which& = 1
            'If which& > totalLeaves Then which& = totalLeaves
            leaf(which&).isFree = -1
        End If
    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 pumpkin (cx, cy, pr, limit As Integer)
    Dim As Long u, i
    Dim lastr, dx, tx1, tx2, tx3, ty1, ty3, ty2, ty22, sxs
    Dim c As _Unsigned Long
    If limit = 0 Then Exit Sub
    'carve this!
    fEllipse cx, cy, pr, 29 / 35 * pr, &HFFFF5500 ' fill ellipse called with color
    lastr = 2 / 7 * pr
    If limit = 2 Then
        Do
            ' $If WEB Then
            ' G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, 0, &HFF000000
            ' $Else
            ellipse cx, cy, lastr, 29 / 35 * pr, &HFF000000
            ' $End If
            lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
            If pr - lastr < 1 / 80 * pr Then Exit Do
        Loop
    End If
    '' 'flickering candle light
    'c = _RGB(Rnd * 55 + 200, Rnd * 55 + 200, 120)

    '' eye sockets
    'ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, c
    'ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12, c
    'ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, c
    'ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12, c

    '' nose
    'ftri cx, cy - rand&(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand&(1, 2) * pr / 12, cy + 2 * pr / 12, c

    '' evil grin
    'ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12, c
    'ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12, c

    '' moving teeth/talk/grrrr..
    'u = rand&(4, 8)
    'dx = pr / u
    'For i = 1 To u
    '    tx1 = cx - 6 * pr / 12 + (i - 1) * dx
    '    tx2 = tx1 + .5 * dx
    '    tx3 = tx1 + dx
    '    ty1 = cy + 5 * pr / 12
    '    ty3 = cy + 5 * pr / 12
    '    ty2 = cy + (4 - Rnd) * pr / 12
    '    ty22 = cy + (6 + Rnd) * pr / 12
    '    ftri tx1, ty1, tx2, ty2, tx3, ty3, c
    '    ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3, c
    'Next
    'If limit = 2 Then
    '    sxs = sx
    '    pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    '    pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, Int(limit - 1)
    'End If
End Sub

'Andy Amaya's triangle fill modified for QB64, use if color already set
Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3, c As _Unsigned Long)
    Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
    Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single
    Dim slope3 As Single
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3

    '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) / length
        For x = 0 To length
            Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1)), c
            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) / length
        For x = 0 To length
            If Int(x + x2) <> lastx% Then
                Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2)), c
            End If
        Next
    End If
End Sub

Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)
    Dim scale As Single, x As Long, y As Long
    scale = yRadius / xRadius
    Line (CX, CY - yRadius)-(CX, CY + yRadius), c, BF
    For x = 1 To xRadius
        y = scale * Sqr(xRadius * xRadius - x * x)
        Line (CX + x, CY - y)-(CX + x, CY + y), c
        Line (CX - x, CY - y)-(CX - x, CY + y), c
    Next
End Sub

Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)
    Dim scale As Single, xs As Single, x As Single, y As Single
    Dim lastx As Single, lasty As Single
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSet (CX, CY - yRadius), c: PSet (CX, CY + yRadius), c
    lastx = 0: lasty = yRadius
    For x = 0 To xRadius
        y = scale * Sqr(xs - x * x)
        Line (CX + lastx, CY - lasty)-(CX + x, CY - y), c
        Line (CX + lastx, CY + lasty)-(CX + x, CY + y), c
        Line (CX - lastx, CY - lasty)-(CX - x, CY - y), c
        Line (CX - lastx, CY + lasty)-(CX - x, CY + y), c
        lastx = x: lasty = y
    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) + "...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

ellipse code bug in QBJS

[mnrvovrfc]

THEIRS:

Code: (Select All)

G2D.Ellipse cx, cy, lastr, 29 / 35 * pr, 0, &HFF000000

YOURS:

Code: (Select All)

ellipse cx, cy, lastr, 29 / 35 * pr, &HFF000000

You're still missing one parameter before 32-bit color which is last.

Your sub headers to draw ellipse:

Code: (Select All)

Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)

Sub ellipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long, c As _Unsigned Long)

As dbox already said, you need "rotation" before "color" parameter.

[dbox]

I took out the recursive calling of pumpkin in case some rogue extra call was being made and then even the carving, just the ellipse fill and ellipsi for pumpkin sections and still get something strange in QBJS

Aha! I see the issue.  QBJS is not doing implicit rounding when passing a floating point number to a method parameter that has an integer type.  I'll put this on the fix list for the next release.  In the meantime, you could use a workaround like this:

[bplus]

Ah @dbox thankyou once again.

I found a solution using G2D.Ellipse but glad this mystery is solved. It has nagged at me since first encountered.