7 hours ago
well i wasn't eager to share this before, and i wanted to enclose a smaller version. but here goes. i will explain it below the source code.
this program requires the include file that is included in the attachment zip. when run this program requires "xaos" program included somewhere in your system path. this seems to be the home page for "xaos":
https://github.com/xaos-project/xaos/
this program attempts to create 100 png files as output. with each pass it calls upon "xaos" to create at least two files. it might reject one file created because it has one color or otherwise the png is too small to be taken seriously. if the two files are acceptable, they are combined into one picture which is saved as an output result. this program also creates xpf files sent to the "documents" directory. this is in case you happen upon a good output image and want to know how it was designed. there should be two xpf files per pass.
a document for "xaos" is created telling it what to draw and how. as it could be noticed by the include file, things could get fairly complicated. i have written other programs to go looking for viewpoints but it falls into black holes (totally clear color) too many times. i don't have knowledge nor patience for "heuristics" and they should be applied for each built-in fractal. meanwhile the "user" formulas are totally unpredictable. i have written a variation of this qb64 program which goes much further with the "user" formulas which were fabricated. however i still have to get good viewpoints for them.
indeed, i am posting this program, instead of the one i am actually working with, where i could add as many layouts as i want. i'm trying to hit 3000 as i'm writing this, but many of them are samey. many of them produce "color noise" without having to set a radius smaller than 1/100. also with this program i'm keeping to myself, a few "variables" are not changed, but it does focus on the palette and a few other things. an even earlier version than this program didn't combine images. it focused better on the "filters" like emboss and "palette emulation", which aren't really worth putting up with.
most of the viewpoints seem to be fixed but this program could mess about with them a bit. the code is not very good about it. in the giant select case inside the include file, indeed none of the viewpoints are expected to be further adjusted. zooming in (making radius approach zero) didn't go down as i expected and a disappointment. so i had to limit how it was being done. eventually i wrote a subprogram that forces a list of possible values for the radius.
the code having to do with "perturbation" is there because it was before i discovered this has to be figured out running "xaos" interactively. therefore, it could produce almost-clear-color images which will be rejected. this program does mess around with the palette but not in a very original manner. because "xaos" cannot be asked to draw a small range of iterations (especially to cut a lot of the blue out of a render with the "default" palette) then the programmer has to "cheat" by manipulating the palette, usually by choosing only two or three colors to set in particular registers. the other program prefers black as the first and last of 31 registers, other values causes it to crash which is not nice.
the routine to combine two images needs some sauce. in a variation of my program i have it call "imagemagick" to do it, also because it could produce smaller compressed jpeg files. took the opportunity to use special effects but became tired of it quickly. one great improvement is to employ many operations from "gimp" such as "dodge", "grain extract" and logic with "hsv" and the like. once i thought about creating a routine "sensitive" to transparency but things would have to be carried much farther than _clearcolor.
i cannot have "xaos" 4.3.3 at this time, i will need ubuntu "noble numbat" installed. i don't know if some of the bugs were fixed. it is very temperamental about the "user" formulas.
included in the attachment is a sample run of this program with ten images. they were converted to jpeg because the png files actually produced occupied four times as much disk space.
there are a lot of things to adjust in the code. before compiling and running this program, observe the file paths and change them to your liking. this program creates no directories, not even into the system temporary directory. the program attempts to create 100 png files and 200 xpf files (two text files per pass). change if it that's too much for you, because there's no easy way to break out of it. i thought about having it clean up and give up after it finds a sentinel file in the current directory it's running in. another thing: some layouts, especially involving the "user" formulas might take many minutes to render! so be patient.
mnrvovrfc-dxaos-ye.zip (Size: 2.97 MB / Downloads: 0)
Code: (Select All)
'by mnrvovrfc, began April-2024
$CONSOLE:ONLY
OPTION _EXPLICIT
DIM sf(1 TO 20) AS STRING, pals(1 TO 7) AS STRING, pald(1 TO 31) AS _BYTE
DIM spal(1 TO 10) AS STRING, paco(1 TO 2) AS STRING, vws(1 TO 3) AS STRING
DIM AS LONG fo, scr1, scr2, scr3, sizf1, sizf2, mustbeatleast
DIM AS INTEGER ii, ij, u, v, w, x, rr, gg, bb, rrm, ggm, bbm, lp
DIM AS INTEGER urr, ugg, ubb, vrr, vgg, vbb, jj, g, uv
dim as integer vl, vc, vx, vh, q, qq
DIM AS _BYTE pert, plane, zf, alterpal
DIM outf$, vw$, maxiter$, bailout$, julia1$, si$, form$, tmp1$, tmp2$
DIM purt$, palo$, file1$, file2$, file3$, cfile$, apath$, comd$
DIM afile$, basefile$, gle$, mysel$
DIM AS STRING endl, qu
redim vj(1 to 1) as integer
mustbeatleast = 40960
qu = CHR$(34)
endl = CHR$(10)
pald(31) = 7
'this might have to be changed:
$IF WIN THEN
apath$ = _dir$("TEMP")
$ELSE
'the above returns "/var/tmp" on my computer which is *not* user-writeable
apath$ = "/tmp"
$END IF
' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0
spal(1) = "1;2;1;2;3;1;2;3;4;1;2;3;4;5;1;2;3;4;5;1;2;3;4;1;2;3;1;2;1;6"
spal(2) = "1;1;1;1;1;1;2;2;3;1;1;1;1;1;2;2;2;4;1;1;1;1;1;1;2;2;2;2;5;6"
spal(3) = "1;2;3;4;1;1;1;1;1;1;2;5;1;1;1;1;1;2;2;4;1;1;1;1;1;2;2;2;3;6"
spal(4) = "1;1;1;1;1;1;1;2;2;2;2;1;1;1;1;3;2;2;2;2;4;1;1;1;1;5;2;2;2;6"
spal(5) = "1;1;1;1;1;2;3;4;5;1;1;1;1;1;1;2;3;4;5;1;1;1;1;1;1;2;3;4;5;6"
spal(6) = "1;1;1;1;1;1;1;1;1;1;2;3;4;5;6;1;1;1;1;1;2;3;4;5;6;1;1;1;1;1"
spal(7) = "1;1;1;1;1;1;1;1;1;1;2;3;4;5;6;1;1;1;1;1;1;1;1;1;1;2;3;4;5;6"
spal(8) = "1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;2;3;4;5;6"
spal(9) = "1;1;1;1;1;1;1;2;3;4;1;1;1;1;1;1;1;2;3;4;1;1;1;1;1;2;3;4;5;6"
spal(10) = "1;1;1;1;1;2;2;2;2;1;1;1;1;1;3;3;3;1;1;1;1;4;4;1;1;1;5;5;1;6"
paco(1) = "(palettecolors ~000000~ ~@~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ " +_
"~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ " +_
"~000000~ ~!~ ~000000~ ~000000~)" + endl + "(shiftpalette #)"
paco(2) = "(palettecolors ~000000~ ~@~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ " +_
"~000000~ ~000000~ ~$~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ ~000000~ " +_
"~000000~ ~!~ ~000000~ ~000000~)" + endl + "(shiftpalette #)"
ReplaceString2 paco(1), "~", qu, 0
ReplaceString2 paco(2), "~", qu, 0
RANDOMIZE TIMER
if not _direxists(apath$) then SHELL "mkdir " + apath$
apath$ = apath$ + "/"
FOR w = 1 TO 100
$IF WIN THEN
cfile$ = ENVIRON$("USERPROFILE") + "\Pictures\dumbxaos" + Zeroes$(w, 3) + ".png"
$ELSE
cfile$ = ENVIRON$("HOME") + "/Pictures/dumbxaos" + Zeroes$(w, 3) + ".png"
$END IF
file1$ = apath$ + "dumbxaosa" + Zeroes$(w, 3) + "000000.png"
file2$ = apath$ + "dumbxaosb" + Zeroes$(w, 3) + "000000.png"
afile$ = apath$ + "dumbxaosc" + Zeroes$(w, 3) + ".png"
FOR jj = 1 TO 2
basefile$ = apath$ + "dumbxaos" + CHR$(96 + jj) + Zeroes$(w, 3)
DO
'blank out document
FOR ii = 1 TO 20
sf(ii) = ""
NEXT
'initialize palette (code modified later)
rr = Rand(96, 192)
gg = Rand(112, 224)
bb = Rand(144, 255)
DO
urr = Rand(48, 192)
ugg = Rand(48, 192)
ubb = Rand(48, 192)
LOOP UNTIL (ABS(urr - ugg) > 32) AND (ABS(ubb - ugg) > 32) AND (ABS(urr - ubb) > 32)
IF Random1(2) = 1 THEN SWAP rr, gg
IF Random1(2) = 1 THEN SWAP bb, gg
IF Random1(2) = 1 THEN SWAP rr, bb
IF Random1(2) = 1 THEN SWAP bb, gg
alterpal = 0
IF jj = 1 AND Random1(7) = 1 THEN
alterpal = 1
DO
vrr = Rand(48, 248)
vgg = Rand(48, 248)
vbb = Rand(48, 248)
LOOP UNTIL (ABS(vrr - vgg) > 48) AND (ABS(vbb - vgg) > 48) AND (ABS(vrr - vbb) > 48)
palo$ = "(defaultpalette 0)" + endl + paco(Random1(2))
tmp1$ = LCASE$(Zeroes$(rr, -2)) + LCASE$(Zeroes$(gg, -2)) + LCASE$(Zeroes$(bb, -2))
ReplaceString2 palo$, "!", tmp1$, 1
tmp1$ = LCASE$(Zeroes$(urr, -2)) + LCASE$(Zeroes$(ugg, -2)) + LCASE$(Zeroes$(ubb, -2))
ReplaceString2 palo$, "@", tmp1$, 1
tmp1$ = LCASE$(Zeroes$(vrr, -2)) + LCASE$(Zeroes$(vgg, -2)) + LCASE$(Zeroes$(vbb, -2))
ReplaceString2 palo$, "$", tmp1$, 1
tmp1$ = LTRIM$(STR$(Rand(-20, 5)))
ReplaceString2 palo$, "#", tmp1$, 1
ELSE
ij = Rand(2, 6)
FOR ii = 1 TO 6
IF ii > 1 THEN
rrm = (Random1(2) - 1) * 2 - 1
ggm = (Random1(2) - 1) * 2 - 1
bbm = (Random1(2) - 1) * 2 - 1
x = Rand(10, 24) * 2 * rrm
rr = rr + x
IF rr < 0 THEN rr = urr
IF rr > 255 THEN rr = urr
x = Rand(10, 24) * 2 * rrm
gg = gg + x
IF gg < 0 THEN gg = ugg
IF gg > 255 THEN gg = ugg
x = Rand(10, 24) * 2 * rrm
bb = bb + x
IF bb < 0 THEN bb = ubb
IF bb > 255 THEN bb = ubb
END IF
IF ii = ij THEN
pals(ii) = " " + qu + LCASE$(Zeroes(Rand(64, 192), -2)) + LCASE$(Zeroes(Rand(64, 192), -2)) + _
LCASE$(Zeroes(Rand(64, 192), -2)) + qu
ELSE
pals(ii) = " " + qu + LCASE$(Zeroes$(rr, -2)) + LCASE$(Zeroes$(gg, -2)) + LCASE$(Zeroes$(bb, -2)) + qu
END IF
NEXT
tmp1$ = spal(Random1(10))
lp = Random1(45) - 15
IF lp < 1 THEN lp = 1
FOR ii = 1 TO 30
pald(ii) = VAL(SSelect$(tmp1$, lp))
lp = lp + 1
IF lp > 30 THEN lp = 1
NEXT
IF w MOD 2 = 0 THEN
pals(7) = " " + qu + "808080" + qu + ")"
ELSE
pals(7) = " " + qu + "ffffff" + qu + ")"
END IF
palo$ = "(defaultpalette 0)" + endl + "(palettecolors"
FOR ii = 1 TO 31
palo$ = palo$ + pals(pald(ii))
NEXT
END IF
'set a few variables before formula junk
pert = 0
plane = 0
julia1$ = ""
form$ = ""
gle$ = ""
zf = 1
'$INCLUDE: 'dxaos-select-old.bi'
'formula junk
v = 0
v = v + 1
sf(v) = palo$
IF julia1$ <> "" THEN
v = v + 1
sf(v) = "(formula 'mandel)"
ELSEIF form$ = "" THEN
v = v + 1
sf(v) = "(formula 'user)"
v = v + 1
SELECT CASE zf
CASE 1
sf(v) = "(usrform " + qu + "((abs(re(z))+i+c)*abs(im(z)))^2" + qu + ")"
CASE 2
sf(v) = "(usrform " + qu + "(abs(re(z))+i*abs(im(z)))^2+c" + qu + ")"
CASE 3
sf(v) = "(usrform " + qu + "(abs(re(z))+i*abs(im(z)))^2+c" + qu + ")" + endl + "(usrformInit " + qu + si$ + qu + ")"
CASE 4
sf(v) = "(usrform " + qu + "abs(c+i*re(z))^2+im(z)" + qu + ")" + endl + "(usrformInit " + qu + si$ + qu + ")"
CASE 5
sf(v) = "(usrform " + qu + "abs(exp(re(z))*c)+abs(im(z))+i" + qu + ")" + endl + "(usrformInit " + qu + si$ + qu + ")"
END SELECT
ELSE
v = v + 1
sf(v) = form$
END IF
IF julia1$ <> "" THEN
v = v + 1
sf(v) = julia1$
END IF
IF pert = 1 THEN
v = v + 1
sf(v) = "(perturbation " + generateridiculousnumber$ + " " + generateridiculousnumber$ + ")"
ELSEIF pert = 2 THEN
IF Random1(2) = 1 THEN
tmp1$ = generateasininenumber$(28)
ELSE
tmp1$ = generateasininenumber$(37)
END IF
tmp2$ = generateridiculousnumber$
IF Random1(2) = 1 THEN SWAP tmp1$, tmp2$
v = v + 1
sf(v) = "(perturbation " + tmp1$ + " " + tmp2$ + ")"
ELSEIF pert = 3 THEN
v = v + 1
sf(v) = purt$
END IF
v = v + 1
IF gle$ = "" THEN
sf(v) = "(angle " + LTRIM$(STR$(Random1(178) - 89)) + ")"
ELSE
sf(v) = gle$
END IF
v = v + 1
sf(v) = "(maxiter " + Choice$(maxiter$) + ")"
v = v + 1
IF bailout$ <> "" THEN
sf(v) = "(bailout " + Choice$(bailout$) + ")"
END IF
IF plane > 0 THEN
v = v + 1
sf(v) = "(plane " + LTRIM$(STR$(plane)) + ")"
END IF
IF alterpal THEN
x = Random1(10) * 3
IF x = 6 OR x = 9 THEN
v = v + 1
sf(v) = "(outcoloring" + STR$(Random1(x)) + ")"
ELSEIF x = 3 THEN
v = v + 1
sf(v) = "(outcoloring 10)" + endl + "(outtcoloring 0)"
v = v + 1
sf(v) = "(incoloring 10)" + endl + "(intcoloring" + STR$(Random1(10)) + ")"
END IF
ELSE
IF Random1(2) = 1 THEN
v = v + 1
x = Random1(7)
SELECT CASE x
CASE 7
sf(v) = "(outcoloring 10)" + endl + "(outtcoloring" + STR$(Random1(10)) + ")"
CASE ELSE
sf(v) = "(outcoloring" + STR$(Random1(x)) + ")"
END SELECT
END IF
IF Random1(2) = 1 THEN
v = v + 1
x = Random1(10)
SELECT CASE x
CASE 10
sf(v) = "(incoloring 10)" + endl + "(intcoloring" + STR$(Random1(6)) + ")"
CASE ELSE
sf(v) = "(incoloring" + STR$(Random1(x)) + ")"
END SELECT
END IF
END IF
IF julia1$ <> "" THEN
v = v + 1
sf(v) = "(julia #t)"
END IF
v = v + 1
sf(v) = vw$
'create output file
$IF WIN THEN
outf$ = ENVIRON$("USERPROFILE") + "\Documents\dumbxaos" + CHR$(96 + jj) + Zeroes$(w, 3) + ".xpf"
$ELSE
outf$ = ENVIRON$("HOME") + "/Documents/dumbxaos" + CHR$(96 + jj) + Zeroes$(w, 3) + ".xpf"
$END IF
fo = FREEFILE
OPEN outf$ FOR OUTPUT AS fo
PRINT #fo, "(initstate)"; endl;
FOR ii = 1 TO 20
IF sf(ii) <> "" THEN PRINT #fo, sf(ii); endl;
NEXT
CLOSE fo
comd$ = "xaos -render " + outf$ + " -basename " + basefile$ + _
" -size 1366x768 -renderimage Truecolor -renderframerate 1.0 -range 3 -inhibittextoutput"
SHELL comd$
_DEST _CONSOLE
'this really sucks, I didn't want to do this:
IF jj = 1 THEN sizf1 = filesize(file1$) ELSE sizf1 = filesize(file2$)
IF sizf1 < 1 THEN
PRINT "*** FATAL ERROR! Xaos did not produce output."
SYSTEM
END IF
LOOP UNTIL sizf1 >= mustbeatleast
vj(vh) = 0
'here instead of in include file:
vc = vc + 1
NEXT 'jj
sizf1 = 0
sizf2 = 0
_DEST _CONSOLE
scr1 = _LOADIMAGE(file1$, 32)
IF scr1 >= -1 THEN
PRINT "*** FATAL ERROR! Cannot load the first image."
SYSTEM
END IF
scr2 = _LOADIMAGE(file2$, 32)
IF scr2 >= -1 THEN
_FREEIMAGE scr1
PRINT "*** FATAL ERROR! Cannot load the other image."
SYSTEM
END IF
scr3 = _NEWIMAGE(1366, 768, 32)
IF scr3 >= -1 THEN
_FREEIMAGE scr2
_FREEIMAGE scr1
PRINT "*** FATAL ERROR! Cannot load create output image buffer."
SYSTEM
END IF
avgcombine scr1, scr2, scr3
_SAVEIMAGE afile$, scr3
sizf1 = filesize(afile$)
_FREEIMAGE scr3
_FREEIMAGE scr2
_FREEIMAGE scr1
_DEST _CONSOLE
IF sizf1 < 1 THEN
PRINT "*** Combination failed! Giving up."
SYSTEM
END IF
mycopyfile afile$, cfile$
PRINT "Created: "; cfile$
'this might have to be adjusted. stuff *does* build up!
IF (w - 1) MOD 50 = 0 THEN GOSUB cleanup
NEXT 'w
GOSUB cleanup
PRINT "FINISHED"
SYSTEM
cleanup:
PRINT: PRINT "Cleaning up..."
FOR g = 1 TO 200
file1$ = apath$ + "dumbxaosa" + Zeroes$(g, 3) + "000000.png"
file2$ = apath$ + "dumbxaosb" + Zeroes$(g, 3) + "000000.png"
file3$ = apath$ + "dumbxaosc" + Zeroes$(g, 3) + ".png"
IF _FILEEXISTS(file1$) THEN KILL file1$
IF _FILEEXISTS(file2$) THEN KILL file2$
IF _FILEEXISTS(file3$) THEN KILL file3$
NEXT
PRINT
RETURN
FUNCTION generateridiculousnumber$ ()
DIM sfmt$, x AS INTEGER
x = Random1(19)
IF x < 10 THEN sfmt$ = "-0." ELSE sfmt$ = "0."
IF x = 19 THEN
generateridiculousnumber$ = "0"
ELSE
x = ((x - 1) MOD 9) + 1
sfmt$ = sfmt$ + Repeat$(10, LTRIM$(STR$(x)))
generateridiculousnumber$ = sfmt$
END IF
END FUNCTION
'recommended for "octo" formula
FUNCTION generateasininenumber$ (mil AS INTEGER)
DIM sfmt$, x AS INTEGER, y AS INTEGER
x = Random1(mil)
IF x = mil THEN
generateasininenumber$ = "0"
EXIT FUNCTION
ELSEIF x < 19 THEN
IF x < 10 THEN sfmt$ = "-0.0" ELSE sfmt$ = "0.0"
y = 10
ELSE
IF x < 28 THEN sfmt$ = "-0.1" ELSE sfmt$ = "0.1"
y = 9
END IF
x = ((x - 1) MOD 9) + 1
sfmt$ = sfmt$ + Repeat$(y, LTRIM$(STR$(x)))
generateasininenumber$ = sfmt$
END FUNCTION
FUNCTION fractview$ (xx AS DOUBLE, yy AS DOUBLE, xr AS DOUBLE, dum0 AS DOUBLE)
DIM AS DOUBLE x, y
DIM sret$
x = xx + (Rand(-500, 50) / 1000)
y = yy + (Rand(-500, 500) / 1000)
sret$ = "(view " + N2S$(x) + " " + N2S$(y) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
fractview$ = sret$
END FUNCTION
FUNCTION fractview2$ (xx AS DOUBLE, yy AS DOUBLE, xr AS DOUBLE, dum0 AS DOUBLE)
DIM AS DOUBLE x, y
DIM sret$
x = xx + (Rand(-1000, 500) / 1000)
y = yy + (Rand(-1000, 500) / 1000)
sret$ = "(view " + N2S$(x) + " " + N2S$(y) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
fractview2$ = sret$
END FUNCTION
'(x1,y1) should be the range point, and (x2,y2) should be in the rest of the (view) expression.
FUNCTION varyview$ (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, xr AS DOUBLE, weigh AS _BYTE)
DIM AS LONG x3, x4, y3, y4
DIM sret$
IF Random1(weigh) = 1 THEN
sret$ = "(view " + N2S$(x2) + " " + N2S$(y2) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
ELSE
x3 = _CEIL(x1 * 10000)
x4 = _CEIL(x2 * 10000)
IF x3 > x4 THEN SWAP x3, x4
y3 = _CEIL(y1 * 10000)
y4 = _CEIL(y2 * 10000)
IF y3 > y4 THEN SWAP y3, y4
sret$ = "(view " + N2S$(Rand(x3, x4) / 10000) + " " + N2S$(Rand(y3, y4) / 10000) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
END IF
varyview$ = sret$
END FUNCTION
'the same as previous but allows also to zoom in and out
'just set the first two parameters to zero
' the two other (x,y) should be the first two parameters from a (view) expression.
FUNCTION varyradius$ (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, varyrange AS STRING)
DIM AS LONG x3, x4, y3, y4
DIM sret$, xr AS DOUBLE
xr = VAL(Choice$(varyrange))
x3 = _CEIL(x1 * 1000000)
y3 = _CEIL(y1 * 1000000)
IF x3 = 0 AND y3 = 0 THEN
sret$ = "(view " + N2S$(x2) + " " + N2S$(y2) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
ELSE
x3 = _CEIL(x1 * 10000)
x4 = _CEIL(x2 * 10000)
IF x3 > x4 THEN SWAP x3, x4
y3 = _CEIL(y1 * 10000)
y4 = _CEIL(y2 * 10000)
IF y3 > y4 THEN SWAP y3, y4
sret$ = "(view " + N2S$(Rand(x3, x4) / 10000) + " " + N2S$(Rand(y3, y4) / 10000) + " " + N2S$(xr) + " " + N2S$(xr) + ")"
END IF
varyradius$ = sret$
END FUNCTION
sub avgcombine (p1 as long, p2 as long, outp as long)
dim as long c1, c2
dim as integer r1, g1, b1, r2, g2, b2, xx, yy, ht, wd
_dest outp
wd = _width(outp)
ht = _height(outp)
for yy = 0 to ht - 1
for xx = 0 to wd - 1
_source p1
c1 = point(xx, yy)
_source p2
c2 = point(xx, yy)
r1 = _red(c1)
g1 = _green(c1)
b1 = _blue(c1)
r2 = _red(c2)
g2 = _green(c2)
b2 = _blue(c2)
r1 = (r1 + r2) \ 2
g1 = (g1 + g2) \ 2
b1 = (b1 + b2) \ 2
c1 = _rgba(r1, g1, b1, 255)
pset(xx, yy), c1
next
next
end sub
'Sadly, a file "exists" if it has size of zero,
' so this condition has to be accounted for.
'Because some applications actually indicate things
' with zero-length files.
'Otherwise, to me, a file with size of zero doesn't exist.
' (there's NOTHING on it, what is existence then?)
'might have to be revised for windows.
FUNCTION filesize& (afile$)
STATIC AS LONG fo, iret
iret = -2
IF afile$ <> "" THEN
IF _FILEEXISTS(afile$) THEN
fo = FREEFILE
OPEN afile$ FOR BINARY AS fo
iret = LOF(fo)
CLOSE fo
ELSE
iret = -1
END IF
END IF
filesize& = iret
END FUNCTION
sub mycopyfile (srcefile as string, destfile as string)
dim a$
dim as long f1, f2
f1 = freefile
open srcefile for binary as f1
f2 = freefile
open destfile for binary as f2
a$ = space$(lof(f1))
get #f1, , a$
put #f2, , a$
close f2
close f1
$IF LINUX THEN
shell _hide "sync"
$END IF
end sub
function items10$(startval as double)
dim sret$, x as double, y as double, i as integer
x = startval
y = startval
for i = 1 to 9
sret$ = sret$ + N2S$(x) + ";"
x = x + y
next
sret$ = sret$ + N2S$(x)
items10$ = sret$
end function
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
FUNCTION Repeat$ (num%, tx$)
DIM a$, lx&, cp&, j%
a$ = ""
IF (num% > 0) AND (tx$ <> "") THEN
lx& = LEN(tx$)
cp& = 1
a$ = SPACE$(lx& * num%)
FOR j% = 1 TO num%
MID$(a$, cp&, lx&) = tx$
cp& = cp& + lx&
NEXT
END IF
Repeat$ = a$
END FUNCTION
FUNCTION Zeroes$ (num AS LONG, numdig AS INTEGER)
DIM b$, v AS LONG
DIM AS INTEGER sg, hx
IF num < 0 THEN sg = -1: num = num * -1
IF numdig < 0 THEN hx = 1: numdig = numdig * -1 ELSE hx = 0
IF hx THEN
b$ = HEX$(num)
ELSE
b$ = LTRIM$(STR$(num))
END IF
v = numdig - LEN(b$)
IF v > 0 THEN b$ = STRING$(v, 48) + b$
IF sg = -1 THEN b$ = "-" + b$
Zeroes$ = b$
END FUNCTION
FUNCTION Choice$ (tx$)
DIM AS LONG y, z
IF tx$ = "" THEN
Choice$ = ""
EXIT FUNCTION
END IF
z = CountString(tx$, ";")
IF z = 0 THEN
Choice$ = tx$
EXIT FUNCTION
END IF
z = z + 1
y = Random1&(z)
Choice$ = SSelect$(tx$, y)
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 SSelect$ (tx$, valu%)
SSelect$ = FieldString$(tx$, valu%, ";")
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
'by S.McNeill, modified by me a bit such as having it take
' a double-float instead of *another* string. (roll eyes)
'One thing that HAS NEVER BEEN FIXED, UNTIL NOW,
' is changing "D+" or "D-" that BASIC puts in for some reason unknown
' to me, to "E+" or "E-" that almost everything else recognizes.
'newscinot$() from other program deemed not good enough for these purposes, had to borrow help LOL.
FUNCTION N2S$ (num AS DOUBLE)
DIM l$, r$, t$, sign$, hexp$, r&&
DIM AS LONG dp, dm, ep, em, l, i
DIM AS INTEGER check1
t$ = LTRIM$(STR$(num))
hexp$ = t$
IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
IF check1 <> 1 THEN
l$ = hexp$
dp = INSTR(l$, "D+"): dm = INSTR(l$, "D-")
if dp > 0 then
mid$(l$, dp, 1) = "E"
elseif dm > 0 then
mid$(l$, dm, 1) = "E"
end if
IF LEFT$(l$, 1) = "." THEN
l$ = "0" + l$
ELSEIF LEFT$(l$, 2) = "-." THEN
l$ = "-0" + MID$(l$, 2)
END IF
N2S = l$
EXIT FUNCTION
END IF
SELECT CASE l
CASE IS < dp: l = dp
CASE IS < dm: l = dm
CASE IS < ep: l = ep
CASE IS < em: l = em
END SELECT
l$ = LEFT$(t$, l - 1)
r$ = MID$(t$, l + 1): r&& = VAL(r$)
IF INSTR(l$, ".") THEN
IF r&& > 0 THEN
r&& = r&& - LEN(l$) + 2
ELSE
r&& = r&& + 1
END IF
l$ = LEFT$(l$, 1) + MID$(l$, 3)
END IF
SELECT CASE r&&
CASE 0
'l$ = l$
CASE IS < 0
FOR i = 1 TO -r&&
l$ = "0" + l$
NEXT
l$ = "0." + l$
CASE ELSE
FOR i = 1 TO r&&
l$ = l$ + "0"
NEXT
END SELECT
N2S$ = sign$ + l$
END FUNCTIONthis program requires the include file that is included in the attachment zip. when run this program requires "xaos" program included somewhere in your system path. this seems to be the home page for "xaos":
https://github.com/xaos-project/xaos/
this program attempts to create 100 png files as output. with each pass it calls upon "xaos" to create at least two files. it might reject one file created because it has one color or otherwise the png is too small to be taken seriously. if the two files are acceptable, they are combined into one picture which is saved as an output result. this program also creates xpf files sent to the "documents" directory. this is in case you happen upon a good output image and want to know how it was designed. there should be two xpf files per pass.
a document for "xaos" is created telling it what to draw and how. as it could be noticed by the include file, things could get fairly complicated. i have written other programs to go looking for viewpoints but it falls into black holes (totally clear color) too many times. i don't have knowledge nor patience for "heuristics" and they should be applied for each built-in fractal. meanwhile the "user" formulas are totally unpredictable. i have written a variation of this qb64 program which goes much further with the "user" formulas which were fabricated. however i still have to get good viewpoints for them.
indeed, i am posting this program, instead of the one i am actually working with, where i could add as many layouts as i want. i'm trying to hit 3000 as i'm writing this, but many of them are samey. many of them produce "color noise" without having to set a radius smaller than 1/100. also with this program i'm keeping to myself, a few "variables" are not changed, but it does focus on the palette and a few other things. an even earlier version than this program didn't combine images. it focused better on the "filters" like emboss and "palette emulation", which aren't really worth putting up with.
most of the viewpoints seem to be fixed but this program could mess about with them a bit. the code is not very good about it. in the giant select case inside the include file, indeed none of the viewpoints are expected to be further adjusted. zooming in (making radius approach zero) didn't go down as i expected and a disappointment. so i had to limit how it was being done. eventually i wrote a subprogram that forces a list of possible values for the radius.
the code having to do with "perturbation" is there because it was before i discovered this has to be figured out running "xaos" interactively. therefore, it could produce almost-clear-color images which will be rejected. this program does mess around with the palette but not in a very original manner. because "xaos" cannot be asked to draw a small range of iterations (especially to cut a lot of the blue out of a render with the "default" palette) then the programmer has to "cheat" by manipulating the palette, usually by choosing only two or three colors to set in particular registers. the other program prefers black as the first and last of 31 registers, other values causes it to crash which is not nice.
the routine to combine two images needs some sauce. in a variation of my program i have it call "imagemagick" to do it, also because it could produce smaller compressed jpeg files. took the opportunity to use special effects but became tired of it quickly. one great improvement is to employ many operations from "gimp" such as "dodge", "grain extract" and logic with "hsv" and the like. once i thought about creating a routine "sensitive" to transparency but things would have to be carried much farther than _clearcolor.
i cannot have "xaos" 4.3.3 at this time, i will need ubuntu "noble numbat" installed. i don't know if some of the bugs were fixed. it is very temperamental about the "user" formulas.
included in the attachment is a sample run of this program with ten images. they were converted to jpeg because the png files actually produced occupied four times as much disk space.
there are a lot of things to adjust in the code. before compiling and running this program, observe the file paths and change them to your liking. this program creates no directories, not even into the system temporary directory. the program attempts to create 100 png files and 200 xpf files (two text files per pass). change if it that's too much for you, because there's no easy way to break out of it. i thought about having it clean up and give up after it finds a sentinel file in the current directory it's running in. another thing: some layouts, especially involving the "user" formulas might take many minutes to render! so be patient.
mnrvovrfc-dxaos-ye.zip (Size: 2.97 MB / Downloads: 0)