LB Booster
General >> General Board >> rotating 3D line cubes
http://lbb.conforums.com/index.cgi?board=general&action=display&num=1422803977
rotating 3D line cubes
Post by bluatigro on Feb 1st, 2015, 2:19pm

this is a demo of rotating 3D line cubes
Code:
''bluatigro 1 feb 2015
''rotating 3D cubes
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , frame , key$
winx = WindowWidth
winy = WindowHeight
dim m( 26 * 4 * 4 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp , pi
global xyz , xzy , yxz , yzx , zxy , zyx , number
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
pi = atn( 1 ) * 4
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5

nomainwin
open "3D line" for graphics as #m
  #m "trapclose [quit]"
  #m "when characterInput [key]"
  #m "setfocus"
  timer 40 , [tmr]
wait
[tmr]
  scan
  #m "fill black"
  call link 1 , 200,200,0 , frame,frame,frame , xyz , 0
  call cube 0,0,0 , 50,50,50 , "red" , 5
  call link 1 , 200,-200,0 , frame,frame,frame , xzy , 0
  call cube 0,0,0 , 50,50,50 , "cyan" , 5
  call link 1 , 0,200,0 , frame,frame,frame , yxz , 0
  call cube 0,0,0 , 50,50,50 , "blue" , 5
  call link 1 , 0,-200,0 , frame,frame,frame , yzx , 0
  call cube 0,0,0 , 50,50,50 , "yellow" , 5
  call link 1 , -200,200,0 , frame,frame,frame , zxy , 0
  call cube 0,0,0 , 50,50,50 , "green" , 5
  call link 1 , -200,-200,0 , frame,frame,frame , zyx , 0
  call cube 0,0,0 , 50,50,50 , "pink" , 5

  frame = frame + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  close #m
end

sub cube mx,my,mz , dx,dy,dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx-dx,my+dy,mz+dz , kl$ , size
  call lijn mx+dx,my+dy,mz-dz , mx-dx,my+dy,mz-dz , kl$ , size
  call lijn mx+dx,my-dy,mz+dz , mx-dx,my-dy,mz+dz , kl$ , size
  call lijn mx+dx,my-dy,mz-dz , mx-dx,my-dy,mz-dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my-dy,mz+dz , kl$ , size
  call lijn mx+dx,my+dy,mz-dz , mx+dx,my-dy,mz-dz , kl$ , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my-dy,mz+dz , kl$ , size
  call lijn mx-dx,my+dy,mz-dz , mx-dx,my-dy,mz-dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my+dy,mz-dz , kl$ , size
  call lijn mx+dx,my-dy,mz+dz , mx+dx,my-dy,mz-dz , kl$ , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my+dy,mz-dz , kl$ , size
  call lijn mx-dx,my-dy,mz+dz , mx-dx,my-dy,mz-dz , kl$ , size

end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl$ , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  ax = winx/2 + x1 / ( z1 + 1000 ) * 1000
  ay = winy/2 - y1 / ( z1 + 1000 ) * 1000
  bx = winx/2 + x2 / ( z2 + 1000 ) * 1000
  by = winy/2 - y2 / ( z2 + 1000 ) * 1000
  #m "color " ; kl$
  #m "size " ; size
  #m "down"
  #m "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
  #m "up"
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  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 ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no
    case xzy
      call keer rotx , rotz , roty , no
    case yxz
      call keer roty , rotx , rotz , no
    case yzx
      call keer roty , rotz , rotx , no
    case zxy
      call keer rotz , rotx , roty , no
    case zyx
      call keer rotz , roty , rotx , no
    case else
      call keer rotx , roty , rorz , no
  end select

  number = no
end sub

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

sub keer a , b , c , no
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

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

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

sub maal a , b , uit
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref 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
Re: rotating 3D line cubes
Post by bluatigro on Feb 6th, 2015, 11:42am

try at splitting code

error :
- i see only a smal white screen

main Code:
''bluatigro 6 feb 2015
''3D_line_2.bas
'include _fullscreen_init.bas
'include _3D_engine_init.bas
'include _math_init.bas

global frame , key$
nomainwin
open "3D line cubes" for graphics as #m
  #m "trapclose [quit]"
  #m "when characterInput [key]"
  #m "setfocus"
  timer 40 , [tmr]
wait
[tmr]
  scan
  #m "fill black"
  call link 1 , 200,200,0 , frame,frame,frame , xyz , 0
  call cube 0,0,0 , 50,50,50 , "red" , 5
  call link 1 , 200,-200,0 , frame,frame,frame , xzy , 0
  call cube 0,0,0 , 50,50,50 , "cyan" , 5
  call link 1 , 0,200,0 , frame,frame,frame , yxz , 0
  call cube 0,0,0 , 50,50,50 , "blue" , 5
  call link 1 , 0,-200,0 , frame,frame,frame , yzx , 0
  call cube 0,0,0 , 50,50,50 , "yellow" , 5
  call link 1 , -200,200,0 , frame,frame,frame , zxy , 0
  call cube 0,0,0 , 50,50,50 , "green" , 5
  call link 1 , -200,-200,0 , frame,frame,frame , zyx , 0
  call cube 0,0,0 , 50,50,50 , "pink" , 5

  frame = frame + 5
wait
[key]
  key$ = right$( Inkey$ , 1 )
  if key$ <> chr$( 27 ) then wait
[quit]
  close #m
end

'include _math.bas
'include _3D_engine.bas
'include _3D_line.bas

_math_init.bas Code:
''bluatigro 23 jan 2015
''_math_init.bas

  global pi , golden.ratio
  pi = atn( 1 ) * 4
  golden.ratio = ( sqr( 5 ) - 1 ) / 2
  global true , false
  true = not( false

_3D_engine_init Code:
''bluatigro 6 feb 2015
''_3D_engine_init.bas

dim m( 26 * 4 * 4 )
for i = 0 to 3
  m( in( 0 , i , i ) ) = 1
next i
global rotx , roty , rotz , trans , temp 
global xyz , xzy , yxz , yzx , zxy , zyx , number
rotx = 21
roty = 22
rotz = 23
trans = 24
temp = 25
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5

_fullscreen_init Code:
''bluatigro 6 feb 2015
''_fullscreen_init.bas

  WindowWidth = DisplayWidth
  WindowHeight = DisplayHeight
  global winx , winy
  winx = WindowWidth
  winy = WindowHeight

_math.bas Code:
''bluatigro 6 feb 2015 :
''_math.bas

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

function range( l , h )
  range = rnd(0) * ( h - l ) + l
end sub

function nr$( no , max )
  nr$ = right$( "00000000" ; no , max )
end function

_3D_engine.bas Code:
''bluatigro 6 feb 2015
''_3D_engine.bas

sub link no , x , y , z , xz , yz , xy , ax , p
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  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 ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no
    case xzy
      call keer rotx , rotz , roty , no
    case yxz
      call keer roty , rotx , rotz , no
    case yzx
      call keer roty , rotz , rotx , no
    case zxy
      call keer rotz , rotx , roty , no
    case zyx
      call keer rotz , roty , rotx , no
    case else
      call keer rotx , roty , rorz , no
  end select

  number = no
end sub

sub keer a , b , c , no
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

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

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

sub maal a , b , uit
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref 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

_3D_line.bas Code:
''bluatigro 6 feb 2015
''_3D_line.bas

sub cube mx,my,mz , dx,dy,dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx-dx,my+dy,mz+dz , kl$ , size
  call lijn mx+dx,my+dy,mz-dz , mx-dx,my+dy,mz-dz , kl$ , size
  call lijn mx+dx,my-dy,mz+dz , mx-dx,my-dy,mz+dz , kl$ , size
  call lijn mx+dx,my-dy,mz-dz , mx-dx,my-dy,mz-dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my-dy,mz+dz , kl$ , size
  call lijn mx+dx,my+dy,mz-dz , mx+dx,my-dy,mz-dz , kl$ , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my-dy,mz+dz , kl$ , size
  call lijn mx-dx,my+dy,mz-dz , mx-dx,my-dy,mz-dz , kl$ , size

  call lijn mx+dx,my+dy,mz+dz , mx+dx,my+dy,mz-dz , kl$ , size
  call lijn mx+dx,my-dy,mz+dz , mx+dx,my-dy,mz-dz , kl$ , size
  call lijn mx-dx,my+dy,mz+dz , mx-dx,my+dy,mz-dz , kl$ , size
  call lijn mx-dx,my-dy,mz+dz , mx-dx,my-dy,mz-dz , kl$ , size

end sub

sub lijn x1,y1,z1 , x2,y2,z2 , kl$ , size
  call spot x1,y1,z1
  call spot x2,y2,z2
  if z1 < -900 then exit sub
  if z2 < -900 then exit sub
  ax = winx/2 + x1 / ( z1 + 1000 ) * 1000
  ay = winy/2 - y1 / ( z1 + 1000 ) * 1000
  bx = winx/2 + x2 / ( z2 + 1000 ) * 1000
  by = winy/2 - y2 / ( z2 + 1000 ) * 1000
  #m "color " ; kl$
  #m "size " ; size
  #m "down"
  #m "line " ; ax ; "  " ; ay ; " " ; bx ; " " ; by
  #m "up"
end sub