My old Turtle Graphics Fractals

My old Turtle Graphics Fractals - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: My old Turtle Graphics Fractals (/showthread.php?tid=512)

My old Turtle Graphics Fractals - triggered - 06-02-2022

I decided to try and implement a graphics method I'm particularly fond of:

Code: (Select All)
Screen 12

Dim a$

a$ = "FRRFRRF"

Dim j

For j = 1 To 4

    a$ = stReplace$(a$, "F", "FLFRRFLF")

Next j

TurtleGraphics 320 / 2, 240 / 2, 0, 5, a$

End

Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)

    Dim As Double x, y, angle, stepsize

    Dim w As String

    Dim t As String

    x = x0

    y = y0

    angle = a0

    w = path

    stepsize = ssize

    PReset (x0, y0)

    Do While Len(w)

        t = Left$(w, 1)

        w = Right$(w, Len(w) - 1)

        Select Case t

            Case "F"

                x = x + stepsize * Cos(angle)

                y = y + stepsize * Sin(angle)

            Case "L"

                angle = angle - 60 * _Pi / 180

            Case "R"

                angle = angle + 60 * _Pi / 180

        End Select

        Line -(x, y), 15

    Loop

End Sub

Function stReplace$ (a As String, b As String, c As String)

    Dim i As Integer

    Dim g As String

    Dim r As String

    For i = 1 To Len(a)

        g = Mid$(a, i, 1)

        If g = b Then

            r = r + c

        Else

            r = r + g

        End If

    Next

    stReplace = r

End Function

RE: My old Turtle Graphics Fractals - bplus - 06-02-2022

Yeah aren't those the "best" kind of programs, ones that you are "particularly fond of".

That's a good one, I like the use of string replacements to build the draw string for Koch Flake.

RE: My old Turtle Graphics Fractals - Pete - 06-02-2022

Hey look, another triggered snowflake!

Code: (Select All)
SCREEN 12

DIM a$

a$ = "FRRFRRF"

DIM j

FOR j = 1 TO 4

    a$ = stReplace$(a$, "F", "RFSFRFSF")

NEXT j

TurtleGraphics 460 / 2, 120 / 2, 0, 5, a$

TurtleGraphics 840 / 2, 120 / 2, 0, 5, a$

TurtleGraphics 650 / 2, 340 / 2, 0, 5, a$

TurtleGraphics 550 / 2, 540 / 2, 0, 5, a$

TurtleGraphics 750 / 2, 540 / 2, 0, 5, a$

TurtleGraphics 480 / 2, 690 / 2, 0, 5, a$

TurtleGraphics 820 / 2, 690 / 2, 0, 5, a$

TurtleGraphics 550 / 2, 840 / 2, 0, 5, a$

TurtleGraphics 750 / 2, 840 / 2, 0, 5, a$

SLEEP

SYSTEM

SUB TurtleGraphics (x0 AS DOUBLE, y0 AS DOUBLE, a0 AS DOUBLE, ssize AS DOUBLE, path AS STRING)

    DIM AS DOUBLE x, y, angle, stepsize

    DIM w AS STRING

    DIM t AS STRING

    x = x0

    y = y0

    angle = a0

    w = path

    stepsize = ssize

    PRESET (x0, y0)

    DO WHILE LEN(w)

        t = LEFT$(w, 1)

        w = RIGHT$(w, LEN(w) - 1)

        SELECT CASE t

            CASE "F"

                x = x + stepsize * COS(angle)

                y = y + stepsize * SIN(angle)

            CASE "L"

                angle = angle - 60 * _PI / 180

            CASE "R"

                angle = angle + 60 * _PI / 180

        END SELECT

        LINE -(x, y), 15

    LOOP

END SUB

FUNCTION stReplace$ (a AS STRING, b AS STRING, c AS STRING)

    DIM i AS INTEGER

    DIM g AS STRING

    DIM r AS STRING

    FOR i = 1 TO LEN(a)

        g = MID$(a, i, 1)

        IF g = b THEN

            r = r + c

        ELSE

            r = r + g

        END IF

    NEXT

    stReplace = r

END FUNCTION

RE: My old Turtle Graphics Fractals - bplus - 06-02-2022

Well my mod isn't all trumped up!

Code: (Select All)
_Title "Koch Curve" '  by triggered mod b+ 2022-06-02

Screen _NewImage(700, 700, 12) ' b+ mod tirggered Koch curve

_ScreenMove 300, 20

mx = _Width / 2: my = _Height / 2

Dim a$

a$ = "FRRFRRF"

ss = 600

Circle (mx, my), 1

Circle (mx, my), ss / Sqr(3)

x0 = _Width / 2 + ss / Sqr(3) * Cos(_D2R(210))

y0 = _Height / 2 + ss / Sqr(3) * Sin(_D2R(210))

TurtleGraphics x0, y0, 0, ss, a$

_Delay 1

Dim j

For j = 1 To 4

    'Cls

    ss = ss / 3

    a$ = stReplace$(a$, "F", "FLFRRFLF")

    TurtleGraphics x0, y0, 0, ss, a$

    _Limit 2 ' pause 2 x's per sec

Next j

Sleep

Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)

    Dim As Double x, y, angle, stepsize

    Dim w As String

    Dim t As String

    x = x0

    y = y0

    angle = a0

    w = path

    stepsize = ssize

    PReset (x0, y0)

    Do While Len(w)

        t = Left$(w, 1)

        w = Right$(w, Len(w) - 1)

        Select Case t

            Case "F"

                x = x + stepsize * Cos(angle)

                y = y + stepsize * Sin(angle)

            Case "L"

                angle = angle - 60 * _Pi / 180

            Case "R"

                angle = angle + 60 * _Pi / 180

        End Select

        Line -(x, y), 15

    Loop

End Sub

Function stReplace$ (a As String, b As String, c As String)

    Dim i As Integer

    Dim g As String

    Dim r As String

    For i = 1 To Len(a)

        g = Mid$(a, i, 1)

        If g = b Then

            r = r + c

        Else

            r = r + g

        End If

    Next

    stReplace = r

End Function

RE: My old Turtle Graphics Fractals - Pete - 06-02-2022

Thanks Mark for restocking my short supply of Jewish throwing stars!

Pete Big Grin

RE: My old Turtle Graphics Fractals - bplus - 06-03-2022

And another thing...

Code: (Select All)
_Title "Koch Boch" '  by triggered mod b+ 2022-06-02

Screen _NewImage(700, 700, 12) ' b+ mod tirggered Koch curve

_ScreenMove 300, 20

mx = _Width / 2: my = _Height / 2

Dim a$

a$ = "FRFRFRF"

ss = 350

'Circle (mx, my), 1

'Circle (mx, my), .5 * ss * Sqr(2)

x0 = _Width / 2 + .5 * ss * Sqr(2) * Cos(_D2R(225))

y0 = _Height / 2 + ss / Sqr(2) * Sin(_D2R(225))

TurtleGraphics x0, y0, 0, ss, a$

Sleep

Dim j

For j = 1 To 5

    ss = ss / 3

    a$ = stReplace$(a$, "F", "FLFRFRFLF")

    TurtleGraphics x0, y0, 0, ss, a$

    _Limit 1 ' pause 2 x's per sec

Next j

Sleep

Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)

    Dim As Double x, y, angle, stepsize

    Dim w As String

    Dim t As String

    x = x0

    y = y0

    angle = a0

    w = path

    stepsize = ssize

    PReset (x0, y0)

    Do While Len(w)

        t = Left$(w, 1)

        w = Right$(w, Len(w) - 1)

        Select Case t

            Case "F"

                x = x + stepsize * Cos(angle)

                y = y + stepsize * Sin(angle)

            Case "L"

                angle = angle - 90 * _Pi / 180

            Case "R"

                angle = angle + 90 * _Pi / 180

        End Select

        Line -(x, y), 15

    Loop

End Sub

Function stReplace$ (a As String, b As String, c As String)

    Dim i As Integer

    Dim g As String

    Dim r As String

    For i = 1 To Len(a)

        g = Mid$(a, i, 1)

        If g = b Then

            r = r + c

        Else

            r = r + g

        End If

    Next

    stReplace = r

End Function

It's sleeping after the first square hit spacebar for fractal.

RE: My old Turtle Graphics Fractals - bplus - 06-03-2022

Thumbs up tp triggered for this cool way to do a fractal, luv it!

RE: My old Turtle Graphics Fractals - vince - 06-03-2022

Nice mods, B+. A couple of old fractalesque demos of mine:

alternate Kock snowflake

Code: (Select All)
dim shared pi

dim shared c

dim shared cc

pi = 4*atn(1)

c = 2*sqr(3)/9

cc = sqr(12) / 6 

sw = 1024

sh = 768

screen _newimage(sw, sh, 12)

tri sw/2, sh/2, 600, 0 

tri sw/2, sh/2, 600, pi 

cock sw/2, sh/2, 600, 3 

sleep

system

sub cock(x, y, s, i)

    if i = 0 then exit sub

    for a = pi/6 to 2*pi + pi/6 step pi/3

        xx = s*c*cos(a) + x 

        yy = s*c*sin(a) + y

        tri xx, yy, s/3, a+pi/6

        tri xx, yy, s/3, a+pi/6+pi

        cock xx, yy, s/3, i - 1

    next

end sub

sub tri(x, y, s, a)

    line (x,y)-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a)),8

    line (x,y)-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a)),8

    line (x,y)-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a)),8

    line (x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a))

    line-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a))

    line-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))

end sub

Flower of justice

Code: (Select All)
const sw = 800

const sh = 600

dim shared pi as double

pi = 4*atn(1)

screen _newimage(sw, sh, 32)

r = 100

do

    for a = 0.1 to 1 step 0.01

        cls

        fcirc sw/2, sh/2, a*r + (1-a)*150, a, 3

        _display

        _limit 5

    next

    _delay 2

loop

sleep

system

sub fcirc (x, y, r, a, n)

    if n > 0 then

    for t=0 to 2*pi step 2*pi/6

        xx = x + r*cos(t)

        yy = y + r*sin(t)

        circle (xx, yy), r

        fcirc xx, yy, a*r, a, n - 1

    next

    end if

end sub

Logistic map or the '1-dimensional Mandelbrot'

Code: (Select All)
deflng a-z

dim xx as double, uu as double

screen 12

for u=0 to 640

    uu=2.8 + 1.2*u/640

    for x=0 to 480

        xx = x/480

        for i=0 to 500

            xx = uu*xx*(1-xx)

        next

        pset(u,480*(1-xx))

    next

next

sleep

system

RE: My old Turtle Graphics Fractals - vince - 06-03-2022

(06-02-2022, 03:37 PM)triggered Wrote:
Code: (Select All)
PReset (x0, y0)

WTF is this abomination

RE: My old Turtle Graphics Fractals - bplus - 06-03-2022

(06-03-2022, 06:31 PM)vince Wrote:
(06-02-2022, 03:37 PM)triggered Wrote:
Code: (Select All)
PReset (x0, y0)

WTF is this abomination

Yeah I had to look it up, like PSet, PReset colors a pixel. Unlike PSet using the forecolor of Color, PReset uses the background color of Color, puts it back into the background so to speak.

Makes sense for older code when it was too expensive to CLS and redraw everything every loop.

Also if you don't know if you are going to always draw a line or not from a pset, why make a dot?