+- 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: symmetric craziness out of one image (/showthread.php?tid=4087)
symmetric craziness out of one image - hsiangch_ong - 11-07-2025
this program displays images. derrived from a larger image. it takes a section of the input image. which is a small rectangle. then does symmetric business on it. the image that is shown by the source code. is hardcoded to the dimensions of my laptop screen. feel free to change it for your tastes.
if you don't like the symmetric setup. that could be changed too. the way the code stands. could produce many interesting pictures. another flaw might be. a mini-picture is created. so it is flipped and spread into the four quadrants of the output screen. the "normal" quadrant is the fourth. the bottom-right side. so the mini-picture will be clipped off the right-hand side and the bottom.
each variation is shown for one second. it could cause hundreds of variations. press escape, hold for at least 1 second to quit.
if kthresh variable value is changed. so it is larger. it could produce less variations. do not set it to zero or a small positive value. the rule set in the code. is 32 entire lines from the input image. from 2732x1536 image. it should produce almost a thousand variations. approximately 85% of them. which aren't dominated by large black blocks. a proposal is offered somewhere in the code. i preferred to leave it. so that more interest is produced.
that said. do not try this program. if you could suffer an epileptic seizure. or if you could become violent. watching certain patterned graphics on a computer screen with bright colors! i will not be held responsible. nor the other members of this forum. for health conditions. caused by the inability to use this product.
the routine is supposed to divide the large image. into many small rectangles. from 80x80 to 200x200. which don't intersect with one another. that way it could work toward the threshold faster.
i have enclosed a png file for you to play with. it's almost 10mib!
Code: (Select All)
option _explicit
dim as integer x1, y1, x2, y2, x, y, wd, ht, wdin, htin, wdqu, htqu, wdmy, htmy
dim as long inpic, depic, qupic, mypic, kount, ku, black, kthresh
dim afile$, r1 as _byte, r2 as _byte
'change this to half the size of the output screen:
wdqu = 683 : htqu = 384
'change this to the size of the output screen you desire:
wdmy = 1366 : htmy = 768
randomize val(right$(time$, 2))
$IF WIN THEN
afile$ = environ$("USERPROFILE") + "/Pictures"
'i'm sorry, i don't know the "main path" on macos
$ELSE
afile$ = environ$("HOME") + "/Pictures"
$END IF
afile$ = _openfiledialog$("Please choose a PNG image file.", afile$, "*.png", "PNG FILE")
if afile$ = "" then system
inpic = _loadimage(afile$, 32)
if inpic >= -1 then
_messagebox "my program", "The image file requested could not be loaded!", "error"
system
end if
wdin = _width(inpic)
htin = _height(inpic)
dim o(0 to htin - 1, 0 to wdin - 1) as _bit
qupic = _newimage(wdqu, htqu, 32)
mypic = _newimage(wdmy, htmy, 32)
screen mypic
black = _rgba(0, 0, 0, 255)
kount = wdin * htin
kthresh = wdin * 32
do
x1 = Random1(wdin - 80)
y1 = Random1(htin - 80)
if x1 >= wdin - 200 then
x2 = wdin - x1 - 1
else
x2 = x1 + Rand(80, 200)
end if
if y1 >= htin - 200 then
y2 = htin - y1 - 1
else
y2 = y1 + Rand(80, 200)
end if
ku = kount
for y = y1 to y2
for x = x1 to x2
if o(y, x) = 0 then
ku = ku - 1
end if
next
next
if ku < kount then
kount = ku
wd = x2 - x1 + 1
ht = y2 - y1 + 1
depic = _newimage(wd, ht, 32)
_putimage(0, 0)-step(wd, ht), inpic, depic, (x1, y1)-(x2 - 1, y2 - 1)
_dest depic
for y = y1 to y2
for x = x1 to x2
if o(y, x) then
'change this line:
pset(x, y), black
'to:
'pset(x - x1, y - y1), black
'if you want to see more large black blocks!
else
o(y, x) = 1
end if
next
next
x = 0 : r1 = 0 : r2 = 0
do until x > wdqu
y = 0
do until y > htqu
if r1 then
if r2 then
_putimage(x, y)-step(wd, ht), depic, qupic, (0, 0)-(wd - 1, ht - 1)
else
_putimage(x, y)-step(wd, ht), depic, qupic, (wd - 1, 0)-(0, ht - 1)
end if
else
if r2 then
_putimage(x, y)-step(wd, ht), depic, qupic, (wd - 1, ht - 1)-(0, 0)
else
_putimage(x, y)-step(wd, ht), depic, qupic, (0, ht - 1)-(wd - 1, 0)
end if
end if
r1 = not r1
y = y + ht
loop
r2 = not r2
x = x + wd
loop
wd = wdqu : ht = htqu
_putimage(0, 0)-(wdqu - 1, htqu - 1), qupic, mypic, (0, 0)-(wd - 1, ht - 1)
_putimage(wdqu, 0)-(wdmy - 1, htqu - 1), qupic, mypic, (wd - 1, 0)-(0, ht - 1)
_putimage(wdqu, htqu)-(wdmy - 1, htmy - 1), qupic, mypic, (wd - 1, ht - 1)-(0, 0)
_putimage(0, htqu)-(wdqu - 1, htmy - 1), qupic, mypic, (0, ht - 1)-(wd - 1, 0)
_display
_title "PRESS ESC TO QUIT. threshold =" + str$(kthresh) + " || kount =" + str$(kount)
_delay 1
if _keydown(27) then exit do
_dest mypic
_freeimage depic
end if
loop until kount < kthresh
do : _limit 100 : loop while _keydown(27)
_keyclear
_freeimage qupic
_freeimage inpic
system
FUNCTION Rand& (fromval&, toval&)
DIM f&, t&
IF fromval& = toval& THEN
Rand& = fromval&
EXIT FUNCTION
END IF
f& = fromval&
t& = toval&
IF f& > t& THEN SWAP f&, t&
Rand& = INT(RND * (t& - f& + 1) + f&)
END FUNCTION
FUNCTION Random1& (maxvaluu&)
Random1& = INT(RND * maxvaluu& + 1)
END FUNCTION
hsiangch_ong-month-backflip.zip (Size: 9.52 MB / Downloads: 40)
RE: symmetric craziness out of one image - bplus - 11-07-2025
+1 Wild! works well with image from Candy Corn Trees!