2d quasi cristals

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

2d quasi cristals

Postby bluatigro » Jan 18, 2019 14:12

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
print "ready"
sleep

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

Re: 2d quasi cristals

Postby MrSwiss » Jan 18, 2019 15:06

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 ...
badidea
Posts: 1176
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: 2d quasi cristals

Postby badidea » Jan 18, 2019 20:25

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

Postby bluatigro » Jan 20, 2019 10:01

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
print "ready"
sleep


Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests