LB Booster
« rotating 3D line cubes »

Welcome Guest. Please Login or Register.
Apr 1st, 2018, 04:54am



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
BBC BASIC Home Page
Liberty BASIC forum (the original)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: rotating 3D line cubes  (Read 363 times)
bluatigro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 111
xx rotating 3D line cubes
« Thread started 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

 
« Last Edit: Feb 1st, 2015, 2:22pm by bluatigro » User IP Logged

bluatigro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 111
xx Re: rotating 3D line cubes
« Reply #1 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
 
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls