## 2d quasi cristals

General FreeBASIC programming questions.
bluatigro
Posts: 609
Joined: Apr 25, 2012 10:35
Location: netherlands

### 2d quasi cristals

error :
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
sleep

MrSwiss
Posts: 3331
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: 2d quasi cristals

At a quick first glance, I'd change the following two Functions:

Code: Select all

function length( x as double , y as double ) as double
return sqr( x * x + y * y )   ' <-- for speed (simpler math.)
end Function

function irange( low as integer , high as integer ) as integer
return int( rnd() * ( (high + 1) - low ) + low )  ' corrected
end Function
Then, change all variables for fbGFX, from Double to Single (for speed).
Carry on, from there ...
Posts: 1711
Joined: May 24, 2007 22:10
Location: The Netherlands

### Re: 2d quasi cristals

Sorry, but your code is impossible to follow (Or at least for me). I have no idea where to start, a big puzzle.

Some examples:
1) 'tile5' has as comment 'draw a random tile', but in reality is does drawing + all kinds of mysterious stuff on global variables.
2) you sort points from '1 to ptel' within the main while loop, looks weird
3) then some loop that goes from '0 to 9' and rotates something based on some pixel values?
4) then within the loop a 'tile5' call based on a 'dtel' value, which is some magic number from previous loop
5) And why the first 'tile5' call be fore the loop?
All to confusing for me.

I would try to untangle the spaghetti and separate functional parts.
First define the points (with rotate call), then sort, then draw.
And don't make 'ptel' a shared variable.
The 'speed things' are the last to worry about.

BTW: More 'crystals' are drawn, but everything at the same location.
bluatigro
Posts: 609
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: 2d quasi cristals

update :
try 2
i changed the idea code
i added some REM so you can see what what shoot do

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 * x + y * y )
end function
function irange( low as integer , high as integer ) as integer
return int( rnd * ( 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 )
''draw and store a tile from x,y width d and rotation hoek
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,washigh
dim as double x,y,hx,hy,dx,dy,hoek
''draw a first 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
dtel = 0
'look for first black [ hoek ] = rotate tile
'look for width black [ dtel ]
''of the closest point to mid screen
while dtel = 0
''look at point in tile
dx = size / 5
dy = 0
rotate dx , dy , 18
dtel = 0
hoek = 0
fl = 0
for i = 0 to 9
if point( winx/2+ax(h)+dx , winy/2+ay(h)+dy ) = black then
dtel = dtel + 1
if fl = 0 then
fl = 1
hoek = dtel * 36
end if
else
fl = 0
washigh = 1
end if
''next point from
rotate dx , dy , 36
next i
h = h + 1
wend
''draw new fount tile
x = ax( h )
y = ay( h )
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