3D wire lib example

[bluatigro]

proof of concept


''bluatirgo 21 jun 2018
''3D wire lib example

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , frame , key$ , state
winx = WindowWidth
winy = WindowHeight
dim m( 26 * 4 * 4 ) , sk( 64 , 2 )
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
global arm,elbow,wrist,leg,knee,enkle,neck,lr
arm = 0
elbow = 1
wrist = 2
leg = 3
knee = 4
enkle = 5
neck = 6
lr = 31

nomainwin
open "3D wire" for graphics as #m
 #m "trapclose [quit]"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 100 , [timer]
wait
[timer]
timer 0
 scan
 #m "fill black"
 angle = frame * 360 / 32
 call link 1 , 0,0,0 , 30,0,0 , xyz , 0
 call human.walk angle , 30
 call human "yellow", 1

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

''graphics

sub human.walk fase , amp
 call skelet arm , pend( fase , amp ) , 0 , 0
 call skelet elbow , 0-abs( amp ) , 0 , 0
 call skelet arm + lr , pend( fase + 180 , amp ) , 0 , 0
 call skelet elbow + lr , 0-abs( amp ) , 0 , 0
 call skelet leg , pend( fase + 180 , amp ) , 0 , 0
 call skelet knee , pend( fase + 90 , amp ) + amp , 0 , 0
 call skelet leg + lr , pend( fase , amp ) , 0 , 0
 call skelet knee + lr , pend( fase - 90 , amp ) + amp , 0 , 0
end sub

sub human kl$ , size
 call wire -30,0,0 , 30,0,0 , kl$ , size
 call wire 0,0,0 , 0,70,0 , kl$ , size
 call wire -50,70,0 , 50,70,0 , kl$ , size
 call child 2 , 0,80,0 , neck , xyz , 1
   call child 3 , 0,10,0 , neck + lr , zyx , 2
     call cube 0,10,0 , 15,15,15 , kl$ , size
 call child 2 , -50,70,0 , arm + lr , xzy , 1
   call wire 0,0,0 , 0,-50,0 , kl$ , size
   call child 3 , 0,-50,0 , elbow + lr , xyz , 2
     call wire 0,0,0 , 0,-50,0 , kl$ , size
     call child 4 , 0,-50,0 , wrist + lr , yzx , 3
       call cube 0,-10,0 , 5,10,10 , kl$ , size
 call child 2 , 50,70,0 , arm , xzy , 1
   call wire 0,0,0 , 0,-50,0 , kl$ , size
   call child 3 , 0,-50,0 , elbow , xyz , 2
     call wire 0,0,0 , 0,-50,0 , kl$ , size
     call child 4 , 0,-50,0 , wrist , yzx , 3
       call cube 0,-10,0 , 5,10,10 , kl$ , size
 call child 2 , -30,0,0 , leg + lr , xzy , 1
   call wire 0,0,0 , 0,-50,0 , kl$ , size
   call child 3 , 0,-50,0 , knee + lr , xyz , 2
     call wire 0,0,0 , 0,-50,0 , kl$ , size
     call child 4 , 0,-50,0 , enkle + lr , yzx , 3
       call wire 0,0,0 , 0,0,-20 , kl$ , size
 call child 2 , 30,0,0 , leg , xzy , 1
   call wire 0,0,0 , 0,-50,0 , kl$ , size
   call child 3 , 0,-50,0 , knee , xyz , 2
     call wire 0,0,0 , 0,-50,0 , kl$ , size
     call child 4 , 0,-50,0 , enkle , yzx , 3
       call wire 0,0,0 , 0,0,-20 , kl$ , size
end sub

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

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

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

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

end sub

sub wire x1,y1,z1 , x2,y2,z2 , kl$ , size
 scan
 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

''3d engine

sub skelet lim , x , y , z
 sk( lim , 0 ) = x
 sk( lim , 1 ) = y
 sk( lim , 2 ) = z
end sub

sub child no , x , y , z , lim , ax , p
 call link no , x , y , z _
 , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ) , ax , p
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 , p
   case xzy
     call keer rotx , rotz , roty , no , p
   case yxz
     call keer roty , rotx , rotz , no , p
   case yzx
     call keer roty , rotz , rotx , no , p
   case zxy
     call keer rotz , rotx , roty , no , p
   case zyx
     call keer rotz , roty , rotx , no , p
   case else
     call keer rotx , roty , rorz , no , p
 end select

 number = no
end sub

function pend( fase , amp )
 pend = sin( rad( fase ) ) * amp
end function

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

sub keer a , b , c , no , p
 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



[Gordon R]

[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( 27 ) then wait

wait   '<<<<<<<<<<<<<<<<<

[quit]
 close #m
end