i get only 2 cristals
Code: Select all
'' bluatigro 16 nov 2018
'' 2D quasi cristals
randomize timer
screen 18 , 32
dim shared as integer winx , winy , ptel
screeninfo winx , winy
const as double pi = atn( 1 ) * 4
const as ulong black = rgb ( 0 , 0 , 0 )
const as ulong yellow = rgb( 255 , 255 , 0 )
const as ulong blue = rgb( 0 , 0 , 255 )
const as double size = 60
dim shared as double ax( 80 ) , ay( 80 )
function length( x as double , y as double ) as double
return sqr( x ^ 2 + y ^ 2 )
end function
function irange( low as integer , high as integer ) as integer
return int( rnd(0) * ( high - low + 1 ) + low )
end function
function rad( deg as double ) as double
return deg * pi / 180
end function
sub rotate( byref k as double , byref l as double , deg as double )
dim as double s , c , hk , hl
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
sub triangle( x1 as double , y1 as double _
, x2 as double , y2 as double _
, x3 as double , y3 as double , kl as ulong )
if y1 = y2 then y1 = y1 - 1e-6
if y2 = y3 then y3 = y3 + 1e-6
if y1 > y3 then
swap y1 , y3
swap x1 , x3
end if
if y1 > y2 then
swap y1 , y2
swap x1 , x2
end if
if y2 > y3 then
swap y2 , y3
swap x2 , y3
end if
dim as double i , a , b
for i = y1 to y3
a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
if i < y2 then
b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
else
b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
end if
line ( a , i ) - ( b , i ) , kl
next i
end sub
sub tile5( x as double , y as double , d as double , hoek as double )
ax( ptel ) = x
ay( ptel ) = y
dim as double dx , dy , dx1 , dy1
dx = size
dy = 0
rotate dx , dy , hoek
ax( ptel + 1 ) = x + dx
ay( ptel + 1 ) = y + dy
dx1 = dx
dy1 = dy
rotate dx1 , dy1 , d * 36
ax( ptel + 2 ) = x + dx1
ay( ptel + 2 ) = y + dy1
ax( ptel + 3 ) = x + dx + dx1
ay( ptel + 3 ) = y + dy + dy1
ptel = ptel + 4
x = x + winx / 2
y = y + winy / 2
triangle x,y , x+dx,y+dy , x+dx1,y+dy1 , blue
triangle x+dx+dx1,y+dy+dy1 , x+dx,y+dy , x+dx1,y+dy1 , blue
line (x,y)-(x+dx,y+dy),yellow
line (x+dx,y+dy)-(x+dx+dx1,y+dy+dy1),yellow
line (x+dx+dx1,y+dy+dy1)-(x+dx1,y+dy1),yellow
line (x+dx1,y+dy1)-(x,y),yellow
end sub
dim as integer h , l , dtel,fl,i
dim as double x,y,hx,hy,dx,dy,hoek
''draw a random tile
tile5 0,0 , irange( 1 , 4 ) , 0
while ptel < 80
''sort points
for h = 1 to ptel
for l = 0 to h - 1
if length(ax(h),ay(h))<length(ax(l),ay(l)) then
swap ax(h) , ax(l)
swap ay(h) , ay(l)
end if
next l
next h
x = ax( 0 )
y = ay( 0 )
dx = size
dy = 0
rotate dx , dy , 18
dtel = 0
hoek = 0
fl = 0
for i = 0 to 9
if point( x+dx , y+dy ) = black then
dtel = dtel + 1
if fl = 0 then
fl = 1
hoek = dtel * 36
end if
end if
rotate dx , dy , 36
next i
select case dtel
case 1
tile5 x,y , 1 , hoek
case 2
tile5 x,y , irange( 1 , 2 ) , hoek
case 3
tile5 x,y , irange( 1 , 3 ) , hoek
case else
tile5 x,y , irange( 1 , 4 ) , hoek
end select
wend
print "ready"
sleep