QBJS Sample fix(es) - Printable Version

Code: (Select All)

' Mod MG DRAW by bplus 2023-10-08

'ref  https://qb64.boards.net/thread/219/qb64-dev-competition-idea?page=2&scrollTo=1228

Dim i As Integer, ai As Integer, cc As Integer, u As Integer

Dim a$, s$

Randomize Timer

Screen _newimage(800, 600, 12)

Do

    a$ = ""

    Do Until Len(a$) > 20

        If Random1(2) = 1 Then

            If Random1(2) = 1 Then a$ = a$ + "L" Else a$ = a$ + "R"

        Else

            If Random1(2) = 1 Then a$ = a$ + "D" Else a$ = a$ + "U"

        End If

        a$ = a$ + Str$(Rand(1, 15))

    Loop

    s$ = a$

    Cls

    For i = 1 To 24

        stepper = Val(Mid$(" 10 12 15 18 20 30 40 45 60 72 90120180", Int(Rnd * 13) + 1, 3))

        For ai = 0 To 360 - stepper Step stepper

            cc = Rand(64, 160)

            If i > 10 Then u = 10 Else u = i

            If i Mod 2 Then cc = 9 Else cc = 15

            PreSet (400, 300)

            'Draw "ta0"  ' this needed?

            a$ = "S" + Str$(22 - u * 2) + "TA" + Str$(ai) + "C" + Str$(cc) + s$

            Draw a$

        Next

    Next

    Print "spacebar for another, esc to quit"

    Sleep

Loop Until Asc(InKey$) = 27

Function Rand& (fromval&, toval&)

    Dim sg%, f&, t&

    If fromval& = toval& Then

        Rand& = fromval&

        Exit Function

    End If

    f& = fromval&

    t& = toval&

    If (f& < 0) And (t& < 0) Then

        sg% = -1

        f& = f& * -1

        t& = t& * -1

    Else

        sg% = 1

    End If

    If f& > t& Then Swap f&, t&

    Rand& = Int(Rnd * (t& - f& + 1) + f&) * sg%

End Function

Function Random1& (maxvaluu&)

    Dim sg%

    sg% = Sgn(maxvaluu&)

    If sg% = 0 Then

        Random1& = 0

    Else

        If sg% = -1 Then maxvaluu& = maxvaluu& * -1

        Random1& = Int(Rnd * maxvaluu& + 1) * sg%

    End If

End Function

_Title "Morph Curve Line" 'b+ mod 2026-02-16 from 2022-07-19 trans from ' Morph Curve on Plasma.bas SmallBASIC 0.12.8 [B+=MGA] 2017-04-11 'from SpecBAS version Paul Dunn Dec 2, 2015 'https://www.youtube.com/watch?v=j2rmBRLEVms Const xmax = 1200, ymax = 700, pts = 240, interps = 30, pi = _Pi Dim Shared ShadeGrey, GreyN Randomize Timer Screen _NewImage(xmax, ymax, 32) _FullScreen Dim p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps) Dim As Long L, c, j Dim As Single cx, cy, sc, st, n, m, t, lastx, lasty L = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * pi / pts For n = 1 To interps i(n) = Sin(n / interps * (pi / 2)) Next Color , &HFF330000: Cls While _KeyDown(27) = 0 ResetGrey n = Int(Rnd * 75) + 2: m = Int(Rnd * 500) - 250: c = 0 For t = 0 To 2 * pi Step st If _KeyDown(27) Then System q(c, 0) = cx + sc * (Cos(t) + Cos(n * t) / 2 + Sin(m * t) / 3) q(c, 1) = cy + sc * (Sin(t) + Sin(n * t) / 2 + Cos(m * t) / 3) SetGrey If t > 0 Then Line (lastx, lasty)-(q(c, 0), q(c, 1)) lastx = q(c, 0): lasty = q(c, 1) c = c + 1 Next q(c, 0) = q(0, 0): q(c, 1) = q(0, 1) If L = 0 Then L = 1 _Display _Limit 15 Else For t = 1 To interps Cls For n = 0 To pts If _KeyDown(27) Then System s(n, 0) = q(n, 0) * i(t) + p(n, 0) * (1 - i(t)) s(n, 1) = q(n, 1) * i(t) + p(n, 1) * (1 - i(t)) SetGrey If n > 0 Then Line (lastx, lasty)-(s(n, 0), s(n, 1)) lastx = s(n, 0): lasty = s(n, 1) Next s(n, 0) = s(0, 0) s(n, 1) = s(0, 1) _Display _Limit 15 Next End If For j = 0 To pts + 1 'copy q into p If _KeyDown(27) Then System p(j, 0) = q(j, 0) p(j, 1) = q(j, 1) Next _Display _Delay 1 Wend Sub ResetGrey () 'all globals ShadeGrey = Rnd ^ 2: GreyN = 0 End Sub Sub SetGrey () 'all globals GreyN = GreyN + _Pi(1 / 6) Color _RGB32(170 + 84 * Sin(ShadeGrey * GreyN)) End Sub