what is my typo / error ?
Code: Select all
'' 3d engine
dim shared as single v( 20 , 6 )
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 , p as integer )
declare sub child( no as integer , x as single , y as single , z as single _
, lim 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 )
'' 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 )
'' sphere world
dim shared as single height
declare sub sphere( x as single , y as single , z as single , d as single , kl as single )
declare function mix( kla as integer , f as single , klb as single ) as integer
declare sub egg( x1 as single , y1 as single , z1 as single , d1 as single _
, x2 as single , y2 as single , z2 as single , d2 as single _
, dm as single , kl as integer , no as integer )
declare sub spherehead( 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 tail = 9
const as integer lr = 10
declare sub pilko( kl as integer )
'' to test stuf
dim as single frame , i
screen 20 , 32 , 2
camara 0,0,0 , 0,0,0 , 1
''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
'' dodeca 0,0,0 , 100 , cyan
'' link 1 , 0,0,0 , frame,0,0 , 0
'' lijnman yellow
'' link 1 , 250,0,0 , -frame,0,0 , 0
'' lijnman magenta
'' test sphere world
for height = -768 /2 to 768 / 2
for i = 0 to 2
link 1 , i * 250 - 250 , 0 , 0 , 45 * i , 0 , 0 , 0
pilko orange
next i
next height
'' frame += 1
'' sleep 40
'' flip
do
loop while inkey = ""
end
'' sphere world
sub spherehead( kl as integer )
egg 0,0,0 , 20 , 0,40,10 , 30 , 20 , kl , 0
sphere 15,20,-10 , 10 , white
sphere -15,20,-10 , 10 , white
sphere 0,10,-20 , 8 , kl
end sub
sub pilko( kl as integer )
sphere 0,0,0 , 30 , kl
sphere 0,0,50 , 30 , kl
child 2 , 15,-30,0 , arm , 1
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 3 , 0,-20,0 , elbow , 2
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 4 , 0,-20,0 , wrist , 3
sphere 0,0,0 , 7 , kl
sphere 0,0,-7 , 7 , kl
child 2 , -15,-30,0 , arm + lr , 1
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 3 , 0,-20,0 , elbow + lr , 2
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 4 , 0,-20,0 , wrist + lr, 3
sphere 0,0,0 , 7 , kl
sphere 0,0,-7 , 7 , kl
child 2 , 15,-30,50 , leg , 1
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 3 , 0,-20,0 , knee , 2
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 4 , 0,-20,0 , enkle , 3
sphere 0,0,0 , 7 , kl
sphere 0,0,-7 , 7 , kl
child 2 , -15,-30,50 , leg + lr , 1
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 3 , 0,-20,0 , knee + lr, 2
sphere 0,0,0 , 10 , kl
sphere 0,-10,0 , 10 , kl
child 4 , 0,-20,0 , enkle + lr , 3
sphere 0,0,0 , 7 , kl
sphere 0,0,-7 , 7 , kl
child 2 , 0 , 18 , -18 , neck , 1
child 3 , 0 , 18 , -18 , neck + lr , 2
sphere 0,0,0 , 20 , kl
sphere 17,17,0, 7 , kl
sphere -17,17,0 , 7 , kl
sphere 0,0,-22 , 7 , gray
child 4 , 14,14,-14 , eye , 3
sphere 0,0,0 , 8 , white
sphere 0,0,-5 , 5 , gray
child 4 , -14,14,-14 , eye + lr , 3
sphere 0,0,0 , 8 , white
sphere 0,0,-5 , 5 , gray
child 2 , 0 , 15 , 65 , tail , 1
egg 0,0,0 , 10 , 0,40,40 , 10 , 10 , kl , 5
end sub
sub sphere( x as single , y as single , z as single , d as single , kl as single )
spot x , y , z
dim dd as single , kl1 as integer
if abs( height - y ) < d then
dd = sqr( d ^ 2 - ( height - y ) ^ 2 + .001 )
kl1 = mix( kl , .5 - ( height - y ) / d / 2 , black )
circle ( 1024 / 2 + x , 768 / 2 - height - z / 4 ) , dd , kl1 , , , 1/4 , f
end if
end sub
sub egg( x1 as single , y1 as single , z1 as single , d1 as single _
, x2 as single , y2 as single , z2 as single , d2 as single _
, dm as single , kl as integer , no as integer )
dim as single af , dx , dy , dz , dd , dh
dim i as integer
af = sqr( ( x1 - x2 ) ^ 2 _
+ ( y1 - y2 ) ^ 2 + ( z1 - z2 ) ^ 2 + 1 )
dx = ( x2 - x1 ) / af
dy = ( y2 - y1 ) / af
dz = ( z2 - z1 ) / af
dd = ( d2 - d1 ) / af
dh = ( d1 + d2 ) / 2
if no < 2 then no = af
if no > af then no = af
for i = 0 to af step af / no
sphere x1 + dx * i _
, y1 + dy * i , z1 + dz * i _
, d1 + dd * i + sin( i * pi / af ) _
* ( dm - dh ) , kl
next i
end sub
function mix( kla as integer , f as single , klb as single ) as integer
dim as integer ra , ga , ba , rb , gb , bb , r , g , b
ra = ( kla / 256 ^ 2 ) and 255
ga = ( kla / 256 ) and 255
ba = kla and 255
rb = ( klb / 256 ^ 2 ) and 255
gb = ( klb / 256 ) and 255
bb = klb and 255
r = ra + ( rb - ra ) * f
g = ga + ( gb - ga ) * f
b = ba + ( bb - ba ) * f
return rgb( r , g , b )
end function
'' 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 , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , knee , 2
lijn 0,0,0 , 0,-70,0 , kl
lijn 0,-70,0 , 0,-70,20 , kl
child 2 , -30,0,0 , leg + lr , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , knee + lr , 2
lijn 0,0,0 , 0,-70,0 , kl
lijn 0,-70,0 , 0,-70,20 , kl
child 2 , 50,100,0 , arm , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , elbow , 2
lijn 0,0,0 , 0,-70,0 , kl
child 2 , -50,100,0 , arm + lr , 1
lijn 0,0,0 , 0,-70,0 , kl
child 3 , 0,-70,0 , elbow + lr , 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 , 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
rotate x , y , v( p , 5 )
rotate y , z , v( p , 4 )
rotate x , z , v( p , 3 )
v( no , 0 ) = x + v( p , 0 )
v( no , 1 ) = y + v( p , 1 )
v( no , 2 ) = z + v( p , 2 )
v( no , 3 ) = pan + v( p , 3 )
v( no , 4 ) = tilt + v( p , 4 )
v( no , 5 ) = rol + v( p , 5 )
number = no
end sub
sub child( no as integer , x as single , y as single , z as single _
, lim 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 ) , p
end sub
sub spot( byref x as single , byref y as single , byref z as single )
rotate x , y , v( number , 5 )
rotate y , z , v( number , 4 )
rotate x , z , v( number , 3 )
x += v( number , 0 ) - cam( 0 )
y += v( number , 1 ) - cam( 1 )
z += v( number , 2 ) - 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