Hi folks,
Here's a real pixel grinding little program. I wrote this some time ago in IBasic - and then made a much faster version in IBPro.
This version takes a while to draw the images, since Creative doesn't (yet) have the 2D routines that would make the job a lot easier.
Anyway, this is the best I can do with the tools available ..
' Creative Kaleidoscope - GWS March 2009
'.......................................
def w:Window
def r,g,b,wstyle,i,j,k:int
def x,y,x1,x2,y2,dy,dx,delta,ymin:int
def xlow,xw,ys,yw,c,n:int
def lines,splots:int
def xl1,xl2,c1,c2:int
def xtm,xtp:int
wstyle = @SIZE|@MINBOX|@MAXBOX
window w, -800, 0, 800, 600, wstyle,0 ,"CB Kaleidoscope", handler
setwindowcolor w,rgb(0,0,0)
centerwindow w
CONTROL w,"B, Exit, 500, 520, 60, 30,@CTLBTNFLAT, 1"
CONTROL w,"B, Next, 220, 520, 60, 30,@CTLBTNFLAT, 2"
for i = 1 to 2
setcontrolcolor w,i,RGB(124,171,255),rgb(0,80,180)
next i
draw
WAITUNTIL w = 0
end
SUB handler
select @CLASS
case @IDCLOSEWINDOW
closewindow w
case @IDCONTROL
select @CONTROLID
' clicking the Exit button ...
case 1
closewindow w
case 2
' clicking the new image button ...
setwindowcolor w,rgb(0,0,0)
draw
endselect
endselect
return
sub draw
' draw origin zone ..
lines = rnd(20) + 5
for i = 1 to lines
r = rnd(255):g = rnd(255):b = rnd(255)
y = rnd(173) + 200
delta = 0.57735 * (y - 200)
x = 400 - delta + rnd(2 * delta)
splots = rnd(20)+ 5
for j = 1 to splots
dy = rnd(15)-rnd(15): y = y + dy
dx = rnd(15)-rnd(15): x = x + dx
ymin = 200 + 1.73 * abs(400-x)
if (y < ymin) then y = ymin
if (y > 373) then y = 373
xtm = 400 - delta
xtp = 400 + delta
if (x < xtm) then x = xtm
if (x > xtp) then x = xtp
pset w,x,y,rgb(r,g,b)
pset w,x-300,y-173,rgb(r,g,b)
pset w,x-300,y+173,rgb(r,g,b)
pset w,x+300,y-173,rgb(r,g,b)
pset w,x+300,y+173,rgb(r,g,b)
if (i%2 = 0)
for k = 1 to rnd(10)+ 10
x2 = x + rnd(10) - rnd(10)
y2 = y + rnd(10) - rnd(10)
ymin = 200 + 1.73 * abs(400-x2)
if (y2<ymin) then y2=ymin
if (y2>373) then y2=373
delta = 0.57735 * (y2 - 200)
xtm = 400 - delta
xtp = 400 + delta
if (x2 < xtm) then x2 = xtm
if (x2 > xtp) then x2 = xtp
line w,x,y,x2,y2,rgb(r,g,b)
line w,x-300,y-173,x2-300,y2-173,rgb(r,g,b)
line w,x-300,y+173,x2-300,y2+173,rgb(r,g,b)
line w,x+300,y-173,x2+300,y2-173,rgb(r,g,b)
line w,x+300,y+173,x2+300,y2+173,rgb(r,g,b)
next k
endif
next j
next i
' copy the origin ..
gosub inverse1
gosub reflect1
gosub reflect2
gosub inverse2
return
sub inverse1
' invert the origin zone ..
for i = 1 to 173
y = 200 + i
delta = 0.57735 * i + 0.5
n = 2 * delta
xlow = 400 - delta
yw = 546 - i
for j = 1 to n
x = xlow + j
c = getpixel(w,x,y)
if c
pset w,x,yw,c
pset w,x-300,yw-173,c
pset w,x+300,yw-173,c
pset w,x,yw-346,c
endif
next j
next i
return
sub inverse2
' invert an upper left reflected zone ..
for i = 1 to 173
y = 200 + i
delta = 0.57735 *(173-i) + 0.5
n = 2 * delta
xl1 = 300 - delta
xl2 = 500 - delta
yw = 200 - i
for j = 1 to n
x1 = xl1 + j
x2 = xl2 + j
c1 = getpixel(w,x1,y)
c2 = getpixel(w,x2,y)
if c1
pset w,x1,yw,c1
pset w,x1+300,yw+173,c1
pset w,x1,yw+346,c1
pset w,x1-300,yw+173,c1
endif
if c2
pset w,x2,yw,c2
pset w,x2+300,yw+173,c2
pset w,x2,yw+346,c2
pset w,x2-300,yw+173,c2
endif
next j
next i
return
sub reflect1
' reflect origin to upper right ..
for i = 1 to 200
dx = i / 2
ys = 373 - 0.866 * i
for k = 0 to i
y = ys + 0.866 * k + 0.5
x = 300 + dx + k/2 + 0.5
c = getpixel(w,x,y)
if c
xw = 600 - i + k/2
yw = 200 + 0.866 * k
pset w,xw,yw,c
pset w,xw-300,yw-173,c
pset w,xw-300,yw+173,c
pset w,xw+300,yw-173,c
pset w,xw+300,yw+173,c
endif
next k
next i
return
sub reflect2
' reflect origin to upper left ..
for i = 1 to 200
n = 200 - i
dx = n / 2
ys = 373 - 0.866 * n
for k = 0 to n
y = ys + 0.866 * k + 0.5
x = 500 - dx - k/2 + 0.5
c = getpixel(w,x,y)
if c
xw = 200 + n - k/2
yw = 200 + 0.866 * k
pset w,xw,yw,c
pset w,xw-300,yw-173,c
pset w,xw-300,yw+173,c
pset w,xw+300,yw-173,c
pset w,xw+300,yw+173,c
endif
next k
next i
return
best wishes, :)
Graham
ooooh, the colors ;D