Kaleidoscope

[GWS]

Hi folks ..ÂÃ, 

Here's another port of a program I did a while back ..

Code Select Expand


'..............................................................
' EB Kaleidoscope - Dec 2006 - GWS
'..............................................................
'
int x,y,i,j,k,dx,dy,xtm,xtp,splots,r,g,b,mx,my
int test1,test2,test3,stopit,another,querymouse
pointer sprite1,sprite2,sprite3,sprite4,sprite5,sprite6
pointer s1copy,s2copy,spriten,spritex
float pi,d2r

autodefine "OFF"

pi = 4 * atan(1)
d2r = pi / 180
stopit = 0
another = 0
querymouse = 1

if CREATESCREEN(800,600,32,&screenhandler) < 0
ÂÃ,  MESSAGEBOX 0,"Error creating screen","Error"
ÂÃ,  END
endif
Fillscreen RGB(0,0,0), FrontBuffer

FRONTPEN BackBuffer,RGB(100,100,240)
BACKPEN BackBuffer, RGB(50,50,100)

sprite1 = CREATESPRITE(200,173,1,1)
sprite2 = CREATESPRITE(200,173,1,1)
s1copy = CREATESPRITE(200,173,1,1)
sprite3 = CREATESPRITE(200,173,1,1)
sprite4 = CREATESPRITE(200,173,1,1)
s2copy = CREATESPRITE(200,173,1,1)
sprite5 = CREATESPRITE(200,173,1,1)
sprite6 = CREATESPRITE(200,173,1,1)

gosub NewPattern

'create simulated buttons ..
spriten = CREATESPRITE(100,25,1,1)
spritetobuffer spriten
'Fillscreen RGB(0,0,0), SpriteBuffer
DRAWFILLEDRECT 0,0, 100, 25, RGB(50,50,100),SpriteBuffer

spritex = CREATESPRITE(100,25,1,1)
spritetobuffer spritex
'Fillscreen RGB(0,0,0), SpriteBuffer
DRAWFILLEDRECT 0,0, 100, 25, RGB(50,50,100),SpriteBuffer

do
FILLSCREEN RGB(0,0,0)
' draw origin sprite ..
DrawSpriteXY sprite1,300,200
DrawSpriteXY sprite1,0,27
DrawSpriteXY sprite1,600,27
DrawSpriteXY sprite1,0,373
DrawSpriteXY sprite1,600,373

' draw the inverted copy of the origin sprite1 ..
DrawSpriteXY sprite2,300,373
DrawSpriteXY sprite2,300,27
DrawSpriteXY sprite2,0,200
DrawSpriteXY sprite2,600,200

' draw a right-side reflection of sprite 1 ..
DrawSpriteXY sprite3,373,159
DrawSpriteXY sprite3,77,-14
DrawSpriteXY sprite3,677,-14
DrawSpriteXY sprite3,76,332
DrawSpriteXY sprite3,673,332

' draw a left-side reflection of sprite 1 ..
DrawSpriteXY sprite4,225,159
DrawSpriteXY sprite4,-75,-13
DrawSpriteXY sprite4,526,-13
DrawSpriteXY sprite4,-75,330
DrawSpriteXY sprite4,526,330

' draw a right-side reflection of sprite 2 ..
DrawSpriteXY sprite5,377,417
DrawSpriteXY sprite5,377,72
DrawSpriteXY sprite5,76,245
DrawSpriteXY sprite5,677,245

' draw a left-side reflection of sprite 2 ..
DrawSpriteXY sprite6,225,416
DrawSpriteXY sprite6,226,72
DrawSpriteXY sprite6,525,242
DrawSpriteXY sprite6,-76,242

setfont BackBuffer,"Times Roman",16,400
WRITETEXT 300, 0, "ÂÃ,  EBasic KaleidoscopeÂÃ,  "

' SpriteDrawMode spriten, @TRANS
DrawSpriteXY spriten,146,560
setfont BackBuffer,"Times Roman",14,400
WRITETEXT 180, 561, "Next"

' SpriteDrawMode spritex, @TRANS
DrawSpriteXY spritex,550,560
setfont BackBuffer,"Times Roman",14,400
WRITETEXT 584, 561, "Exit"

' test for Next button clicked ..
mx = MOUSEX()
my = MOUSEY()
test1 = mx > 146 and mx < 246
test2 = my > 560 and my < 585
test3 = querymouse and mousedown(1)
if (test1 and test2 and test3) then another = 1

if another
starttimer backbuffer,500,1
querymouse = false
gosub NewPattern
another = 0
endif

' test for Exit button clicked ..
mx = MOUSEX()
my = MOUSEY()
test1 = mx > 546 and mx < 646
test2 = my > 560 and my < 585
test3 = mousedown(1)
if (test1 and test2 and test3) then stopit = 1

FLIP

until stopit = 1

FREESPRITE sprite1
FREESPRITE sprite2
FREESPRITE sprite3
FREESPRITE sprite4
FREESPRITE sprite5
FREESPRITE sprite6
FREESPRITE s1copy
FREESPRITE s2copy
FREESPRITE spriten
FREESPRITE spritex

CLOSESCREEN
END

SUB screenhandler

select @MESSAGE
case @IDTIMER
if (@code = 1)
querymouse = true
stoptimer backbuffer,1
endif
endselect

return
ENDSUB

sub draw
' draw origin zone ..
def lines,ymin,x2,y2,delta as int

lines = rand(10) + 10
for i = 1 to lines
r = rand(255):g = rand(255):b = rand(255)
y = rand(173)
delta = 0.57735 * y
x = 100 - delta + rand(2 * delta)
splots = rand(5)+ 5
for j = 1 to splots
dy = rand(15)-rand(15): y = y + dy
dx = rand(15)-rand(15): x = x + dx

ymin = 1.73 * abs(100 - x)
if (y < ymin) then y = ymin
if (y > 173) then y = 173

xtm = 100 - delta
xtp = 100 + delta

if (x < xtm) then x = xtm
if (x > xtp) then x = xtp

pset SpriteBuffer,x,y,rgb(r,g,b)

for k = 1 to rand(10) + 5
x2 = x + rand(20) - rand(20)
y2 = y + rand(20) - rand(20)

ymin = 1.73 * abs(100-x2)
if (y2 < ymin) then y2 = ymin
if (y2 > 173) then y2 = 173

delta = 0.57735 * y2

xtm = 100 - delta
xtp = 100 + delta

if (x2 < xtm) then x2 = xtm
if (x2 > xtp) then x2 = xtp

line SpriteBuffer,x,y,x2,y2,rgb(r,g,b)
next k
next j
next i
return
endsub

sub NewPattern
' routine to generate a new pattern ..

SpriteToBuffer(sprite1)
Fillscreen RGB(0,0,0), SpriteBuffer

' draw the origin sprite1 ..
gosub Draw

' create an inverted version of sprite1 ..
spritetobuffer sprite2
DrawSpriteXY sprite1,0,0,spritebuffer
SpriteDrawMode sprite2, @VFLIP

' make a horizontally flipped copy of sprite1 ..
spritetobuffer s1copy
DrawSpriteXY sprite1,0,0,spriteBuffer
SpriteDrawMode s1copy, @HFLIP

' create a right-side reflection of sprite 1 ..
spritetobuffer sprite3
Fillscreen RGB(0,0,0), SpriteBuffer
DrawSpriteXY s1copy,0,0,spriteBuffer
SpriteDrawMode sprite3, @TRANSROTOZOOM
SpriteAngle sprite3, 60 * d2r

' create a left-side reflection of sprite 1 ..
spritetobuffer sprite4
Fillscreen RGB(0,0,0), SpriteBuffer
DrawSpriteXY s1copy,0,0,spriteBuffer
SpriteDrawMode sprite4, @TRANSROTOZOOM
SpriteAngle sprite4, -60 * d2r

' make a horizontally flipped copy of sprite2 ..
spritetobuffer s2copy
Fillscreen RGB(0,0,0), SpriteBuffer
DrawSpriteXY sprite2,0,0,spriteBuffer
SpriteDrawMode s2copy, @HFLIP

' create a right-side reflection of sprite 2 ..
spritetobuffer sprite5
Fillscreen RGB(0,0,0), SpriteBuffer
DrawSpriteXY s2copy,0,0,spriteBuffer
SpriteDrawMode sprite5, @TRANSROTOZOOM
SpriteAngle sprite5, -60 * d2rÂÃ, 

' create a left-side reflection of sprite 2 ..
spritetobuffer sprite6
Fillscreen RGB(0,0,0), SpriteBuffer
DrawSpriteXY s2copy,0,0,spriteBuffer
SpriteDrawMode sprite6, @TRANSROTOZOOM
SpriteAngle sprite6, 60 * d2r

return
endsub



best wishes,

Graham