OpenEuphoria

New Thread Dos Kaleidoscope -- View this CoJaBo

• Posted by Selgor Aug 02, 2010
• 2206 views

Hello
Selgor here

This is to thank you CoJaBo
You showed how it could be done

I changed values of variables

And the result is below.

Finished unless you see further modification ??

I have learned a lot.

Thank you. CoJaBo and all others (Don,Dan,Derek)

Cheers

Selgor

 
----------------------------------------------------- 
---------------------Windows Version  --------------- 
--------------------  Kaleidoscope  ----------------- 
--------------------    Version  2.01  -------------- 
--------------------      2nd August 2010  ---------- 
----------------------------------------------------- 
------- Many thanks to Don Cole 
-------                Dan Moyer 
-------                Derek Parnell 
------- Without Their help it would not have been completed 
----------------------------------------------------------- 
------- CoJaBo - Made it fullscreen and fixed various other minor errors 
-------  and Selgor made it Fullscreeen by changing variable values  
-------------------- not needing scaling 
------------------------------------------------------------------------- 
include win32lib.ew 
without warning 
 
atom kersa 
constant 
CXFULL=w32Func(xGetSystemMetrics,{SM_CXSCREEN}), 
CYFULL=w32Func(xGetSystemMetrics,{SM_CYSCREEN}), 
Win  = create(Window,"",0,0,0,CXFULL,CYFULL,{WS_POPUP,WS_DLGFRAME}) 
 
-- Create a canvas to draw upon. 
constant canvas = 
    create( Pixmap, "", 0, 0,0, CXFULL, CXFULL, 0 ) 
 
constant Timer = 1 
 
kersa = w32Func(xShowCursor,{False}) 
 
constant colors = { 
	Black, NavyBlue, Blue, BrightBlue, 
	ForestGreen, Green, Cyan, SkyBlue, 
	BrightGreen, BrightCyan, DarkGray, Eggplant, 
	Red, Magenta, DarkBrown, Olive, 
	Gray, Brown, LightGray, Purple, 
	White, BrightRed, BrightMagenta, Violet, 
	Orange, Pink, Yellow, BrightWhite  } 
 
atom     a,b,c,d,a1,b1,c1,d1,a2,b2,c2,d2,a3,b3,c3,d3, 
         x,y,x1,y1,xx,yy,xx1,yy1,xxx,yyy,xxx1,yyy1,xxxx,yyyy,xxxx1,yyyy1, 
         lt,tp,rt,bt,lt1,tp1,rt1,bt1,lt2,tp2,rt2,bt2,lt3,tp3,rt3,bt3, 
         kount,kcount,in,kcol 
 
integer segment 
 
procedure init_vars() 
	kount=0 
	kcol=rand(length(colors)) 
        kcount=0 
        segment = 0 
 
	lt=0 tp=0 bt=384 rt=512 
	lt1=512 tp1=0 bt1=384 rt1=1024 
	lt2=0 tp2=384 bt2=768 rt2=512 
	lt3=512 tp3=384 bt3=768 rt3=1024 
 
	x=384 x1=264 y=65 y1=285 
	xx=640 xx1=760 yy=65 yy1=285 
	xxx=384 xxx1=264 yyy=700 yyy1=480 
	xxxx=640 xxxx1=760 yyyy=700 yyyy1=480 
 
	a=1   b=1   c=2   d=1 
	a1=a  b1=b  c1=c  d1=d 
	a2=a  b2=b  c2=c  d2=d 
	a3=a  b3=b  c3=c  d3=d 
 
	setBackColor(canvas, Parchment)--(colors[rand(length(colors))])) 
 
end procedure 
 
procedure kullar() 
	if kcol >= length(colors) then 
		kcol = rand(length(colors)) 
	else 
		if remainder(segment, 50) = 0 then 
			kcol = rand(length(colors)) 
		end if 
	end if 
end procedure 
 
procedure val() 
     x-=a y-=b x1-=c y1-=d 
     xx+=a1 yy-=b1 xx1+=c1 yy1-=d1 
     xxx-=a2 yyy+=b2 xxx1-=c2 yyy1+=d2 
     xxxx+=a3 yyyy+=b3 xxxx1+=c3 yyyy1+=d3 
end procedure 
 
procedure xyopp() 
     if  x<lt or  x>rt then a=-a   end if 
     if  y<tp or  y>bt then b=-b   end if 
     if x1<lt or x1>rt then c=-c   end if 
     if y1<tp or y1>bt then d=-d   end if 
end procedure 
 
procedure xyopp2() 
     if  xx<lt1 or  xx>rt1 then a1=-a1   end if 
     if  yy<tp1 or  yy>bt1 then b1=-b1   end if 
     if xx1<lt1 or xx1>rt1 then c1=-c1   end if 
     if yy1<tp1 or yy1>bt1 then d1=-d1   end if 
end procedure 
 
procedure xyopp3() 
     if  xxx<lt2 or  xxx>rt2 then a2=-a2   end if 
     if  yyy<tp2 or  yyy>bt2 then b2=-b2   end if 
     if xxx1<lt2 or xxx1>rt2 then c2=-c2   end if 
     if yyy1<tp2 or yyy1>bt2 then d2=-d2   end if 
end procedure 
 
procedure xyopp4() 
     if  xxxx<lt3 or  xxxx>rt3 then a3=-a3   end if 
     if  yyyy<tp3 or  yyyy>bt3 then b3=-b3   end if 
     if xxxx1<lt3 or xxxx1>rt3 then c3=-c3   end if 
     if yyyy1<tp3 or yyyy1>bt3 then d3=-d3   end if 
end procedure 
 
 
integer stopped 
stopped = 0 
 
procedure WinKey(integer id, integer event, sequence parms) 
	-- Check for key presses. 
	if parms[1] = VK_SPACE then 
		stopped = not stopped 
		if stopped then 
			killTimer( Win, Timer ) 
		else 
			setTimer( Win, Timer, 10 ) 
		end if 
	elsif parms[1] = VK_ESCAPE then 
           closeWindow(Win) 
	   kersa = w32Func(xShowCursor,{True}) 
           init_vars() 
	   stopped = 0 
	end if 
 
end procedure 
setHandler(Screen, w32HKeyDown, routine_id("WinKey")) 
 
procedure draw_it(integer id, integer event, sequence parms) 
	-- On each tick of the timer, I draw the next segment of the picture. 
 
	if segment >= 800  then --650 then 
         segment=1 
		-- Maximum number of segments already drawn, 
		-- so do nothing. 
		 
 
--		setBackColor(canvas,(colors[rand(length(colors))])) 
		---- Use above to change Background 
		setBackColor(canvas,Parchment) 
                return 
	end if 
 
	segment += 1 
	kount+=1 
	kullar() 
	setPenColor(canvas,colors[kcol]) 
	drawLine(canvas,(x+a),(y+b),(x1+c),(y1+d)) 
	drawLine(canvas,(xxx+a2),(yyy+b2),(xxx1+c2),(yyy1+d2)) 
	drawLine(canvas,(xx+a1),(yy+b1),(xx1+c1),(yy1+d1)) 
	drawLine(canvas,(xxxx+a3),(yyyy+b3),(xxxx1+c3),(yyyy1+d3)) 
	val() xyopp() xyopp2() xyopp3() xyopp4() 
 
	-- Force the window to be redrawn. 
	repaintFG(Win) 
end procedure 
setHandler(Win, w32HTimer, routine_id( "draw_it" )) 
 
procedure start_it(integer id, integer event, sequence parms) 
	-- Start the timer ticking at 100 times per second 
	setTimer( Win, Timer, 10 ) 
end procedure 
setHandler(Win, w32HActivate, routine_id("start_it")) 
 
 
procedure paint_it(integer id, integer event, sequence parms) 
	-- Whenever the window needs to be repainted, 
	-- copy the picture to the window. 
	copyBlt(Win, 0, 0, canvas) 
 
	-- Refresh the 'help' text. 
--	wPuts( {Win, 10, 10}, "ESC to pause/continue  ENTER to restart") 
 
end procedure 
setHandler(Win, w32HPaint, routine_id("paint_it")) 
 
init_vars() 
WinMain( Win, Maximized) 
<eucode>