Kaleidoscope

[GWS]

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 ..

Code Select Expand


' 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

[ZeroDog]

ooooh, the colors