roterende 3D lijn kubus

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

Moderators: anthonio, Abcott

roterende 3D lijn kubus

Berichtdoor bluatigro » zo feb 01, 2015 4:06 pm

Code: Selecteer alles
''bluatirgo 1 feb 2015
''rotating 3D cubes
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , frame , key$ , state
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]
''the cubes can't be shown on the same time
''the cubes rotate differend from eats other
  scan
  #m "fill black"
  select case state
    case 0
      call link 1 , 200,200,0 , frame,frame,frame , xyz , 0
      call cube 0,0,0 , 100,100,100 , "red" , 5
    case 1
      call link 1 , 200,-200,0 , frame,frame,frame , xzy , 0
      call cube 0,0,0 , 100,100,100 , "cyan" , 5
    case 2
      call link 1 , 0,200,0 , frame,frame,frame , yxz , 0
      call cube 0,0,0 , 100,100,100 , "blue" , 5
    case 3
      call link 1 , 0,-200,0 , frame,frame,frame , yzx , 0
      call cube 0,0,0 , 100,100,100 , "yellow" , 5
    case 4
      call link 1 , -200,200,0 , frame,frame,frame , zxy , 0
      call cube 0,0,0 , 100,100,100 , "green" , 5
    case else
      call link 1 , -200,-200,0 , frame,frame,frame , zyx , 0
      call cube 0,0,0 , 100,100,100 , "pink" , 5
  end select

  frame = ( frame + 5 ) mod 360
  if frame = 0 then state = ( state + 1 ) mod 6
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
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