https://basicanywheremachine-news.blogsp...chart.html

@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:

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

I want to use a C-Library together with QB64.
This works fine with number types as parameters.
But is this possible with strings (in C I have to use an array, I know!) and if yes, how ?

In the Help or Wiki of QB64 there is written (chapter "DECLARE LIBRARY"):

"Parameters used by the Library procedure must be passed by value (BYVAL) except for STRING characters."

https://www.reddit.com/r/BASICAnywhereMa...hart_demo/

Here's a little image exploding effect.  Not the best routine for sure, but it was a fun diversion tonight making this.  I got the pixel exploding method idea from some old Qbasic code.  The Image explodes, sending all pixels flying away, and the screen fades out.  For a sample image the demo is using the QB64 built-in ICON, but you can use any small image.  It would be easy to adapt this to grab an area of the current screen instead, and not even give the SUB and image handle.
 
- Dav 

'================

'EXPLODEIMAGE.BAS

'================

'Explodes a small image on the screen, fading out screen.

'It does this loading all image pixel data into arrays,

'and changing the x/y position of pixels on the screen.

'Alpha transparecy is used for screen fading effect.

'Tested & Working under Windows/Linux QB64-PE 3.8.0.

'Coded by Dav, SEP/2023





_ICON 'NEED THIS. Using Phoenix ICON in this example as the image



RANDOMIZE TIMER



SCREEN _NEWIMAGE(800, 600, 32)



'Get a bird& image from the built-in ICON

bird& = _NEWIMAGE(192, 192, 32): _DEST bird&

_PUTIMAGE (0, 0)-(192, 192), -11: _DEST 0



'draw a background for to show fading better

FOR x = 1 TO _WIDTH STEP 20

    FOR y = 1 TO _HEIGHT STEP 20

        LINE (x, y)-STEP(10, 10), _RGBA(RND * 255, RND * 255, RND * 255, RND * 255), BF

    NEXT

NEXT



'compute center spot for placing image on screen

cx = _WIDTH / 2 - (_WIDTH(bird&) / 2) 'x center image on screen

cy = _HEIGHT / 2 - (_HEIGHT(bird&) / 2) 'y center image on screen



'Show and Explode the image

ExplodeImage bird&, cx, cy



END



SUB ExplodeImage (image&, x, y)



    _PUTIMAGE (x, y), image&

    PRINT "Press any key to Explode the image..."

    _DISPLAY

    SLEEP



    pixels& = _WIDTH(image&) * _HEIGHT(image&)



    REDIM PixX(pixels&), PixY(pixels&)

    REDIM PixXDir(pixels&), PixYDir(pixels&)

    REDIM PixClr&(pixels&)



    'Read all pixels from image& into arrays,

    'and generate x/y movement values

    _SOURCE image&

    pix& = 0

    FOR x2 = 0 TO _WIDTH(image&) - 1

        FOR y2 = 0 TO _HEIGHT(image&) - 1

            PixClr&(pix&) = POINT(x2, y2) 'pixel color

            PixX(pix&) = x + x2 'pixel x pos

            PixY(pix&) = y + y2 'pixel y pos

            'generate random x/y dir movement values

            DO

                'assign a random x/y dir value (from range -8 to 8)

                PixXDir(pix&) = RND * 8 - RND * 8 'go random +/- x pixels

                PixYDir(pix&) = RND * 8 - RND * 8 'go random +/- y pixels

                'Keep looping until both directions have non-zero values

                IF PixXDir(pix&) <> 0 AND PixYDir(pix&) <> 0 THEN EXIT DO

            LOOP

            pix& = pix& + 1 'goto next pixels

        NEXT

    NEXT

    _SOURCE 0



    'Explode image and Fade out screen

    FOR alpha = 0 TO 225 STEP .8

        'display all pixels

        FOR pix& = 0 TO pixels& - 1

            'pixel x pos, +/- dir value

            PixX(pix&) = PixX(pix&) + PixXDir(pix&)

            'pixel y pos, +/- dir value

            PixY(pix&) = PixY(pix&) + PixYDir(pix&)

            PSET (PixX(pix&), PixY(pix&)), PixClr&(pix&)

        NEXT

        'the fade out trick

        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, alpha), BF

        _LIMIT 30

        _DISPLAY

    NEXT



END SUB

handy template for quickly testing useful math functions

WIP: I added automatic resizing to window, and I want to add some kind of mouse drag and wheel zoom some time later as well as make it fast

OK much better! I got the leaves falling while the Title is printing out plus it looks like strong wind is blowing them off.

Fall Banner 2023 bplus WIP

I'm going to post this program here for not having anything else better to offer. It's a silly sound generator that exports to wave and supports crude wavetable synthesis. This program should also work in the older QB64, down to v0.98.

Because the size of attachments could be limited by this forum, and because with my online connection, upload is very slow, I have cut all wave files in half of what they were originally. The "scan1.wav" and "scan2.wav" are exactly 12 seconds long, and "scan3.wav" is eight seconds long, this will make it easier to use offsets if that makes any sense for something that is nowhere near acoustic drum rhythms. You could supply your own but they have to have the names "scan1.wav" to "scan6.wav" for this program. Keep the samples as short as possible, not much longer than 12 seconds. If you choose a power of 2 as the length it becomes easy to create wavetable messes at 120 beats per minute.

The wave files to be used with this program must be 44100Hz 16-bit mono (one channel). It saves in that format. It cannot handle any other format.

The format of "wavesa.txt" is:
one section has "functions" which are explained in the other documentation file.
the "===" separator.
the second section which recalls the "functions" by line number.

It's recommended the "wavesa.txt" file is 1000 lines or less.

I show the source code for the program here but please read the documentation.

'by mnrvovrfc 2020/10/10

'fixed on 2023/9/3 so it works on QB64PE, and on Linux as well as Windows

_DEFINE A-Z AS LONG



TYPE wavetypehead

    ariff AS STRING * 4

    num1 AS LONG

    wavefmt AS STRING * 8

    junk AS STRING * 20

    adata AS STRING * 4

    num2 AS LONG

END TYPE



DIM bufi(1 TO 6, 1 TO 1323000) AS INTEGER, bufs(1 TO 6)

DIM ss(1 TO 1000) AS STRING

DIM wh AS wavetypehead

DIM goahead AS _BIT, usetan AS _BIT, sampvolu AS _BIT, quadruple AS _BIT, multbefore AS _BIT

DIM loadscan AS _BIT, dcdc AS INTEGER

DIM xx AS SINGLE, yy AS SINGLE, torad AS SINGLE, volu AS SINGLE, twopi AS SINGLE, etarpmas AS SINGLE



wavefilehead$ = "RIFF    WAVEfmt " + chrn$(16000101068, 2, 1, 1, 1, 1, 1, 1, 1, 2)_

+ chrn$(17200136881020, 3, 1, 1, 3, 2, 1, 1, 1, 1) + chr$(16) + chr$(0) + "data"

torad = 4 * ATN(1)

twopi = torad * 2

torad = torad / 180

etarpmas = 1 / 44100





FOR w = 1 TO 6

    afile$ = "scan" + CHR$(48 + w) + ".wav"

    IF NOT _FILEEXISTS(afile$) THEN

        PRINT "File NOT found: "; afile$

        GOTO pend

    END IF

NEXT

ifile$ = "wavesa.txt"

outfile$ = "wavesa-render.wav"



REDIM sc(1 TO 1) AS STRING

cycle = 360

limsec = 0

volu = 0.25

dcdc = 0

u = GetCommand(sc())

IF u > 0 THEN

    FOR w = 1 TO u

        IF INSTR(LCASE$(sc(w)), ".txt") > 0 THEN

            a$ = sc(w)

            IF _FILEEXISTS(a$) THEN

                ifile$ = a$

                PRINT "Input text filename set to:"

                PRINT ifile$

            END IF

        ELSEIF LEFT$(sc(w), 2) = "--" THEN

            a$ = LCASE$(MID$(sc(w), 3))

            IF a$ = "help" THEN

                helpme

            ELSEIF LEFT$(a$, 3) = "out" THEN

                b$ = MID$(a$, 4)

                IF INSTR(LCASE$(b$), ".wav") > 0 THEN

                    IF _FILEEXISTS(b$) THEN

                        PRINT "Cannot execute to overwrite output file."

                        PRINT b$

                        GOTO pend

                    END IF

                    outfile$ = b$

                    PRINT "Output filename set to:"

                    PRINT outfile$

                END IF

            ELSEIF LEFT$(a$, 5) = "cycle" THEN

                n = VAL(MID$(a$, 6))

                IF n < 360 THEN

                    PRINT "Cannot accept a 'cycle' less than 360!"

                ELSE

                    cycle = n

                END IF

            ELSEIF a$ = "tan" THEN

                usetan = NOT usetan

            ELSEIF a$ = "samp" THEN

                sampvolu = NOT sampvolu

            ELSEIF a$ = "quad" THEN

                quadruple = NOT quadruple

            ELSEIF a$ = "mult" THEN

                multbefore = NOT multbefore

            ELSEIF LEFT$(a$, 3) = "vol" THEN

                n = VAL(MID$(a$, 4))

                IF n < 1 THEN

                    PRINT "Volume control cannot be silence!"

                ELSEIF n > 100 THEN

                    n = 100

                END IF

                volu = n / 100

            ELSEIF LEFT$(a$, 3) = "lim" OR LEFT$(a$, 5) = "limit" THEN

                IF LEFT$(a$, 5) = "limit" THEN x = 6 ELSE x = 4

                b$ = MID$(a$, x)

                n = VAL(b$)

                IF INSTR(b$, ".") > 0 AND INT(n) >= 1 THEN

                    limsec = INT(VAL(b$) * 44100)

                ELSEIF n < 4410 THEN

                    PRINT "Output wave file must be at least 4410 samples.  Size is NOT limited."

                ELSEIF n > 1323000 THEN

                    PRINT "Provided output file size longer than 1 minute, thus it's NOT limited."

                    limsec = 0

                ELSE

                    limsec = n

                END IF

            ELSEIF LEFT$(a$, 2) = "dc" THEN

                b$ = MID$(a$, 3)

                IF LEN(b$) <= 4 THEN

                    n = VAL("&H" + b$)

                    IF n <> 0 AND limsec > 0 THEN

                        dcdc = n

                        PRINT "Requested overlaid DC offset of"; dcdc

                    END IF

                END IF

            END IF

        END IF

    NEXT

END IF

IF NOT _FILEEXISTS(ifile$) THEN

    PRINT "File NOT found: "; ifile$

    GOTO pend

END IF



brekass = 0

fi = FREEFILE

OPEN ifile$ FOR INPUT AS fi

n = 0

DO UNTIL EOF(fi)

    LINE INPUT #fi, a$

    a$ = NewTrim$(a$, 1, 1)

    IF a$ <> "" THEN

        n = n + 1

        ss(n) = a$

        IF a$ = "===" THEN brekass = n

        IF NOT loadscan THEN

            IF INSTR(a$, "+") > 0 THEN loadscan = -1

        END IF

        IF n >= 1000 THEN EXIT DO

    END IF

LOOP

CLOSE fi

IF n = 0 OR brekass < 2 OR brekass = n THEN

    PRINT "Input text file is not in the correct format!"

    GOTO pend

END IF

brekass = brekass + 1

nitems = n



IF limsec = 0 THEN

    bg = 4410

    REDIM bufo(1 TO bg) AS INTEGER

ELSE

    REDIM bufo(1 TO limsec) AS INTEGER

END IF



IF loadscan THEN

    FOR w = 1 TO 6

        afile$ = "scan" + CHR$(48 + w) + ".wav"

        goahead = 0

        fi = FREEFILE

        OPEN afile$ FOR BINARY AS fi

        GET #fi, , wh

        IF wh.ariff = "RIFF" AND wh.wavefmt = "WAVEfmt " AND wh.adata = "data" THEN

            u = wh.num2 \ 2

            IF u > 1323000 THEN

                CLOSE fi

                PRINT "Input wave file is too big to be used for this process."

                PRINT afile$

                GOTO pend

            END IF

            bufs(w) = u

            REDIM buftemp(1 TO u) AS INTEGER

            GET #fi, , buftemp()

            goahead = -1

        END IF

        CLOSE fi

        IF goahead THEN

            FOR i = 1 TO u

                bufi(w, i) = buftemp(i)

            NEXT

            ERASE buftemp

        ELSE

            PRINT "The following file could not be processed:"

            PRINT afile$

            GOTO pend

        END IF

    NEXT

ELSE

    PRINT "Warning: input wave files were NOT loaded!"

END IF



hp = 1

FOR i = brekass TO nitems

    f = VAL(ss(i))

    IF f > 0 AND f <= brekass - 2 THEN

        l = 0

        u = INSTR(ss(f), "+")

        v = 1

        IF u > 0 THEN

            IF NOT loadscan THEN

                PRINT "Something is wrong!  Input waves weren't loaded..."

                GOTO pend

            END IF

        ELSE

            u = INSTR(ss(f), "*")

            v = 2

        END IF

        IF u = 0 THEN

            u = INSTR(ss(f), "#")

            v = 4

        END IF

        IF u = 0 THEN

            u = INSTR(ss(f), "&")

            v = 5

        END IF

        IF u = 0 THEN v = 3

        SELECT CASE v

            CASE 1

                n = VAL(LEFT$(ss(f), u - 1))

                xx = VAL(MID$(ss(f), u + 1))

                m = INT(xx)

                IF n > 0 AND n < 7 AND m >= 0 AND m <= 100 THEN

                    xx = xx / 100

                    m = -1 * INT((-1 * xx) * bufs(n))

                    m = m + 1

                    FOR j = 1 TO cycle

                        IF sampvolu THEN

                            e = INT(bufi(n, m) * volu)

                        ELSE

                            e = bufi(n, m)

                        END IF

                        IF l < 20 THEN

                            bufo(hp) = INT(e * (l / 20))

                            l = l + 1

                        ELSE

                            bufo(hp) = e

                        END IF

                        m = m + 1

                        IF m > bufs(n) THEN m = 1

                        hp = hp + 1

                        IF limsec > 0 AND hp > limsec THEN EXIT FOR

                        IF limsec = 0 AND hp > bg THEN GOSUB realloc

                    NEXT

                    GOSUB dofadeout

                END IF

            CASE 2

                IF LEFT$(ss(f), 2) = "0*" OR VAL(ss(f)) = 0 THEN

                    n = VAL(MID$(ss(f), u + 1))

                    DO WHILE n > 0

                        bufo(hp) = 0

                        hp = hp + 1

                        IF limsec > 0 AND hp > limsec THEN EXIT DO

                        IF limsec = 0 AND hp > bg THEN GOSUB realloc

                        n = n - 1

                    LOOP

                ELSE

                    xx = VAL(LEFT$(ss(f), u - 1))

                    n = VAL(MID$(ss(f), u + 1))

                    IF usetan AND quadruple THEN n = n * 4

                    yy = 0

                    DO WHILE n > 0

                        DO WHILE yy < 360

                            goahead = -1

                            IF usetan THEN

                                m = INT(yy)

                                IF m >= 105 AND m <= 255 THEN

                                    IF multbefore THEN

                                        e = INT(TAN(yy * torad) * 32767 * volu)

                                    ELSE

                                        e = INT(TAN(yy * torad) * 32767)

                                    END IF

                                    IF e < -32768 THEN e = -32768

                                    IF e > 32767 THEN e = 32767

                                    IF NOT multbefore THEN e = INT(e * volu)

                                ELSE

                                    goahead = 0

                                END IF

                            ELSE

                                e = INT(SIN(yy * torad) * 32767 * volu)

                            END IF

                            IF goahead THEN

                                IF l < 20 THEN

                                    bufo(hp) = INT(e * (l / 20))

                                    l = l + 1

                                ELSE

                                    bufo(hp) = e

                                END IF

                                hp = hp + 1

                                IF limsec > 0 AND hp > limsec THEN EXIT DO

                                IF limsec = 0 AND hp > bg THEN GOSUB realloc

                            END IF

                            yy = yy + xx

                        LOOP

                        IF limsec > 0 AND hp > limsec THEN EXIT DO

                        yy = yy - 360

                        n = n - 1

                    LOOP

                    GOSUB dofadeout

                END IF

            CASE 3

                n = INT(VAL(ss(f)) * volu)

                IF n >= -32768 AND n <= 32767 THEN

                    FOR j = 1 TO cycle

                        bufo(hp) = n

                        hp = hp + 1

                        IF limsec > 0 AND hp > limsec THEN EXIT FOR

                        IF limsec = 0 AND hp > bg THEN GOSUB realloc

                    NEXT

                END IF

            CASE 4

                IF LEFT$(ss(f), 2) <> "0#" THEN

                    xx = VAL(LEFT$(ss(f), u - 1))

                    IF xx > 0 THEN

                        n = VAL(MID$(ss(f), u + 1)) * cycle

                        yy = 0

                        FOR j = 1 TO n

                            DO

                                goahead = -1

                                IF usetan THEN

                                    m = INT(yy)

                                    IF m >= 105 AND m <= 255 THEN

                                        IF multbefore THEN

                                            e = INT(TAN(yy * torad) * 32767 * volu)

                                        ELSE

                                            e = INT(TAN(yy * torad) * 32767)

                                        END IF

                                        IF e < -32768 THEN e = -32768

                                        IF e > 32767 THEN e = 32767

                                        IF NOT multbefore THEN e = INT(e * volu)

                                    ELSE

                                        goahead = 0

                                    END IF

                                ELSE

                                    e = INT(SIN(yy * torad) * 32767 * volu)

                                END IF

                                IF goahead THEN

                                    IF l < 20 THEN

                                        bufo(hp) = INT(e * (l / 20))

                                        l = l + 1

                                    ELSE

                                        bufo(hp) = e

                                    END IF

                                    hp = hp + 1

                                    IF limsec > 0 AND hp > limsec THEN EXIT FOR

                                    IF limsec = 0 AND hp > bg THEN GOSUB realloc

                                END IF

                                yy = yy + xx

                                IF INT(yy) >= 360 THEN yy = yy - 360

                            LOOP UNTIL goahead

                        NEXT

                        GOSUB dofadeout

                    END IF

                END IF

            CASE 5

                IF LEFT$(ss(f), 2) <> "0&" THEN

                    xx = VAL(LEFT$(ss(f), u - 1))

                    IF xx > 0 AND xx < 8000 THEN

                        IF usetan THEN xx = xx / 4

                        xx = xx * twopi * etarpmas

                        n = VAL(MID$(ss(f), u + 1)) * cycle

                        ''note this time "yy" has to be in RADIANS

                        yy = 0

                        FOR j = 1 TO n

                            DO

                                goahead = -1

                                IF usetan THEN

                                    m = INT(yy / torad)

                                    IF m >= 105 AND m <= 255 THEN

                                        IF multbefore THEN

                                            e = INT(TAN(yy) * 32767 * volu)

                                        ELSE

                                            e = INT(TAN(yy) * 32767)

                                        END IF

                                        IF e < -32768 THEN e = -32768

                                        IF e > 32767 THEN e = 32767

                                        IF NOT multbefore THEN e = INT(e * volu)

                                    ELSE

                                        goahead = 0

                                    END IF

                                ELSE

                                    e = INT(SIN(yy) * 32767 * volu)

                                END IF

                                IF goahead THEN

                                    IF l < 20 THEN

                                        bufo(hp) = INT(e * (l / 20))

                                        l = l + 1

                                    ELSE

                                        bufo(hp) = e

                                    END IF

                                    hp = hp + 1

                                    IF limsec > 0 AND hp > limsec THEN EXIT FOR

                                    IF limsec = 0 AND hp > bg THEN GOSUB realloc

                                END IF

                                yy = yy + xx

                                IF yy >= twopi THEN yy = yy - twopi

                            LOOP UNTIL goahead

                        NEXT

                        GOSUB dofadeout

                    END IF

                END IF

        END SELECT

    END IF

    IF limsec > 0 AND hp > limsec THEN

        PRINT "Limit reached around line"; i

        EXIT FOR

    END IF

NEXT



IF limsec = 0 THEN

    ac = bg * 2

ELSE

    ac = limsec * 2

    IF dcdc <> 0 THEN

        FOR i = 1 TO limsec

            u = bufo(i) + dcdc

            IF u < -32768 THEN u = -32768

            IF u > 32767 THEN u = 32767

            bufo(i) = u

        NEXT

    END IF

END IF

ab = ac + &H24

ff = FREEFILE

OPEN outfile$ FOR BINARY AS ff

PUT #ff, , wavefilehead$

PUT #ff, , ac

PUT #ff, , bufo()

PUT #ff, 5, ab

CLOSE ff

PRINT "Output wave file created:"

PRINT outfile$

GOTO pend





pend:

END



realloc:

bg = bg + 4410

REDIM _PRESERVE bufo(1 TO bg) AS INTEGER

RETURN



dofadeout:

l = hp

IF l < 20 THEN RETURN

IF limsec > 0 AND hp > limsec THEN l = limsec

FOR j = 0 TO 19

    bufo(l) = bufo(l) * (j / 20)

    l = l - 1

NEXT

RETURN





SUB helpme ()

    DIM sh(1 TO 23) AS STRING

    CLS

    sh(1) = "$07Usage: $01wavesa.exe $04{$09text-file.txt$04} {$09switches$04}"

    sh(2) = "$07  Input text file should have full path,"

    sh(3) = "$07    Otherwise it's assumed to be $0F'wavesa.txt'"

    sh(4) = "$07    in the same directory as this EXE file."

    sh(5) = "$07  Text file $0Fmust$07 have $0F'==='$07 to separate"

    sh(6) = "$07    functions from indexes."

    sh(7) = "  Switches (prefix with $0F'--'$07) are:"

    sh(8) = "$0F    out$09abc    $07Name the output wave file."

    sh(9) = "$0F    cycle$09#        $07Set the size of a cycle"

    sh(10) = "$07      (default=360, cannot set less than this)"

    sh(11) = "$07      This indicates how much of imported sample"

    sh(12) = "$07        per function execution."

    sh(13) = "$0F    limit$09#.#      $07Output wave file limit"

    sh(14) = "$0F      $09x $07= integer number of samples"

    sh(15) = "$0F      $09x.y $07= float number of seconds"

    sh(16) = "$0F    vol$09#      $07Volume control (1 to 100, 100=max amplitude, default=25)"

    sh(17) = "$07      This is always applied to generated waveforms."

    sh(18) = "$0F    dc$09hhhh    $07Overlay a DC offset.  Number must be in hexadecimal."

    sh(19) = "$0F    tan       $07Use tangent instead of sine for waveform generation."

    sh(20) = "$0F    samp      $07Subject imported samples to volume control."

    sh(21) = "$0F    mult      $07For tangent waveform generation, do multiplication"

    sh(22) = "$07                and attenuation before clipping."

    sh(23) = "$0F    quad      $07Quadruple the passes for tangent waveform generation."

    FOR i = 1 TO 23

        LOCATE i, 1

        TXIprint sh(i)

    NEXT

END SUB





FUNCTION chrn$ (nn AS _UNSIGNED _INTEGER64, a1 AS _BYTE, a2 AS _BYTE, a3 AS _BYTE, a4 AS _BYTE, a5 AS _BYTE, a6 AS _BYTE, a7 AS _BYTE, a8 AS _BYTE, a9 AS _BYTE)

    DIM aa(1 TO 9) AS _UNSIGNED _BYTE, ab(1 TO 9) AS _UNSIGNED _BYTE

    IF nn = 0 THEN chrn$ = "": EXIT FUNCTION

    aa(1) = a1: aa(2) = a2: aa(3) = a3

    aa(4) = a4: aa(5) = a5: aa(6) = a6

    aa(7) = a7: aa(8) = a8: aa(9) = a9

    j = 1

    a$ = LTRIM$(STR$(nn))

    DO UNTIL a$ = ""

        IF aa(j) = 0 THEN EXIT DO

        ab(j) = VAL(LEFT$(a$, aa(j)))

        a$ = MID$(a$, aa(j) + 1)

        j = j + 1

        IF j > 9 THEN EXIT DO

    LOOP

    sret$ = ""

    FOR i = 1 TO 9

        IF aa(i) > 0 THEN sret$ = sret$ + CHR$(ab(i))

    NEXT

    chrn$ = sret$

END FUNCTION





FUNCTION CountString% (tx$, delim$)

    DIM AS LONG count, z1, z2, lx

    IF (tx$ = "") OR (delim$ = "") THEN

        CountString% = 0

        EXIT FUNCTION

    END IF

    lx = LEN(delim$)

    z1 = 1

    z2 = INSTR(tx$, delim$)

    count = 0

    DO UNTIL z2 = 0

        count = count + 1

        z1 = z2 + lx

        z2 = INSTR(z1, tx$, delim$)

    LOOP

    CountString% = count

END FUNCTION





FUNCTION FieldString$ (tx$, ndx%, delim$)

    DIM AS LONG count, z1, z2, lx, y

    IF (tx$ = "") OR (delim$ = "") OR (ndx% < 1) THEN

        FieldString$ = ""

    ELSE

        count = CountString(tx$, delim$) + 1

        IF ndx% > count THEN

            FieldString$ = ""

            EXIT FUNCTION

        END IF

        lx = LEN(delim$)

        z1 = 1

        z2 = INSTR(tx$, delim$)

        y = 0

        DO UNTIL z2 = 0

            y = y + 1

            IF y >= ndx% THEN EXIT DO

            z1 = z2 + lx

            z2 = INSTR(z1, tx$, delim$)

        LOOP

        IF (z2 = 0) AND (y <= ndx%) THEN

            FieldString$ = MID$(tx$, z1)

        ELSE

            FieldString$ = MID$(tx$, z1, z2 - z1)

        END IF

    END IF

END FUNCTION





FUNCTION GetCommand% (args$())

    comd$ = COMMAND$

    IF comd$ = "" THEN

        GetCommand% = 0

        EXIT FUNCTION

    END IF

    delim$ = CHR$(1)

    inquote = 0

    lx = LEN(comd$)

    DO UNTIL lx < 1

        b$ = MID$(comd$, lx, 1)

        IF b$ = CHR$(34) THEN

            inquote = NOT inquote

        ELSEIF (b$ = " ") AND (inquote = 0) THEN

            MID$(comd$, lx, 1) = delim$

        END IF

        lx = lx - 1

    LOOP

    z = CountString(comd$, delim$) + 1

    REDIM args$(1 TO z)

    FOR y = 1 TO z

        args$(y) = FieldString$(comd$, y, delim$)

        IF (LEFT$(args$(y), 1) = CHR$(34)) AND (RIGHT$(args$(y), 1) = CHR$(34)) THEN

            lx = LEN(args$(y)) - 2

            args$(y) = MID$(args$(y), 2, lx)

        END IF

    NEXT

    GetCommand% = z

END FUNCTION





FUNCTION NewTrim$ (tx$, fromleft%, fromright%)

    DIM a$, b AS INTEGER

    DIM AS LONG j, lx

    IF (fromleft% = 0) AND (fromright% = 0) THEN

        NewTrim$ = tx$

        EXIT FUNCTION

    END IF

    a$ = tx$

    lx = LEN(a$)

    IF fromleft% THEN

        FOR j = 1 TO lx

            b = ASC(a$, j)

            IF b > 32 THEN EXIT FOR

        NEXT

        IF j <= lx THEN a$ = MID$(a$, j): lx = LEN(a$)

    END IF

    IF fromright% THEN

        FOR j = lx TO 1 STEP -1

            b = ASC(a$, j)

            IF b > 32 THEN EXIT FOR

        NEXT j

        IF j > 0 THEN a$ = LEFT$(a$, j)

    END IF

    NewTrim$ = a$

END FUNCTION





SUB TXIprint (t$)

    IF t$ = "" THEN EXIT SUB

    IF LTRIM$(RTRIM$(t$)) = "" THEN EXIT SUB

    sl = LEN(t$)

    j = 1

    DO WHILE j <= sl

        b$ = MID$(t$, j, 1)

        IF b$ = "#" OR b$ = "$" THEN

            z$ = MID$(t$, j + 1, 2)

            o = VAL("&H" + z$)

            IF o > 0 OR (o = 0 AND z$ = "00") THEN

                IF b$ = "$" THEN

                    COLOR o MOD 16, o \ 16

                ELSE

                    PRINT CHR$(o);

                END IF

            END IF

            j = j + 3

        ELSE

            PRINT b$;

            j = j + 1

        END IF

    LOOP

END SUB

Hi,

I've taken a bit of time to create qbjs-vscode-template repo:
https://github.com/grymmjack/qbjs-vscode-template

How do you use it?

Well you need vscode, but after that...

1. Clone the repo - `git clone https://github.com/grymmjack/qbjs-vscode-template your-project-here`
   
2. Go into project dir - `cd your-project-here`
   
3. Delete `.git` (start clean on your own) `rm -rf .git`
   
4. Open vscode
   
5. Add `your-project-here` folder to vscode workspace - `code -ra .` (if you have it setup in path)
   
6. Install the recommended extensions (only asked one time)
   
7. Restart vscode (if applicable)
   
8. Open `index.bas` and start coding
   
9. Press `F5` to build and preview