anaglyph 3d 3.0

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

anaglyph 3d 3.0

Berichtdoor bluatigro » do maart 13, 2014 12:00 pm

dit heeft nu matrix wiskunde voor t bewegen en plaatsen van 3d objecten

Code: Selecteer alles
''anaglyph 3d 3.0
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , scrnx , scrny , eye , you
global mmax , skmax
global xyz , xzy , yxz , yzx , zxy , zyx
mmax = 20
skmax = 64
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
dim m( ( mmax + 5 ) * 16 )
dim skx( skmax ) , sky( skmax ) , skz( skmax )
global frame , pi , state
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
scrnx$ = str$( 350 )
prompt "Screen width in mm =" ; scrnx$
scrnx = val( scrnx$ )
scrny$ = str$( 280 )
prompt "Screen height in mm =" ; scrny$
scrny = val( scrny$ )
you$ = str$( 350 )
prompt "You - screen in mm =" ; you$
you = val( you$ )
eye = 70 ''pupil distance in mm

nomainwin
open "ANAGLYPH 3D 3.0" for graphics as #m
  #m "trapclose [quit]"
  #m "rule ";_R2_MERGEPEN
  timer 400 , [tmr]
wait
[tmr]
  #m "fill black"
  call startmatrix
  select case state
    case 0
      call link 1 , 0,0,0 , frame*360/32,0,0 , xyz , 0
      call cubo 0,0,0 , 50,50,50 , 5
      call sphere 50,50,50 , 25 , 5
    case 1
      call link 1 , 0,0,0 , frame*360/32,0,0 , xyz , 0
      call dodeca 0,0,0 , 50 , 5
    case else
      call link 1 , 0,0,0 , frame*360/32,0,0 , xyz , 0
      call okto 0,0,0 , 50,50,50 , 5
  end select
  frame = ( frame + 1 ) mod 32
  if frame = 0 then
    state = ( state + 1 ) mod 3
  end if
wait
[quit]
  close #m
end

''  3d engine

function rad( deg )
  rad = deg * pi / 180
end function

function pend( fase , amp )
''for smooth movements
  pend = sin( rad( fase ) ) * amp
end function

sub skelet lim , x , y , z
''for animating avatar lim's
  skx( lim ) = x
  sky( lim ) = y
  skz( lim ) = z
end sub

sub child no , x , y , z , lim , ax , p
''for creating lim's of a avatar
  if lim < 0 or lim > 64 then exit sub
  call link no , x , y , z _
  , sky( lim ) , skx( lim ) , skz( lim ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''set draw matrix : wil efect future drawing

''no : number new matrix
''x,y,z : translation
''xz,yz,xy : rotation in degrees
''ax : sequence of axes
''p : number old matrix

  if no < 1 or no > mmax then exit sub
  if p < 0 or p > mmax then exit sub
  if p = no then exit sub
  rotx = mmax + 1
  roty = mmax + 2
  rotz = mmax + 3
  trans = mmax + 4
''copy matrix 0 into matrix's
  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans
''create rotation matrix's
  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )
''create translation matrix
  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z
''select axes sequence [ 1 of 6 ] and act on i
  select case ax
    case xyz
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case xzy
      call multiply rotx , rotz , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yxz
      call multiply roty , rotx , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case yzx
      call multiply roty , rotz , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zxy
      call multiply rotz , rotx , temp
      call multiply temp , roty , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case zyx
      call multiply rotz , roty , temp
      call multiply temp , rotx , no
      call multiply no , trans , temp
      call multiply temp , p , no
    case else
      call multiply rotx , roty , temp
      call multiply temp , rotz , no
      call multiply no , trans , temp
      call multiply temp , p , no
  end select
  number = no
end sub

sub copy a , b
''matrix( b ) = matrix( a )
  for i = 0 to 3
    for j = 0 to 3
      m( in( b , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub spot byref x , byref y , byref z
'''lokal coordinates to world coordinates
''x,y,z = matrix( number ) * x,y,z
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx
  y = hy
  z = hz
end sub

sub multiply a , b , c
''matrix( c ) = matrix( a ) * matrix( b )
  for i = 0 to 3
    for j = 0 to 3
      m( in( c , i , j ) ) = 0
      for k = 0 to 3
        m( in( c , i , j ) ) = m( in( c , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub startmatrix
''set startmatrix to unity
  for x = 0 to 3
    for y = 0 to 3
      m( in( 0,x,y ) ) = 0
    next y
    m( in( 0,x,x ) ) = 1
  next x
end sub

function in( no , x , y )
  in = no * 16 + x * 4 + y
end function

''  graphics

function tox( x , y , z , rl )
''catch x/0 error
  if z + you = 0 then tox = 0
''ofset red or blue
  o = ( eye / 2 ) / ( z + you ) * you - ( eye / 2 )
  o = o * rl
''ofset z + perspertif
  a = ( x + o ) / ( z + you ) * you
''from mm to pixels
  tox = winx / 2 + a * winx / scrnx
end function

function toy( x , y , z )
''catch x/0 error
  if z + you = 0 then toy = 0
''ofset z + perspectif
  a = y / ( z + you ) * you
''from mm to pixels
  toy = winy / 2 - a * winy / scrny
end function

sub sphere x , y , z , d , t
  call spot x , y , z
  a = tox( x , y , z , 1 )
  b = toy( x , y , z )
  d = d / ( z + you ) * you * winx / scrnx
  #m "size " ; t
  #m "color red"
  #m "goto ";a;" ";b
  #m "down"
  #m "circle ";d
  #m "up"
  a = tox( x , y , z , -1 )
  #m "color blue"
  #m "goto ";a;" ";b
  #m "down"
  #m "circle ";d
  #m "up"
end sub

sub lino x1 , y1 , z1 , x2 , y2 , z2 , thick
  call spot x1 , y1 , z1
  call spot x2 , y2 , z2
  #m "size "; thick
  ax = tox( x1 , y1 , z1 , 1 )
  ay = toy( x1 , y1 , z1 )
  bx = tox( x2 , y2 , z2 , 1 )
  by = toy( x2 , y2 , z2 )
  #m "down"
  #m "color red"
  #m "line " ; ax ; " " ; ay ; " " ; bx ; " " ; by
  #m "up"
  ax = tox( x1 , y1 , z1 , -1 )
  bx = tox( x2 , y2 , z2 , -1 )
  #m "down"
  #m "color blue"
  #m "line " ; ax ; " " ; ay ; " " ; bx ; " " ; by
  #m "up"
end sub

sub cubo mx , my , mz , dx , dy , dz , thick
  call lino mx+dx,my+dy,mz+dz,mx-dx,my+dy,mz+dz,thick
  call lino mx+dx,my+dy,mz-dz,mx-dx,my+dy,mz-dz,thick
  call lino mx+dx,my-dy,mz+dz,mx-dx,my-dy,mz+dz,thick
  call lino mx+dx,my-dy,mz-dz,mx-dx,my-dy,mz-dz,thick
  call lino mx+dx,my+dy,mz+dz,mx+dx,my-dy,mz+dz,thick
  call lino mx+dx,my+dy,mz-dz,mx+dx,my-dy,mz-dz,thick
  call lino mx-dx,my+dy,mz+dz,mx-dx,my-dy,mz+dz,thick
  call lino mx-dx,my+dy,mz-dz,mx-dx,my-dy,mz-dz,thick
  call lino mx+dx,my+dy,mz+dz,mx+dx,my+dy,mz-dz,thick
  call lino mx+dx,my-dy,mz+dz,mx+dx,my-dy,mz-dz,thick
  call lino mx-dx,my+dy,mz+dz,mx-dx,my+dy,mz-dz,thick
  call lino mx-dx,my-dy,mz+dz,mx-dx,my-dy,mz-dz,thick
end sub

sub okto x , y , z , dx , dy , dz , t
  call lino x,y+dy,z,x,y,z+dz,t
  call lino x,y,z+dz,x,y-dy,z,t
  call lino x,y-dy,z,x,y,z-dz,t
  call lino x,y,z-dz,x,y+dy,z,t
  call lino x+dx,y,z,x,y,z+dz,t
  call lino x,y,z+dz,x-dx,y,z,t
  call lino x-dx,y,z,x,y,z-dz,t
  call lino x,y,z-dz,x+dx,y,z,t
  call lino x+dx,y,z,x,y+dy,z,t
  call lino x,y+dy,z,x-dx,y,z,t
  call lino x-dx,y,z,x,y-dy,z,t
  call lino x,y-dy,z,x+dx,y,z,t
end sub

sub dodeca x , y , z , d , dik
  f = ( sqr( 5 ) - 1 ) / 2
  ''(±1, ±1, ±1)
  ''(0, ±1/f, ±f)
  ''(±1/f, ±f, 0)
  ''(±f, 0, ±1/f)
  call lino x + d , y + d , z + d , x , y + 1/f*d , z + f*d ,dik
  call lino x + d , y + d , z + d , x + 1/f*d , y + f*d , z ,dik
  call lino x + d , y + d , z + d , x + f*d , y , z + 1/f*d ,dik
  call lino x - d , y - d , z - d , x , y - 1/f*d , z - f*d ,dik
  call lino x - d , y - d , z - d , x - 1/f*d , y - f*d , z ,dik
  call lino x - d , y - d , z - d , x - f*d , y , z - 1/f*d ,dik
  call lino x+1/f*d,y+f*d,z,x+1/f*d,y-f*d,z,dik
  call lino x-1/f*d,y-f*d,z,x-1/f*d,y+f*d,z,dik
  call lino x,y+1/f*d,z+f*d,x,y+1/f*d,z-f*d,dik
  call lino x,y-1/f*d,z-f*d,x,y-1/f*d,z+f*d,dik
  call lino x-f*d,y,z-1/f*d,x+f*d,y,z-1/f*d,dik
  call lino x+f*d,y,z+1/f*d,x-f*d,y,z+1/f*d,dik
  call lino x+1/f*d,y+f*d,z,x+d,y+d,z-d,dik
  call lino x-1/f*d,y-f*d,z,x-d,y-d,z+d,dik
  call lino x+f*d,y,z+1/f*d,x-f*d,y,z+1/f*d,dik
  call lino x-f*d,y,z-1/f*d,x+f*d,y,z-1/f*d,dik
  call lino x-f*d,y,z+1/f*d,x-d,y+d,z+d,dik
  call lino x+f*d,y,z-1/f*d,x+d,y-d,z-d,dik
  call lino x+f*d,y,z-1/f*d,x+d,y+d,z-d,dik
  call lino x-f*d,y,z+1/f*d,x-d,y-d,z+d,dik
  call lino x-d,y+d,z+d,x,y+1/f*d,z+f*d,dik
  call lino x+d,y-d,z-d,x,y-1/f*d,z-f*d,dik
  call lino x-d,y+d,z+d,x-1/f*d,y+f*d,z,dik
  call lino x+d,y-d,z-d,x+1/f*d,y-f*d,z,dik
  call lino x+f*d,y,z+1/f*d,x+d,y-d,z+d,dik
  call lino x-f*d,y,z-1/f*d,x-d,y+d,z-d,dik
  call lino x+d,y-d,z+d,x,y-1/f*d,z+f*d,dik
  call lino x-d,y+d,z-d,x,y+1/f*d,z-f*d,dik
  call lino x+d,y+d,z-d,x,y+1/f*d,z-f*d,dik
  call lino x-d,y-d,z+d,x,y-1/f*d,z+f*d,dik
  call lino x+d,y-d,z+d,x+1/f*d,y-f*d,z,dik
  call lino x-d,y+d,z-d,x-1/f*d,y+f*d,z,dik
end sub
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron