## 2d quasi cristals

General FreeBASIC programming questions.
bluatigro
Posts: 595
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 cristalsrandomize timerscreen 18 , 32dim shared as integer winx , winy , ptel screeninfo winx , winyconst as double pi = atn( 1 ) * 4const 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 = 60dim shared as double ax( 80 ) , ay( 80 )function length( x as double , y as double ) as double  return sqr( x ^ 2 + y ^ 2 )end functionfunction irange( low as integer , high as integer ) as integer   return int( rnd(0) * ( high - low + 1 ) + low )end functionfunction rad( deg as double ) as double  return deg * pi / 180end functionsub 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 = hlend subsub 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 iend subsub 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),yellowend subdim as integer h , l , dtel,fl,idim 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  wendprint "ready"sleep`
MrSwiss
Posts: 3040
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 Functionfunction irange( low as integer , high as integer ) as integer  return int( rnd() * ( (high + 1) - low ) + low )  ' correctedend Function`
Then, change all variables for fbGFX, from Double to Single (for speed).
Carry on, from there ...
Posts: 1300
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: 595
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 cristalsrandomize timerscreen 18 , 32dim shared as integer winx , winy , ptel screeninfo winx , winyconst as double pi = atn( 1 ) * 4const 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 = 60dim shared as double ax( 80 ) , ay( 80 )function length( x as double , y as double ) as double  return sqr( x * x + y * y )end functionfunction irange( low as integer , high as integer ) as integer   return int( rnd * ( high - low + 1 ) + low )end functionfunction rad( deg as double ) as double  return deg * pi / 180end functionsub 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 = hlend subsub 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 iend subsub 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),yellowend subdim as integer h , l , dtel,fl,i,washighdim 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  wendprint "ready"sleep`