i have a bug / typo somewere ?
Code: Select all
type matrix
dim as single m( 3 , 3 )
end type
operator * ( a as matrix , b as matrix ) as matrix
dim as integer i , j , k
dim uit as matrix
for i = 0 to 3
for j = 0 to 3
'' uit.m( i , j ) = 0
for k = 0 to 3
'' uit.m( i , j ) += a.m( i , k ) * b.m( k , j )
uit.m( j , k ) += a.m( j , i ) * b.m( i , k )
next k
next j
next i
return uit
end operator
dim shared as matrix v( 20 )
v( 0 ).m( 0 , 0 ) = 1
v( 0 ).m( 1 , 1 ) = 1
v( 0 ).m( 2 , 2 ) = 1
v( 0 ).m( 3 , 3 ) = 1
dim shared as single sk( 64 , 2 )
declare sub link( no as integer , x as single , y as single , z as single _
, pan as single , tilt as single , rol as single , ax as integer , p as integer )
declare sub child( no as integer , x as single , y as single , z as single _
, lim as integer , ax as integer , p as integer )
declare sub spot( byref x as single , byref y as single , byref z as single )
declare sub rotate( byref k as single , byref l as single , deg as single )
declare function rad( x as single ) as single
dim shared as integer number
const as single pi = atn( 1 ) * 4
dim shared as single cam( 6 )
declare sub camara( x as single , y as single , z as single _
, pan as single , tilt as single , rol as single , zoom as single )
declare function pend( f as single , a as single ) as single
declare sub skelet( no as integer , x as single , y as single , z as single )
const as integer xyz = 0
const as integer xzy = 1
const as integer yxz = 2
const as integer yzx = 3
const as integer zxy = 4
const as integer zyx = 5
'' graphics
''primary colors
const as integer black = &h000000
const as integer red = &hff0000
const as integer green = &h00ff00
const as integer yellow = &hffff00
const as integer blue = &h0000ff
const as integer magenta = &hff00ff
const as integer cyan = &h00ffff
const as integer white = &hffffff
''mix colors
const as integer orange = &hff7f00
const as integer gray = &h7f7f7f
const as integer pink = &hff7f7f
const as integer purple = &h7f007f
'' lijn world
declare sub lijn( x1 as single , y as single , z as single _
, x2 as single , y2 as single , z2 as single , kl as integer )
declare sub cube( x1 as single , y as single , z as single _
, x2 as single , y2 as single , z2 as single , kl as integer )
declare sub dodeca( x as single , y as single , z as single _
, d as single , dik as integer )
declare sub lijnman( kl as integer )
const as integer arm = 0
const as integer elbow = 1
const as integer wrist = 2
const as integer leg = 3
const as integer knee = 4
const as integer enkle = 5
const as integer neck = 6
const as integer head = 7
const as integer eye = 8
const as integer lr = 10
screen 20 , 32 , 2
dim frame as single
do
cls
'' test 3d engine
skelet leg , pend( frame * 5 , 30 ) , 0 , 0
skelet knee , pend( frame * 5 - 90 , 30 ) + 30 , 0 , 0
skelet leg + lr , pend( frame * 5 + 180 , 30 ) , 0 , 0
skelet knee + lr , pend( frame * 5 + 90 , 30 ) + 30 , 0 , 0
skelet arm , pend( frame * 5 + 180 , 30 ) , 0 , 0
skelet elbow , -30 , 0 , 0
skelet arm + lr , pend( frame * 5 , 30 ) , 0 , 0
skelet elbow + lr , -30 , 0 , 0
'' test lijn world
link 1 , -250,0,0 , frame,frame,0 , 0 , 0
dodeca 0,0,0 , 100 , cyan
link 1 , 0,0,0 , frame,0,0 , 0 , 0
lijnman yellow
link 1 , 250,0,0 , -frame,0,0 , 0 , 0
lijnman magenta
frame = frame + 1
sleep 40
flip
loop while inkey = ""
end
'' lijn world
sub lijnman( kl as integer )
lijn 30,0,0 ,-30,0,0 , kl
lijn 0,0,0 , 0,120,0 , kl
lijn 50,100,0 , -50,100,0 , kl
cube 0,140,0 , 15,15,15 , kl
child 2 , 30,0,0 , leg , yzx , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , knee , 0 , 2
lijn 0,0,0 , 0,-70,0 , kl
lijn 0,-70,0 , 0,-70,20 , kl
child 2 , -30,0,0 , leg + lr , yzx , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , knee + lr , 0 , 2
lijn 0,0,0 , 0,-70,0 , kl
lijn 0,-70,0 , 0,-70,20 , kl
child 2 , 50,100,0 , arm , xzy , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , elbow , 0 , 2
lijn 0,0,0 , 0,-70,0 , kl
child 2 , -50,100,0 , arm + lr , xzy , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , elbow + lr , 0 , 2
lijn 0,0,0 , 0,-70,0 , kl
end sub
sub dodeca( x as single , y as single , z as single , d as single , dik as integer )
dim f as single
f = ( sqr( 5 ) - 1 ) / 2
''(±1, ±1, ±1)
''(0, ±1/f, ±f)
''(±1/f, ±f, 0)
''(±f, 0, ±1/f)
lijn x + d , y + d , z + d , x , y + 1/f*d , z + f*d ,dik
lijn x + d , y + d , z + d , x + 1/f*d , y + f*d , z ,dik
lijn x + d , y + d , z + d , x + f*d , y , z + 1/f*d ,dik
lijn x - d , y - d , z - d , x , y - 1/f*d , z - f*d ,dik
lijn x - d , y - d , z - d , x - 1/f*d , y - f*d , z ,dik
lijn x - d , y - d , z - d , x - f*d , y , z - 1/f*d ,dik
lijn x+1/f*d,y+f*d,z,x+1/f*d,y-f*d,z,dik
lijn x-1/f*d,y-f*d,z,x-1/f*d,y+f*d,z,dik
lijn x,y+1/f*d,z+f*d,x,y+1/f*d,z-f*d,dik
lijn x,y-1/f*d,z-f*d,x,y-1/f*d,z+f*d,dik
lijn x-f*d,y,z-1/f*d,x+f*d,y,z-1/f*d,dik
lijn x+f*d,y,z+1/f*d,x-f*d,y,z+1/f*d,dik
lijn x+1/f*d,y+f*d,z,x+d,y+d,z-d,dik
lijn x-1/f*d,y-f*d,z,x-d,y-d,z+d,dik
lijn x+f*d,y,z+1/f*d,x-f*d,y,z+1/f*d,dik
lijn x-f*d,y,z-1/f*d,x+f*d,y,z-1/f*d,dik
lijn x-f*d,y,z+1/f*d,x-d,y+d,z+d,dik
lijn x+f*d,y,z-1/f*d,x+d,y-d,z-d,dik
lijn x+f*d,y,z-1/f*d,x+d,y+d,z-d,dik
lijn x-f*d,y,z+1/f*d,x-d,y-d,z+d,dik
lijn x-d,y+d,z+d,x,y+1/f*d,z+f*d,dik
lijn x+d,y-d,z-d,x,y-1/f*d,z-f*d,dik
lijn x-d,y+d,z+d,x-1/f*d,y+f*d,z,dik
lijn x+d,y-d,z-d,x+1/f*d,y-f*d,z,dik
lijn x+f*d,y,z+1/f*d,x+d,y-d,z+d,dik
lijn x-f*d,y,z-1/f*d,x-d,y+d,z-d,dik
lijn x+d,y-d,z+d,x,y-1/f*d,z+f*d,dik
lijn x-d,y+d,z-d,x,y+1/f*d,z-f*d,dik
lijn x+d,y+d,z-d,x,y+1/f*d,z-f*d,dik
lijn x-d,y-d,z+d,x,y-1/f*d,z+f*d,dik
lijn x+d,y-d,z+d,x+1/f*d,y-f*d,z,dik
lijn x-d,y+d,z-d,x-1/f*d,y+f*d,z,dik
end sub
sub cube( x as single , y as single , z as single _
, x2 as single , y2 as single , z2 as single , kl as integer )
lijn x + x2 , y + y2 , z + z2 , x - x2 , y + y2 , z + z2 , kl
lijn x + x2 , y + y2 , z - z2 , x - x2 , y + y2 , z - z2 , kl
lijn x + x2 , y - y2 , z + z2 , x - x2 , y - y2 , z + z2 , kl
lijn x + x2 , y - y2 , z - z2 , x - x2 , y - y2 , z - z2 , kl
lijn x + x2 , y + y2 , z + z2 , x + x2 , y - y2 , z + z2 , kl
lijn x + x2 , y + y2 , z - z2 , x + x2 , y - y2 , z - z2 , kl
lijn x - x2 , y + y2 , z + z2 , x - x2 , y - y2 , z + z2 , kl
lijn x - x2 , y + y2 , z - z2 , x - x2 , y - y2 , z - z2 , kl
lijn x + x2 , y + y2 , z + z2 , x + x2 , y + y2 , z - z2 , kl
lijn x + x2 , y - y2 , z + z2 , x + x2 , y - y2 , z - z2 , kl
lijn x - x2 , y + y2 , z + z2 , x - x2 , y + y2 , z - z2 , kl
lijn x - x2 , y - y2 , z + z2 , x - x2 , y - y2 , z - z2 , kl
end sub
sub lijn( x1 as single , y1 as single , z1 as single _
, x2 as single , y2 as single , z2 as single , kl as integer )
spot x1 , y1 , z1
spot x2 , y2 , z2
dim as single a1 , b1 , a2 , b2
a1 = 1024 / 2 + x1 / ( z1 + 1000 ) * 1000
b1 = 768 / 2 - y1 / ( z1 + 1000 ) * 1000
a2 = 1024 / 2 + x2 / ( z2 + 1000 ) * 1000
b2 = 768 / 2 - y2 / ( z2 + 1000 ) * 1000
line ( a1 , b1 ) - ( a2 , b2 ) , kl
end sub
'' 3d engine
function pend( f as single , a as single ) as single
return sin( rad( f ) ) * a
end function
sub skelet( lim as integer , x as single , y as single , z as single )
if lim < 0 or lim > 64 then exit sub
sk( lim , 0 ) = x
sk( lim , 1 ) = y
sk( lim , 2 ) = z
end sub
sub camara( x as single , y as single , z as single _
, pan as single , tilt as single , rol as single , zoom as single )
cam( 0 ) = x
cam( 1 ) = y
cam( 2 ) = z
cam( 3 ) = pan
cam( 4 ) = tilt
cam( 5 ) = rol
cam( 6 ) = zoom
end sub
sub link( no as integer , x as single , y as single , z as single _
, pan as single , tilt as single , rol as single , ax as integer , p as integer )
if no < 1 or no > 20 then exit sub
if p < 0 or p > 20 then exit sub
if p = no then exit sub
dim as matrix mp , rotx , roty , rotz , translate
mp = v( p )
rotx = v( 0 )
roty = v( 0 )
rotz = v( 0 )
translate = v( 0 )
roty.m( 0 , 0 ) = cos( rad( rol ) )
roty.m( 0 , 1 ) = -sin( rad( rol ) )
roty.m( 1 , 0 ) = sin( rad( rol ) )
roty.m( 1 , 1 ) = cos( rad( rol ) )
roty.m( 0 , 0 ) = cos( rad( pan ) )
roty.m( 0 , 2 ) = -sin( rad( pan ) )
roty.m( 2 , 0 ) = sin( rad( pan ) )
roty.m( 2 , 2 ) = cos( rad( pan ) )
roty.m( 1 , 1 ) = cos( rad( tilt ) )
roty.m( 1 , 2 ) = -sin( rad( tilt ) )
roty.m( 2 , 1 ) = sin( rad( tilt ) )
roty.m( 2 , 2 ) = cos( rad( tilt ) )
translate.m( 3 , 0 ) = x
translate.m( 3 , 1 ) = y
translate.m( 3 , 2 ) = z
select case ax
case xyz
v( no ) = mp * rotx * roty * rotz * translate
case xzy
v( no ) = mp * rotx * rotz * roty * translate
case yxz
v( no ) = mp * roty * rotx * rotz * translate
case yzx
v( no ) = mp * roty * rotz * rotx * translate
case zxy
v( no ) = mp * rotz * rotx * roty * translate
case zyx
v( no ) = mp * rotz * roty * rotx * translate
case else
end select
number = no
end sub
sub child( no as integer , x as single , y as single , z as single _
, lim as integer , ax as integer , p as integer )
if lim < 0 or lim > 64 then exit sub
link no , x , y , z , sk( lim , 1 ) , sk( lim , 0 ) , sk( lim , 2 ), ax , p
end sub
sub spot( byref x as single , byref y as single , byref z as single )
dim as single hx , hy , hz
dim as integer i
i = number
hx = x * v( i ).m( 0 , 0 ) + y * v( i ).m( 1 , 0 ) _
+ z * v( i ).m( 2 , 0 ) + v( i ).m( 3 , 0 )
hy = x * v( i ).m( 0 , 1 ) + y * v( i ).m( 1 , 1 ) _
+ z * v( i ).m( 2 , 1 ) + v( i ).m( 3 , 1 )
hz = x * v( i ).m( 0 , 2 ) + y * v( i ).m( 1 , 2 ) _
+ z * v( i ).m( 2 , 2 ) + v( i ).m( 3 , 2 )
x = hx
y = hy
z = hz
x += - cam( 0 )
y += - cam( 1 )
z += - cam( 2 )
rotate x , z , -cam( 3 )
rotate y , z , -cam( 4 )
rotate x , y , -cam( 5 )
end sub
sub rotate( byref k as single , byref l as single , deg as single )
dim as single hk , hl , s , c
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
function rad( x as single ) as single
return x * pi / 180
end function