Pseudo-fractal - interactive version

[hsiangch_ong]

i was bored so i messed about with the "pseudo-fractal" program (the last one listed in the post) shown in this topic:

https://qb64phoenix.com/forum/showthread...07#pid1907

please read the instructions further below.

Code: (Select All)

'based on program shown on this topic:
'https://qb64phoenix.com/forum/showthread.php?tid=372&pid=1907#pid1907
'modifications by mnrvovrfc (a.k.a. hsiangch_ong) 5-feb-2025
OPTION _EXPLICIT
DIM AS INTEGER oloc(1 TO 15), colo(1 TO 7)
DIM AS SINGLE a, b, c, d, e, xn, xm, yn, k, xnsqr, ynsqr, cresh, maxiter
DIM AS SINGLE xpos, ypos, xmin, ymin, xmax, ymax, xnn, ynn, dx, dy
DIM AS INTEGER i, j, pg, o, cc, dd, ee
DIM AS STRING noyb, afile
DIM endl AS STRING, ff AS LONG, thiscr AS LONG, doit AS _BYTE, firsttime AS _BYTE
endl = CHR$(10)
$IF WIN THEN
endl = CHR$(13) + endl
$ELSEIF MACOSX THEN
endl = CHR$(13)
$END IF

$IF WIN THEN
afile = LCASE$(HEX$(VAL(MID$(DATE$, 4, 2)) * 1000000~& + INT(TIMER(0.001) * 1000)))
$ELSE
noyb = "/tmp/noyb1"
SHELL _HIDE "uuidgen > " + noyb
afile = _READFILE$(noyb)
KILL noyb
afile = LeftLen$(afile, 1)
ReplaceString2 afile, "-", "", 0
$END IF
afile = "pseudofract" + afile

RANDOMIZE VAL(RIGHT$(TIME$, 2))
FOR i = 1 TO 15
    oloc(i) = i
NEXT
o = VAL(MID$(TIME$, 4, 2)) + 1
DO WHILE o > 0
    o = o - 1
    FOR i = 1 TO 15
        DO
            j = Random1(15)
        LOOP WHILE i = j
        SWAP oloc(i), oloc(j)
    NEXT
LOOP
pg = 1
GOSUB dopalette

across = 1024
down = 576
thiscr = _NEWIMAGE(across, down, 12)
SCREEN thiscr
_TITLE afile
xpos = Rand(24, 40) * 10
ypos = Rand(18, 30) * 10
a = Rand(2, 5) * 0.5 * (-1)
ee = Random1(9)
e = ee / 10
b = e * (-1)
cc = Rand(12, 36)
c = cc / 10
dd = Rand(3, 13)
d = (dd * 5) / 10 * (-1)
xmin = (Rand(5, 9) * 5) / 10 * (-1)
xmax = (Rand(5, 9) * 5) / 10
ymin = Rand(10, 20) / 10 * (-1)
ymax = Rand(10, 20) / 10
'changing this does nothing:
maxiter = 70
cresh = 500
dx = (xmax - xmin) / across
dy = (ymax - ymin) / down
firsttime = 1
DO
    IF firsttime THEN
        firsttime = 0
    ELSE
        doit = 0
        DO
            _LIMIT 12
            IF _KEYDOWN(27) THEN doit = 2
            IF _KEYDOWN(13) THEN
                doit = 3
                EXIT DO
            END IF
            FOR j = 49 TO 57
                IF _KEYDOWN(j) THEN
                    doit = 1
                    a = (j - 48) * 0.5 * (-1)
                    EXIT FOR
                END IF
            NEXT
            'if _keydown(91) then
            'doit = 1
            'if maxiter > 5 then maxiter = maxiter - 5
            'end if
            'if _keydown(93) then
            'doit = 1
            'if maxiter < 200 then maxiter = maxiter + 5
            'end if
            IF _KEYDOWN(44) OR _KEYDOWN(61) THEN
                doit = 1
                IF cresh < 2000 THEN cresh = cresh + 100
            END IF
            IF _KEYDOWN(95) OR _KEYDOWN(45) THEN
                doit = 1
                IF cresh > 100 THEN cresh = cresh - 100
            END IF
            IF _KEYDOWN(105) THEN
                doit = 1
                ypos = ypos - 10
                IF ypos < 0 THEN ypos = 0: doit = 0
            END IF
            IF _KEYDOWN(107) THEN
                doit = 1
                ypos = ypos + 10
                IF ypos > down - 40 THEN ypos = ypos - 10: doit = 0
            END IF
            IF _KEYDOWN(106) THEN
                doit = 1
                xpos = xpos - 10
                IF xpos < 0 THEN xpos = 0: doit = 0
            END IF
            IF _KEYDOWN(108) THEN
                doit = 1
                xpos = xpos + 10
                IF xpos > across - 70 THEN xpos = xpos - 10: doit = 0
            END IF
            IF _KEYDOWN(44) OR _KEYDOWN(60) THEN
                doit = 1
                pg = pg - 1
                IF pg < 1 THEN pg = 15
                GOSUB dopalette
            END IF
            IF _KEYDOWN(46) OR _KEYDOWN(62) THEN
                doit = 1
                pg = pg + 1
                IF pg > 15 THEN pg = 1
                GOSUB dopalette
            END IF
            IF _KEYDOWN(67) THEN
                doit = 1
                cc = cc - 1
                IF cc < 12 THEN cc = 59
                c = cc / 10
            END IF
            IF _KEYDOWN(68) THEN
                doit = 1
                dd = dd - 1
                IF dd < 3 THEN dd = 13
                d = (dd * 5) / 10 * (-1)
            END IF
            IF _KEYDOWN(69) THEN
                doit = 1
                ee = ee - 1
                IF ee < 1 THEN ee = 9
                e = ee / 10
                b = e * (-1)
            END IF
            IF _KEYDOWN(99) THEN
                doit = 1
                cc = cc + 1
                IF cc >= 60 THEN cc = 12
                c = cc / 10
            END IF
            IF _KEYDOWN(100) THEN
                doit = 1
                dd = dd + 1
                IF dd > 13 THEN dd = 3
                d = (dd * 5) / 10 * (-1)
            END IF
            IF _KEYDOWN(101) THEN
                doit = 1
                ee = ee + 1
                IF ee > 9 THEN ee = 1
                e = ee / 10
                b = e * (-1)
            END IF
        LOOP UNTIL doit
        _KEYCLEAR
        IF doit = 2 THEN EXIT DO
    END IF
    CLS
    FOR ynn = 1 TO down
        FOR xnn = 1 TO across
            k = 0
            xn = xmin + dx * xnn
            yn = ymin + dy * ynn
            DO
                k = k + 1
                xnsqr = xn * xn
                ynsqr = yn * yn
                IF (xnsqr + ynsqr) > cresh THEN
                    GOSUB PlotPoint
                    EXIT DO
                END IF
                IF k > maxiter THEN
                    EXIT DO
                END IF
                xm = a + b * xn + c * ynsqr
                yn = d + e * xn
                xn = xm
            LOOP
        NEXT xnn
    NEXT ynn
    IF doit < 3 THEN
        _PRINTSTRING (0, 560), "Press escape to quit. Press cdeijkl123456789<>-+  position =" + STR$(xpos) + "," + STR$(ypos) + "  cresh =" + STR$(cresh)
    END IF
    IF doit = 3 THEN EXIT DO
LOOP UNTIL _KEYDOWN(27)
_KEYCLEAR
IF doit = 3 THEN
    _SAVEIMAGE afile + ".png", thiscr
    ff = FREEFILE
    OPEN afile + ".txt" FOR OUTPUT AS ff
    PRINT #ff, "xpos ="; xpos; endl; "ypos ="; ypos; endl;
    PRINT #ff, "a ="; a; endl; "b ="; b; endl; "c ="; c; endl;
    PRINT #ff, "d ="; d; endl; "e ="; e; endl;
    PRINT #ff, "xmin ="; xmin; endl; "xmax ="; xmax; endl;
    PRINT #ff, "ymin ="; ymin; endl; "ymax ="; ymax; endl;
    PRINT #ff, "maxiter ="; maxiter; endl; "cresh ="; cresh; endl;
    CLOSE ff
END IF
SYSTEM

PlotPoint:
PSET (xpos - .5 * across + xnn, ypos - .5 * down + ynn), colo((k MOD 7) + 1)
RETURN


dopalette:
j = pg
FOR i = 1 TO 7
    colo(i) = oloc(j)
    j = j + 1
    IF j > 15 THEN j = 1
NEXT
RETURN


FUNCTION Random1& (maxval AS LONG)
    Random1& = INT(RND * maxval + 1)
END FUNCTION

FUNCTION Rand& (loval AS LONG, hival AS LONG)
    Rand& = INT(RND * (hival - loval + 1) + loval)
END FUNCTION

SUB ReplaceString2 (tx AS STRING, sfind AS STRING, repl AS STRING, numtimes AS LONG)
    DIM AS STRING s, t
    DIM AS LONG ls, count, u
    DIM goahead AS _BYTE
    IF (tx = "") OR (sfind = "") OR (sfind = repl) OR (LEN(sfind) > LEN(tx)) THEN EXIT SUB
    s = UCASE$(sfind): t = UCASE$(tx)
    ls = LEN(s)
    count = 0
    goahead = 1
    DO
        u = INSTR(t, s)
        IF u > 0 THEN
            tx = LEFT$(tx, u - 1) + repl + MID$(tx, u + ls)
            t = UCASE$(tx)
            IF numtimes > 0 THEN count = count + 1: IF count >= numtimes THEN goahead = 0
        ELSE
            goahead = 0
        END IF
    LOOP WHILE goahead
END SUB

FUNCTION LeftLen$ (tx$, numchar%)
    IF tx$ = "" THEN
        LeftLen$ = ""
    ELSEIF numchar% > 0 THEN
        LeftLen$ = LEFT$(tx$, LEN(tx$) - numchar%)
    ELSE
        LeftLen$ = tx$
    END IF
END FUNCTION

this is an interactive program:

key             function
escape          quit program
enter           save image and text-file info and quit program
i,j,k,l         shift image render
plus/minus      increase/decrease "cresh"
c,d,e           change those variables as listed in this program
number key      change variable "a" as listed in this program
comma/period    shift "palette"


this program will often refuse to create a picture, or create one which is a colored solid block.  it's better to press escape and try again.

the "palette" is 15 colors (except black) and is randomly created.  the comma and period keys (shifted or not) shift down or up the list of colors by one location.

the value of variable "b" is related to that of "e" on purpose.  the value of "d" could have a great effect on the render.  oftentimes, it produces worthless results.  the lowercase "c", "d" and "e" keys decrease the value for that variable.  type the letter in uppercase to increase the value instead.

perhaps variable "cresh" could be increased beyond 2000 but i wanted to be conservative.  in my experiments, changing "maxiter" had no effect.  for most "interesting" images the (xpos, ypos) to take up the whole screen in this program seems to be (510,290).  the screen for this program is purposely set to 3/4 what is my laptop's screen which is 1366 by 768 pixels.

this is important: press enter instead of escape to save the current image to png.  it will be saved to the same directory as the executable.  two files will be saved.  the other one is a text file that reveals the values used to come up with the fractal.  it will require another program that will read those values and draw the fractal like in the original "pseudo-fractal".  known issue: the "palette" is not recorded into the text file.

this program requires qb64 phoenix 3.12 or later.  for older releases it will have to be edited somewhere near the top.  i did not put a "compiler check" because whoever is still using "official" or a release older than 3.4 really should upgrade.  i'm sorry for sounding arrogant.

i'm on linux.  therefore the code to fabricate a random filename will have to be verified for windows.  i wrote a function that fabricates a name according to the system time and a running counter but can't find it in my backups yet.

(looks around anxiously.)  well you could ask, just what do i do with a text file generated by this program?!

run this program:

Code: (Select All)

'based on program shown on this topic:
'https://qb64phoenix.com/forum/showthread.php?tid=372&pid=1907#pid1907
'modifications by mnrvovrfc (a.k.a. hsiangch_ong) 5-feb-2025
$IF VERSION < 3.4 THEN
$ERROR Sorry, please upgrade QB64 to the latest Phoenix Edition!
$END IF
option _explicit
DIM AS INTEGER oloc(1 TO 15), colo(1 TO 7)
dim as single a, b, c, d, e, xn, xm, yn, k, xnsqr, ynsqr, cresh, maxiter
dim as single xpos, ypos, xmin, ymin, xmax, ymax, xnn, ynn, dx, dy
dim as integer across, down, i, j, pg, o, cc, dd, ee, zm, xk, yk
dim as long ff, thiscr, eq
dim as string afile, entry, ky

$IF WIN THEN
entry = "USERPROFILE"
$ELSE
entry = "HOME"
$END IF

afile = _openfiledialog$("Please choose 'pseudo-fractal' text file.", environ$(entry) + "/Documents/", "*.txt", "TEXT")
if afile = "" then system
ff = freefile
open afile for input as ff
do until eof(ff)
    line input #ff, entry
    getintoequal entry, ky, eq
    if eq = -1 then _continue
    if ky = "a" then a = val(mid$(entry, eq)) : _continue
    if ky = "b" then b = val(mid$(entry, eq)) : _continue
    if ky = "c" then c = val(mid$(entry, eq)) : _continue
    if ky = "d" then d = val(mid$(entry, eq)) : _continue
    if ky = "e" then e = val(mid$(entry, eq)) : _continue
    if ky = "xpos" then xpos = val(mid$(entry, eq)) : _continue
    if ky = "ypos" then ypos = val(mid$(entry, eq)) : _continue
    if ky = "xmin" then xmin = val(mid$(entry, eq)) : _continue
    if ky = "xmax" then xmax = val(mid$(entry, eq)) : _continue
    if ky = "ymin" then ymin = val(mid$(entry, eq)) : _continue
    if ky = "ymax" then ymax = val(mid$(entry, eq)) : _continue
    if ky = "maxiter" then maxiter = val(mid$(entry, eq)) : _continue
    if ky = "cresh" then cresh = val(mid$(entry, eq)) : _continue
    if ky = "zm" then zm = val(mid$(entry, eq)) : _continue
    if ky = "xk" then xk = val(mid$(entry, eq)) : _continue
    if ky = "yk" then yk = val(mid$(entry, eq))
loop
close ff
if zm = 0 then zm = 100
if xk = 0 then xk = 100
if yk = 0 then yk = 100

RANDOMIZE VAL(RIGHT$(TIME$, 2))
FOR i = 1 TO 15
    oloc(i) = i
NEXT
o = VAL(MID$(TIME$, 4, 2)) + 1
DO WHILE o > 0
    o = o - 1
    FOR i = 1 TO 15
        DO
            j = int(rnd * 15 + 1)
        LOOP WHILE i = j
        SWAP oloc(i), oloc(j)
    NEXT
LOOP
pg = 1
j = pg
FOR i = 1 TO 7
    colo(i) = oloc(j)
    j = j + 1
    IF j > 15 THEN j = 1
NEXT

across = 1024
down = 576
thiscr = _NEWIMAGE(across, down, 12)
SCREEN thiscr
_title "Pseudo-fractal - Press escape to quit."
dx = (xmax - xmin) / across
dy = (ymax - ymin) / down
FOR ynn = 1 TO down
    FOR xnn = 1 TO across
        k = 0
        xn = xmin + (dx * zm / 100) * (xnn * xk / 100)
        yn = ymin + (dy * zm / 100) * (ynn * yk / 100)
        DO
            k = k + 1
            xnsqr = xn * xn
            ynsqr = yn * yn
            IF (xnsqr + ynsqr) > cresh THEN
                GOSUB PlotPoint
                EXIT DO
            END IF
            IF k > maxiter THEN
                EXIT DO
            END IF
            xm = a + b * xn + c * ynsqr
            yn = d + e * xn
            xn = xm
        LOOP
    NEXT xnn
NEXT ynn
do : _limit 100 : loop until _keydown(27)
_keyclear
system


PlotPoint:
PSET (xpos - 0.5 * across + xnn, ypos - 0.5 * down + ynn), colo((k MOD 7) + 1)
RETURN

'changed: ky, eq
sub getintoequal (entry as string, ky as string, eq as long)
    dim u as long
    u = instr(entry, "=")
    if u = 0 then
        eq = -1
        exit sub
    end if
    eq = u + 1
    ky = _trim$(lcase$(left$(entry$, u - 1)))
end sub

but what do variables "zm", "xk" and "yk" do?  heh heh.  i'm keeping it to myself.  the handling of the "palette" here is also left as an exercise to the reader.

[bplus]

Do you have any screen shots. I am leary of code with kill in it or has to create a file.

BTW you used Option _Explicit and yet all variables not declared ??? was this even tested in QB64pe IDE?

[PhilOfPerth]

Interestig - but variables across and down not defined.

[SMcNeill]

I added the two undeclared variables and gave this a run.   Have no idea what it was supposed to do.

CDE seemed to do *something* to zoom in or out or alter the image, but I have no idea what they do.  This seems rather complex with a lot of variables at work, and you'll need to go into better details for instructions as they're just not intuitive as to what the heck any keypress is supposed to be altering or accomplishing.