animation example

[bluatigro]

i copyed the avatar out of a freebasic code
but it does not doe what i expect


WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = 1024 ''WindowWidth
winy = 768 ''WindowHeight
nomainwin
global arm,elbow,wrist,leg,knee,enkle
arm = 1
elbow = 2
wrist = 3
leg = 4
knee = 5
enkle = 6
global thumb,index,middle,ring,pinky,leftno,rightno
thumb = 7
index = 10
middle = 13
ring = 16
pinky = 19
leftno = 0
rightno = 32
gosub [math]
gosub [color]
gosub [basis3D]
open "animation example" for graphics as #m
 #m "trapclose [quit]"
 #m "fill lightgray"
 #m "goto 0 0"
 #m "down"
 #m "boxfilled " ; winx ; " " ; winy
 #m "up"
 for height = 0 to 300
   scan
   call link 1 , 0,130,0 , 30,0,0 , xyz , 0
   call ant blue , yellow
 next height
 notice "ready"
wait
[quit]
 close #m
end
''avartar example

sub hand kl , i
call  sphere 0,0,0,10 , kl
call  egg 0,0,5,7 , 0,-20,10,7 , 7 , kl , 0
call  egg 0,0,0,7 , 0,-25,0,7 , 7 , kl , 0
call  egg 0,0,-5,7 , 0,-20,-10,7 , 7 , kl , 0
call  child 6 , 0,-20,10 , ring + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , ring + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , ring + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-25,0 , midle + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , midle + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , midle + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-20,-10 , index + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , index + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , index + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-10,-20 , thumb + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , thumb + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , thumb + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
end sub

sub ant kl1 , kl2
call  link 2 , 0,0,0 , 0,0,0 , xyz , 1
call    egg 0,0,0,30 , 0,60,0,0 , 30 , kl1 , 0
call    egg 40,70,0,1 , -40,70,0,1 , 20 , kl1 , 0
call    child 3 , 0,70,0 , neck + leftno , xyz , 2
call      child 4 , 0,40,0 , neck + rightno , zyx , 3
call        egg 0,0,0,25 , 0,-20,-30,0 , 17 , kl1 , 0
call        child 5 , -14,20,0 , eye + rightno , xyz , 4
call          sphere 0,0,0 , 10 , white
call          sphere 0,0,-7 , 5 , black
call        child 5 , 14,20,0 , eye + leftno , xyz , 4
call          sphere 0,0,0 , 10 , white
call          sphere 0,0,-7 , 5 , black
call    child 3 , 40,70,0 , arm + leftno , xzy , 2
call      sphere 0,0,0,10, kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , elbow + leftno, xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , wrist + leftno , yzx , 4
call          hand kl2 , leftno
call    child 3 , -40,70,0 , arm + rightno , xzy , 2
call      sphere 0,0,0,10, kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , elbow + rightno , xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , wrist + rightno , yzx , 4
call          hand kl2 , rightno
call    child 3 , 20,-20,0 , leg + leftno , xyz , 2
call      sphere 0,0,0,10 , kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , knee + leftno, xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , enkle + leftno , zyx , 4
call          egg 0,0,0,14 , 10,-7,-40,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , 0,-7,-45,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , -10,-7,-40,1 , 7 , kl2 , 0
call    child 3 , -20,-20,0 , leg + rightno , xyz , 2
call      sphere 0,0,0,10 , kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , knee + rightno , xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , enkle + rightno , zyx , 4
call          egg 0,0,0,14 , 10,-7,-40,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , 0,-7,-45,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , -10,-7,-40,1 , 7 , kl2 , 0
end sub

sub human.walk frame , amp
call skelet leg + leftno , pend( frame , amp ) , 0 , 0
call skelet knee + leftno , pend( frame - 90 , amp ) + amp  , 0 , 0
call skelet leg + rightno , pend( frame + 180 , amp ) , 0 , 0
call skelet knee + rightno , pend( frame + 90 , amp ) + amp , 0 , 0
call skelet arm + leftno , pend( frame + 180 , amp ) , 0 , 0
call skelet elbow + leftno , 0-amp , 0 , 0
call skelet arm + rightno , pend( frame , amp ) , 0 , 0
call skelet elbow + rightno , 0-amp , 0 , 0
end sub

''bluatigro 18 nov 2016
''color block
''needs math block

[color]
 global black , red , green , yellow
 global blue , magenta , cyan , white
 global pink , orange , gray , purple
 black   = rgb(   0 ,   0 ,   0 )
 red     = rgb( 255 ,   0 ,   0 )
 green   = rgb(   0 , 255 ,   0 )
 yellow  = rgb( 255 , 255 ,   0 )
 blue    = rgb(   0 ,   0 , 255 )
 magenta = rgb( 255 ,   0 , 255 )
 cyan    = rgb(   0 , 255 , 255 )
 white   = rgb( 255 , 255 , 255 )
 pink    = rgb( 255 , 127 , 127 )
 orange  = rgb( 255 , 127 ,   0 )
 gray    = rgb( 127 , 127 , 127 )
 purple  = rgb( 127 ,   0 , 127 )
return

sub setcolor kl
 r = int( kl and 255 )
 g = int( kl / 256 ) and 255
 b = int( kl / 256 / 256 ) and 255
 print #m , "backcolor " ; r ;" "; g ; " "; b
 print #m , "color " ; r ; " " ; g ; " " ; b
end sub

function rgb( r , g , b )
 rgb = ( int( r ) and 255 ) _
 + ( int( g ) and 255 ) * 256 _
 + ( int( b ) and 255 ) * 256 * 256
end function

function rainbow( x )
 r = sin( rad( x ) ) * 127 + 128
 g = sin( rad( x - 120 ) ) * 127 + 128
 b = sin( rad( x + 120 ) ) * 127 + 128
 rainbow = rgb( r , g , b )
end function

function mix( kl1 , f , kl2 )
 r1 = int( kl1 and 255 )
 g1 = int( kl1 / 256 ) and 255
 b1 = int( kl1 / 256 / 256 ) and 255
 r2 = int( kl2 and 255 )
 g2 = int( kl2 / 256 ) and 255
 b2 = int( kl2 / 256 / 256 ) and 255
 r = r1 + ( r2 - r1 ) * f
 g = g1 + ( g2 - g1 ) * f
 b = b1 + ( b2 - b1 ) * f
 mix = rgb( r , g , b )
end function

''bluatigro 18 nov 2016
''sphere world block
''needs color , basis3D and math block

[sphere]
 global height
return

sub sphere x , y , z , d , kl
 scan
 call spot x , y , z
 d = d * cam( 6 )
 dx = winx
 dy = winy
 if height = 0 then
   call setcolor black
   print #m , "goto " ; dx / 2 + x ; " " _
   ; dy * 5 / 6 - z / 4
   print #m , "down"
   print #m , "ellipsefilled " ; d * 2 ; " " ; d / 2
   print #m , "up"
 end if
 if abs( height - y ) < d then
   dd = sqr( d ^ 2 - ( height - y ) ^ 2 ) * 2
   kl = mix( kl , 1 - ( height - y ) / d / 2 + 0.5 , 0 )
   call setcolor kl
   print #m , "goto "; dx / 2 + x ;" " _
   ; dy * 5 / 6 - height - z / 4
   print #m , "down"
   print #m , "ellipsefilled "; dd ;" "; dd / 4
   print #m , "up"
 end if
end sub

sub egg x1 , y1 , z1 , d1 , x2 , y2 , z2 , d2 , dm , kl , n
 diff = sqr( ( x1 - x2 ) ^ 2 _
           + ( y1 - y2 ) ^ 2 _
           + ( z1 - z2 ) ^ 2 )
 dx = ( x2 - x1 ) / diff
 dy = ( y2 - y1 ) / diff
 dz = ( z2 - z1 ) / diff
 dd = ( d2 - d1 ) / diff
 if dm = 0 then dm = ( d1 + d2 ) / 2
 if n < 3 then n = diff
 for i = 0 to diff step diff / n
   scan
   call sphere x1 + dx * i _
   , y1 + dy * i _
   , z1 + dz * i _
   , d1 + dd * i _
   + sin( i / diff * pi ) _
   * ( dm - ( d1 + d2 ) / 2 ) _
   , kl
 next i
end sub

sub bezier x1,y1,z1,d1 , x2,y2,z2,d2 , x3,y3,z3,d3 , x4,y4,z4,d4 , kl , dist
 r = int( kl ) and 255
 g = int( kl / 256 ) and 255
 b = int( kl / 256 / 256 ) and 255
 if dist < 1 then dist = 1
 if sqr((x1-x2)^2+(y1-y2)^2+(z1-z2)^2) < dist then
   call sphere x1,y1,z1,d1,kl
 else
   ax = ( x1 + x2 ) / 2
   ay = ( y1 + y2 ) / 2
   az = ( z1 + z2 ) / 2
   ad = ( d1 + d2 ) / 2
   bx = ( x3 + x4 ) / 2
   by = ( y3 + y4 ) / 2
   bz = ( z3 + z4 ) / 2
   bd = ( d3 + d4 ) / 2
   cx = ( x3 + x2 ) / 2
   cy = ( y3 + y2 ) / 2
   cz = ( z3 + z2 ) / 2
   cd = ( d3 + d2 ) / 2
   a1x = ( ax + cx ) / 2
   a1y = ( ay + cy ) / 2
   a1z = ( az + cz ) / 2
   a1d = ( ad + cd ) / 2
   b1x = ( bx + cx ) / 2
   b1y = ( by + cy ) / 2
   b1z = ( bz + cz ) / 2
   b1d = ( bd + cd ) / 2
   c1x = ( a1x + b1x ) / 2
   c1y = ( a1y + b1y ) / 2
   c1z = ( a1z + b1z ) / 2
   c1d = ( a1d + b1d ) / 2
   scan
   call bezier x1,y1,z1,d1 , ax,ay,az,ad , a1x,a1y,a1z,a1d , c1x,c1y,c1z,c1d , kl , dist
   call bezier c1x,c1y,c1z,c1d , b1x,b1y,b1z,b1d , bx,by,bz,bd , x4,y4,z4,d4 , kl , dist
 end if
end sub

''bluatigro 1 dec 2016
''animation block

function nr$( no , m )
 nr$ = right$( "00000000" ; no , m )
end function

sub saveframe f$ , no , m
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 bmpsave "screen" , f$ + nr$( no , m ) + ".bmp"
end sub

sub dia f$ , no , m , ms
 loadbmp "screen" , f$ + nr$( no , m ) + ".bmp"
 #m "background screen"
 call sleep ms
end sub

sub movie f$ , p , m , ms , k
 for i = 1 to k
   for j = 0 to p
     call dia f$ , j , m , ms
   next j
 next i
end sub

sub sleep ms
 now = time$( "milliseconds" )
 while now + ms > time$( "milliseconds" )
 wend
end sub

''bluatigro 21 nov 2018
''math block

[math]
 global pi , golden.ratio , true , false
 pi = atn( 1 ) * 4
 golden.ratio = ( sqr( 5 ) - 1 ) / 2
 false = 0
 true = not( false )
return

function range( l , h )
 range = rnd(0) * ( h - l ) + l
end function

function iif( bool , t , f )
 uit = f
 if bool then uit = t
 iif = uit
end function

function rad( deg )
''from degrees to radians
 rad = deg * pi / 180
end function

sub rotate byref k , byref l , deg
 s = sin( rad( deg ) )
 c = cos( rad( deg ) )
 hk = k * c - l * s
 hl = k * s + l * c
 k = hk
 l = hl
end sub

''bluatigro 18 nov 2016
''3d engine block
''needs math block

[basis3D]
 global mmax
 mmax = 20
 dim m( ( mmax + 5 ) * 4 * 4 + 16 ) , cam( 6 )
 dim skx( 64 ) , sky( 64 ) , skz( 64 )
 global rotx , roty , rotz  , trans , temp , number , pi
 trans = mmax + 1
 rotx = mmax + 2
 roty = mmax + 3
 rotz = mmax + 4
 temp = mmax + 5
 pi = atn( 1 ) * 4
 global xyz , xzy , yxz , yzx , zxy , zyx
 xzy = 1
 yxz = 2
 yzx = 3
 zxy = 4
 zyx = 5
 call startmatrix
return

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

sub skelet lim , x , y , z
''for animating avatar lim's
 skx( lim ) = x
 sky( lim ) = y
 skz( lim ) = z
end sub

sub child no , x , y , z , lim , ax , p
''for creating lim's of a avatar
 if lim < 0 or lim > 64 then exit sub
 call link no , x , y , z _
 , sky( lim ) , skx( lim ) , skz( lim ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''set draw matrix : wil efect future drawing

''no : number new matrix
''x,y,z : translation
''xz,yz,xy : rotation in degrees
''ax : sequence of axes
''p : number old matrix

 if no < 1 or no > mmax then exit sub
 if p < 0 or p > mmax then exit sub
 if no < 1 or no > mmax then exit sub
 if p < 0 or p > mmax then exit sub
 if p = no then exit sub
''copy matrix 0 into matrix's
 call copy 0 , rotx
 call copy 0 , roty
 call copy 0 , rotz
 call copy 0 , trans
''create rotation matrix's
 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 ) )
''create translation matrix
 m( in( trans , 3 , 0 ) ) = x
 m( in( trans , 3 , 1 ) ) = y
 m( in( trans , 3 , 2 ) ) = z
''select axes sequence [ 1 of 6 ] and act on i
 select case ax
   case xyz
     call multiply rotx , roty , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case xzy
     call multiply rotx , rotz , temp
     call multiply temp , roty , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case yxz
     call multiply roty , rotx , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case yzx
     call multiply roty , rotz , temp
     call multiply temp , rotx , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case zxy
     call multiply rotz , rotx , temp
     call multiply temp , roty , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case zyx
     call multiply rotz , roty , temp
     call multiply temp , rotx , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case else
     call multiply rotx , roty , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
 end select
 number = no
end sub

sub copy a , b
''matrix( b ) = matrix( a )
 for i = 0 to 3
   for j = 0 to 3
     m( in( b , i , j ) ) = m( in( a , i , j ) )
   next j
 next i
end sub

sub spot byref x , byref y , byref z
'''lokal coordinates to world coordinates
''x,y,z = matrix( number ) * x,y,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 - cam( 0 )
 y = hy - cam( 1 )
 z = hz - cam( 2 )
 call rotate x , y , 0 - cam( 5 )
 call rotate y , z , 0 - cam( 4 )
 call rotate x , z , 0 - cam( 3 )
 if cam( 6 ) = 0 then cam( 6 ) = 1
 x = x * cam( 6 )
 y = y * cam( 6 )
 z = z * cam( 6 )
end sub

sub camara x,y,z,pan,tilt,rol,zoom
 cam( 0 ) = x
 cam( 1 ) = y
 cam( 2 ) = z
 cam( 3 ) = pan
 cam( 4 ) = tilt
 cam( 5 ) = rol
 cam( 6 ) = zoom
end sub

sub multiply a , b , c
''matrix( c ) = matrix( a ) * matrix( b )
 for i = 0 to 3
   for j = 0 to 3
     m( in( c , i , j ) ) = 0
     for k = 0 to 3
       m( in( c , i , j ) ) = m( in( c , i , j ) ) _
       + m( in( a , i , k ) ) * m( in( b , k , j ) )
     next k
   next j
 next i
end sub

sub startmatrix
''set startmatrix to unity
 for x = 0 to 3
   for y = 0 to 3
     m( in( 0,x,y ) ) = 0
   next y
   m( in( 0,x,x ) ) = 1
 next x
end sub

function in( no , x , y )
''LB4 has no 3d array's
''so i simulate them
 in = x + y * 4 + no * 16
end function



this gives a other picture then the jpg . why ?
it does not draw good
i know i did not do animation and that i draw yellow

Attachments:

[tsh73]

somehow some spheres are not drawn, at all
Then I removed "up/down" commands, it looks like I saw line connecting these places. Like, sphere was of 0 size.

[tsh73]

It seems that I found it.
Variables defined to be GLOBAL in a GOSUB (, [MATH]) seems to be - local!
(there is some GLOBALs in [basis3D] but it probably not used)
That is, undefined and go as 0.
Then I moved that GLOBAL declarations up where, I got whole picture.
So here we are
WindowWidth = 1040'DisplayWidth
WindowHeight = 800'DisplayHeight
global winx , winy
winx = 1024 ''WindowWidth
winy = 768 ''WindowHeight
nomainwin
global arm,elbow,wrist,leg,knee,enkle
arm = 1
elbow = 2
wrist = 3
leg = 4
knee = 5
enkle = 6
global thumb,index,middle,ring,pinky,leftno,rightno
thumb = 7
index = 10
middle = 13
ring = 16
pinky = 19
leftno = 0
rightno = 32
 global pi , golden.ratio , true , false
gosub [math]
 global black , red , green , yellow
 global blue , magenta , cyan , white
 global pink , orange , gray , purple
gosub [color]
'    notice cyan
'    end
gosub [basis3D]
open "animation example" for graphics as #m
 #m "trapclose [quit]"
 #m "fill lightgray"
 '#m "goto 0 0"
 #m "down"
 #m "boxfilled " ; winx ; " " ; winy
'  #m "up"
 for height = 0 to 300 step 2  'step 2 makes it 3x faster.
   scan
   call link 1 , 0,130,0 , 30,0,0 , xyz , 0
   call ant blue , yellow
 next height
 notice "ready"
wait
[quit]
 close #m
end
''avartar example

sub hand kl , i
call  sphere 0,0,0,10 , kl
call  egg 0,0,5,7 , 0,-20,10,7 , 7 , kl , 0
call  egg 0,0,0,7 , 0,-25,0,7 , 7 , kl , 0
call  egg 0,0,-5,7 , 0,-20,-10,7 , 7 , kl , 0
call  child 6 , 0,-20,10 , ring + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , ring + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , ring + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-25,0 , midle + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , midle + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , midle + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-20,-10 , index + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , index + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , index + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call  child 6 , 0,-10,-20 , thumb + i , xyz , q
call    egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call    child 7 , 0,-10,0 , thumb + i + 1 , xyz , 6
call      egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call      child 8 , 0,-10,0 , thumb + i + 2 , xyz , 7
call        egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
end sub

sub ant kl1 , kl2
call  link 2 , 0,0,0 , 0,0,0 , xyz , 1
call    egg 0,0,0,30 , 0,60,0,0 , 30 , kl1 , 0
call    egg 40,70,0,1 , -40,70,0,1 , 20 , kl1 , 0
call    child 3 , 0,70,0 , neck + leftno , xyz , 2
call      child 4 , 0,40,0 , neck + rightno , zyx , 3
call        egg 0,0,0,25 , 0,-20,-30,0 , 17 , kl1 , 0
call        child 5 , -14,20,0 , eye + rightno , xyz , 4
call          sphere 0,0,0 , 10 , white
call          sphere 0,0,-7 , 5 , black
call        child 5 , 14,20,0 , eye + leftno , xyz , 4
call          sphere 0,0,0 , 10 , white
call          sphere 0,0,-7 , 5 , black
call    child 3 , 40,70,0 , arm + leftno , xzy , 2
call      sphere 0,0,0,10, kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , elbow + leftno, xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , wrist + leftno , yzx , 4
call          hand kl2 , leftno
call    child 3 , -40,70,0 , arm + rightno , xzy , 2
call      sphere 0,0,0,10, kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , elbow + rightno , xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , wrist + rightno , yzx , 4
call          hand kl2 , rightno
call    child 3 , 20,-20,0 , leg + leftno , xyz , 2
call      sphere 0,0,0,10 , kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , knee + leftno, xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , enkle + leftno , zyx , 4
call          egg 0,0,0,14 , 10,-7,-40,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , 0,-7,-45,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , -10,-7,-40,1 , 7 , kl2 , 0
call    child 3 , -20,-20,0 , leg + rightno , xyz , 2
call      sphere 0,0,0,10 , kl2
call      egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call      child 4 , 0,-50,0 , knee + rightno , xyz , 3
call        sphere 0,0,0,10 , kl2
call        egg 0,-10,0,1 , 0,-40,0,1 , 10 , kl1 , 0
call        child 5 , 0,-50,0 , enkle + rightno , zyx , 4
call          egg 0,0,0,14 , 10,-7,-40,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , 0,-7,-45,1 , 7 , kl2 , 0
call          egg 0,0,0,14 , -10,-7,-40,1 , 7 , kl2 , 0
end sub

sub human.walk frame , amp
call skelet leg + leftno , pend( frame , amp ) , 0 , 0
call skelet knee + leftno , pend( frame - 90 , amp ) + amp  , 0 , 0
call skelet leg + rightno , pend( frame + 180 , amp ) , 0 , 0
call skelet knee + rightno , pend( frame + 90 , amp ) + amp , 0 , 0
call skelet arm + leftno , pend( frame + 180 , amp ) , 0 , 0
call skelet elbow + leftno , 0-amp , 0 , 0
call skelet arm + rightno , pend( frame , amp ) , 0 , 0
call skelet elbow + rightno , 0-amp , 0 , 0
end sub

''bluatigro 18 nov 2016
''color block
''needs math block

[color]
 global black , red , green , yellow
 global blue , magenta , cyan , white
 global pink , orange , gray , purple
 black   = rgb(   0 ,   0 ,   0 )
 red     = rgb( 255 ,   0 ,   0 )
'print "red", red
 green   = rgb(   0 , 255 ,   0 )
 yellow  = rgb( 255 , 255 ,   0 )
 blue    = rgb(   0 ,   0 , 255 )
 magenta = rgb( 255 ,   0 , 255 )
 cyan    = rgb(   0 , 255 , 255 )
 white   = rgb( 255 , 255 , 255 )
 pink    = rgb( 255 , 127 , 127 )
 orange  = rgb( 255 , 127 ,   0 )
 gray    = rgb( 127 , 127 , 127 )
 purple  = rgb( 127 ,   0 , 127 )
return

sub setcolor kl
 r = int( kl and 255 )
 g = int( kl / 256 ) and 255
 b = int( kl / 256 / 256 ) and 255
 print #m , "backcolor " ; r ;" "; g ; " "; b
 print #m , "color " ; r ; " " ; g ; " " ; b
end sub

function rgb( r , g , b )
 rgb = ( int( r ) and 255 ) _
 + ( int( g ) and 255 ) * 256 _
 + ( int( b ) and 255 ) * 256 * 256
end function

function rainbow( x )
 r = sin( rad( x ) ) * 127 + 128
 g = sin( rad( x - 120 ) ) * 127 + 128
 b = sin( rad( x + 120 ) ) * 127 + 128
 rainbow = rgb( r , g , b )
end function

function mix( kl1 , f , kl2 )
 r1 = int( kl1 and 255 )
 g1 = int( kl1 / 256 ) and 255
 b1 = int( kl1 / 256 / 256 ) and 255
 r2 = int( kl2 and 255 )
 g2 = int( kl2 / 256 ) and 255
 b2 = int( kl2 / 256 / 256 ) and 255
 r = r1 + ( r2 - r1 ) * f
 g = g1 + ( g2 - g1 ) * f
 b = b1 + ( b2 - b1 ) * f
 mix = rgb( r , g , b )
end function

''bluatigro 18 nov 2016
''sphere world block
''needs color , basis3D and math block

[sphere]
 global height
return

sub sphere x , y , z , d , kl
 scan
 call spot x , y , z
 d = d * cam( 6 )
 dx = winx
 dy = winy
 if height = 0 then
   call setcolor black
   print #m , "place " ; int(dx / 2 + x) ; " " _
   ; int(dy * 5 / 6 - z / 4)
   'print #m , "down"
   print #m , "ellipsefilled " ; int(d * 2) ; " " ; int(d / 2)
   'print #m , "up"
 end if
if k1=red then prtColr=1
 if abs( height - y ) < d then
   dd = sqr( d ^ 2 - ( height - y ) ^ 2 ) * 2
   kl = mix( kl , 1 - ( height - y ) / d / 2 + 0.5 , 0 )
if prtColr then print  kl
   call setcolor kl
   print #m , "place "; int(dx / 2 + x) ;" " _
   ; int(dy * 5 / 6 - height - z / 4)
   'print #m , "down"
   print #m , "ellipsefilled "; int(dd) ;" "; int(dd / 4)
   'print #m , "up"
 end if
end sub

sub egg x1 , y1 , z1 , d1 , x2 , y2 , z2 , d2 , dm , kl , n
 diff = sqr( ( x1 - x2 ) ^ 2 _
           + ( y1 - y2 ) ^ 2 _
           + ( z1 - z2 ) ^ 2 )
 dx = ( x2 - x1 ) / diff
 dy = ( y2 - y1 ) / diff
 dz = ( z2 - z1 ) / diff
 dd = ( d2 - d1 ) / diff
 if dm = 0 then dm = ( d1 + d2 ) / 2
 if n < 3 then n = diff
 for i = 0 to diff step diff / n
   scan
   call sphere x1 + dx * i _
   , y1 + dy * i _
   , z1 + dz * i _
   , d1 + dd * i _
   + sin( i / diff * pi ) _
   * ( dm - ( d1 + d2 ) / 2 ) _
   , kl
 next i
end sub

sub bezier x1,y1,z1,d1 , x2,y2,z2,d2 , x3,y3,z3,d3 , x4,y4,z4,d4 , kl , dist
 r = int( kl ) and 255
 g = int( kl / 256 ) and 255
 b = int( kl / 256 / 256 ) and 255
 if dist < 1 then dist = 1
 if sqr((x1-x2)^2+(y1-y2)^2+(z1-z2)^2) < dist then
   call sphere x1,y1,z1,d1,kl
 else
   ax = ( x1 + x2 ) / 2
   ay = ( y1 + y2 ) / 2
   az = ( z1 + z2 ) / 2
   ad = ( d1 + d2 ) / 2
   bx = ( x3 + x4 ) / 2
   by = ( y3 + y4 ) / 2
   bz = ( z3 + z4 ) / 2
   bd = ( d3 + d4 ) / 2
   cx = ( x3 + x2 ) / 2
   cy = ( y3 + y2 ) / 2
   cz = ( z3 + z2 ) / 2
   cd = ( d3 + d2 ) / 2
   a1x = ( ax + cx ) / 2
   a1y = ( ay + cy ) / 2
   a1z = ( az + cz ) / 2
   a1d = ( ad + cd ) / 2
   b1x = ( bx + cx ) / 2
   b1y = ( by + cy ) / 2
   b1z = ( bz + cz ) / 2
   b1d = ( bd + cd ) / 2
   c1x = ( a1x + b1x ) / 2
   c1y = ( a1y + b1y ) / 2
   c1z = ( a1z + b1z ) / 2
   c1d = ( a1d + b1d ) / 2
   scan
   call bezier x1,y1,z1,d1 , ax,ay,az,ad , a1x,a1y,a1z,a1d , c1x,c1y,c1z,c1d , kl , dist
   call bezier c1x,c1y,c1z,c1d , b1x,b1y,b1z,b1d , bx,by,bz,bd , x4,y4,z4,d4 , kl , dist
 end if
end sub

''bluatigro 1 dec 2016
''animation block

function nr$( no , m )
 nr$ = right$( "00000000" ; no , m )
end function

sub saveframe f$ , no , m
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 bmpsave "screen" , f$ + nr$( no , m ) + ".bmp"
end sub

sub dia f$ , no , m , ms
 loadbmp "screen" , f$ + nr$( no , m ) + ".bmp"
 #m "background screen"
 call sleep ms
end sub

sub movie f$ , p , m , ms , k
 for i = 1 to k
   for j = 0 to p
     call dia f$ , j , m , ms
   next j
 next i
end sub

sub sleep ms
 now = time$( "milliseconds" )
 while now + ms > time$( "milliseconds" )
 wend
end sub

''bluatigro 21 nov 2018
''math block

[math]
 global pi , golden.ratio , true , false
 pi = atn( 1 ) * 4
 golden.ratio = ( sqr( 5 ) - 1 ) / 2
 false = 0
 true = not( false )
return

function range( l , h )
 range = rnd(0) * ( h - l ) + l
end function

function iif( bool , t , f )
 uit = f
 if bool then uit = t
 iif = uit
end function

function rad( deg )
''from degrees to radians
 rad = deg * pi / 180
end function

sub rotate byref k , byref l , deg
 s = sin( rad( deg ) )
 c = cos( rad( deg ) )
 hk = k * c - l * s
 hl = k * s + l * c
 k = hk
 l = hl
end sub

''bluatigro 18 nov 2016
''3d engine block
''needs math block

[basis3D]
 global mmax
 mmax = 20
 dim m( ( mmax + 5 ) * 4 * 4 + 16 ) , cam( 6 )
 dim skx( 64 ) , sky( 64 ) , skz( 64 )
 global rotx , roty , rotz  , trans , temp , number , pi
 trans = mmax + 1
 rotx = mmax + 2
 roty = mmax + 3
 rotz = mmax + 4
 temp = mmax + 5
 pi = atn( 1 ) * 4
 global xyz , xzy , yxz , yzx , zxy , zyx
 xzy = 1
 yxz = 2
 yzx = 3
 zxy = 4
 zyx = 5
 call startmatrix
return

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

sub skelet lim , x , y , z
''for animating avatar lim's
 skx( lim ) = x
 sky( lim ) = y
 skz( lim ) = z
end sub

sub child no , x , y , z , lim , ax , p
''for creating lim's of a avatar
 if lim < 0 or lim > 64 then exit sub
 call link no , x , y , z _
 , sky( lim ) , skx( lim ) , skz( lim ) , ax , p
end sub

sub link no , x , y , z , xz , yz , xy , ax , p
''set draw matrix : wil efect future drawing

''no : number new matrix
''x,y,z : translation
''xz,yz,xy : rotation in degrees
''ax : sequence of axes
''p : number old matrix

 if no < 1 or no > mmax then exit sub
 if p < 0 or p > mmax then exit sub
 if no < 1 or no > mmax then exit sub
 if p < 0 or p > mmax then exit sub
 if p = no then exit sub
''copy matrix 0 into matrix's
 call copy 0 , rotx
 call copy 0 , roty
 call copy 0 , rotz
 call copy 0 , trans
''create rotation matrix's
 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 ) )
''create translation matrix
 m( in( trans , 3 , 0 ) ) = x
 m( in( trans , 3 , 1 ) ) = y
 m( in( trans , 3 , 2 ) ) = z
''select axes sequence [ 1 of 6 ] and act on i
 select case ax
   case xyz
     call multiply rotx , roty , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case xzy
     call multiply rotx , rotz , temp
     call multiply temp , roty , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case yxz
     call multiply roty , rotx , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case yzx
     call multiply roty , rotz , temp
     call multiply temp , rotx , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case zxy
     call multiply rotz , rotx , temp
     call multiply temp , roty , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case zyx
     call multiply rotz , roty , temp
     call multiply temp , rotx , no
     call multiply no , trans , temp
     call multiply temp , p , no
   case else
     call multiply rotx , roty , temp
     call multiply temp , rotz , no
     call multiply no , trans , temp
     call multiply temp , p , no
 end select
 number = no
end sub

sub copy a , b
''matrix( b ) = matrix( a )
 for i = 0 to 3
   for j = 0 to 3
     m( in( b , i , j ) ) = m( in( a , i , j ) )
   next j
 next i
end sub

sub spot byref x , byref y , byref z
'''lokal coordinates to world coordinates
''x,y,z = matrix( number ) * x,y,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 - cam( 0 )
 y = hy - cam( 1 )
 z = hz - cam( 2 )
 call rotate x , y , 0 - cam( 5 )
 call rotate y , z , 0 - cam( 4 )
 call rotate x , z , 0 - cam( 3 )
 if cam( 6 ) = 0 then cam( 6 ) = 1
 x = x * cam( 6 )
 y = y * cam( 6 )
 z = z * cam( 6 )
end sub

sub camara x,y,z,pan,tilt,rol,zoom
 cam( 0 ) = x
 cam( 1 ) = y
 cam( 2 ) = z
 cam( 3 ) = pan
 cam( 4 ) = tilt
 cam( 5 ) = rol
 cam( 6 ) = zoom
end sub

sub multiply a , b , c
''matrix( c ) = matrix( a ) * matrix( b )
 for i = 0 to 3
   for j = 0 to 3
     m( in( c , i , j ) ) = 0
     for k = 0 to 3
       m( in( c , i , j ) ) = m( in( c , i , j ) ) _
       + m( in( a , i , k ) ) * m( in( b , k , j ) )
     next k
   next j
 next i
end sub

sub startmatrix
''set startmatrix to unity
 for x = 0 to 3
   for y = 0 to 3
     m( in( 0,x,y ) ) = 0
   next y
   m( in( 0,x,x ) ) = 1
 next x
end sub

function in( no , x , y )
''LB4 has no 3d array's
''so i simulate them
 in = x + y * 4 + no * 16
end function


[bluatigro]

@ carl :
why are the global's in [ color ] good
and in [math] and [basis3D] not ?

[ in my version . ]

[Rod]

I could guess that Just BASIC does not expect any declarations after SUB. So the global never gets set. Moving it above the SUB allows the global declaration to be seen and acted on.

Best practice is surely to declare all globals at the head of the program. Declaring them randomly throughout SUBs and Functions is bound to end in trouble.

[carlg]

Dec 16, 2018 13:21:51 GMT Rod said:

I could guess that Just BASIC does not expect any declarations after SUB. So the global never gets set. Moving it above the SUB allows the global declaration to be seen and acted on.

Best practice is surely to declare all globals at the head of the program. Declaring them randomly throughout SUBs and Functions is bound to end in trouble.

Perhaps the compiler should stop with an error or at least offer up a warning.