Bluatigro robot sim

[tsh73]

Just to say.
JB 2.0 makes this program work - I only had to remove spritecenter - seems not affected by it, not much anyway
(JB1.01 - doesn't work, needs more sprite commands)
Also added flag to add sprites only once - indeed memory usage was growing without it.

''bluatigro 21 apr 2018
''robot sim : whit 3d sprites
 global mmax
 mmax = 20
 gosub [basis3D]
 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
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , day , year
global s.max , s.tel , state , key$ , factor
global toRad, spritesAdded
toRad=pi / 180
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
year = 365.26
factor = 1
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin   'ms per frame prints there
open "robot sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.cls
'  call sprite.rond 30,30 , 25 _
'  , "yellow" , "yellow" , 1
 call sprite.rond3d 30,30 , 25 _
 ,255,255,0, 1
 #m "getbmp yellow25 0 0 60 120"
 call sprite.cls
'  call sprite.rond 30,30 , 10 _
'  , "blue" , "blue" , 1
 call sprite.rond3d 30,30 , 10 _
 ,0,0,255 , 1
 #m "getbmp blue10 0 0 60 120"
 call sprite.cls
'  call sprite.rond 30,30 , 10 _
'  , "red" , "red" , 1
 call sprite.rond3d 30,30 , 10 _
 ,255,0,0, 1
 #m "getbmp red10 0 0 60 120"
 for i = 0 to s.max
   ry( i ) = i
 next i

 #m "font 50 bold"
 #m "fill black"
 call text 100 , 100 , "robot sim ." _
 , "green" , "black"

 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 scan
 '---------add timer
 '#m "font 30 bold"
 'call text 10 , 150 , "";time$("ms")-t0;" ms per frame" _
 ', "green" , "black"
 print time$("ms")-t0;" ms per frame"
 t0=time$("ms")
 '------------------
 s.tel = 0
 call skelet 0 , pend(angle,30) , 0 , 0
 call skelet 1 , -30 , 0 , 0
 call skelet 2 , pend(angle+180,30) , 0 , 0
 call skelet 3 , -30 , 0 , 0
 call skelet 4 , pend(angle+180,30) , 0 , 0
 call skelet 5 , pend(angle+90,30)+30 , 0 , 0
 call skelet 6 , pend(angle,30) , 0 , 0
 call skelet 7 , pend(angle-90,30)+30 , 0 , 0
 call link 1 , 0,0,0 , angle/10,0,0 , xyz , 0
   call add.atom 0 , 0 , 0 , "yellow25"
   call add.atom 0 , 50 , 0 , "yellow25"
   call child 2 , 30,20,0 , 0 , xzy , 1
     call add.atom 0 , 0 , 0 , "red10"
     call add.atom 0 , -20 , 0 , "red10"
     call child 3 , 0,-40,0 ,1, xyz , 2
       call add.atom 0,0,0 , "red10"
       call add.atom 0,-20,0 , "red10"
       call add.atom 0,-40,0 , "red10"
   call child 2 , -30,20,0 , 2 , xzy , 1
     call add.atom 0 , 0 , 0 , "blue10"
     call add.atom 0 , -20 , 0 , "blue10"
     call child 3 , 0,-40,0 , 3 , xyz , 2
       call add.atom 0,0,0 , "blue10"
       call add.atom 0,-20,0 , "blue10"
       call add.atom 0,-40,0 , "blue10"
   call child 2 , 15,-35,0 , 4 , yzx , 1
     call add.atom 0,0,0 , "red10"
     call add.atom 0,-20,0 , "red10"
     call child 3 , 0,-40,0 , 5 , xyz , 2
       call add.atom 0,0,0 , "red10"
       call add.atom 0,-20,0 , "red10"
       call add.atom 0,-40,0 , "red10"
       call add.atom 0,-60,0 , "red10"
       call add.atom 0,-60,-20 , "red10"
   call child 2 , -15,-35,0 , 6 , yzx , 1
     call add.atom 0,0,0 , "blue10"
     call add.atom 0,-20,0 , "blue10"
     call child 3 , 0,-40,0 , 7 , xyz , 2
       call add.atom 0,0,0 , "blue10"
       call add.atom 0,-20,0 , "blue10"
       call add.atom 0,-40,0 , "blue10"
       call add.atom 0,-60,0 , "blue10"
       call add.atom 0,-60,-20 , "blue10"
spritesAdded=1

   ''sort atom's
 for high = 1 to s.tel - 1
   for low = 0 to high - 1
     if s.z( ry( high ) ) < s.z( ry( low ) ) then
       help = ry( high )
       ry( high ) = ry( low )
       ry( low ) = help
     end if
   next low
 next high
 angle = angle + 5
 ''draw molecule
 for i = 0 to s.tel - 1
   #m "spritetoback spr" ; ry( i )
   #m "spritexy spr" ; ry( i ) ; " " _
   ; winx / 2 + s.x( ry( i ) ) ; " " _
   ; winy / 2 - s.y( ry( i ) ) _
   - s.z( ry( i ) ) / 10
 next i
 #m "drawsprites"
 angle = angle + 5
wait
[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
 close #m
end
sub text x , y , txt$ , l$ , b$
 #m "goto " ; x ; " " ; y
 #m "color " ; l$
 #m "backcolor " ; b$
 #m "down"
 #m "\" ; txt$
 #m "up"
end sub
sub sprite.cls
   #m "fill white"
   #m "goto 0 60"
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 60 120"
   #m "up"
end sub
sub sprite.rect x1,y1,x2,y2,clr$
 #m "goto " ; x1 ; " " ; y1
 #m "size 1"
 #m "color black"
 #m "backcolor black"
 #m "down"
 #m "boxfilled " ; x2 ; " " ; y2
 #m "up"
 #m "goto " ; x1 ; " " ; y1 + 60
 #m "color " ; clr$
 #m "backcolor " ; clr$
 #m "down"
 #m "boxfilled " ; x2 ; " " ; y2 + 60
 #m "up"
end sub
sub sprite.rond x,y,d,clr$,bclr$,size
   #m "goto " ; x ; " " ; y
   #m "size " ; size
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "circlefilled " ; d
   #m "up"
   #m "goto " ; x ; " " ; y + 60
   #m "down"
   #m "color " ; clr$
   #m "backcolor " ; bclr$
   #m "circlefilled " ; d
   #m "up"
end sub
sub sprite.rond3d x,y,d,r,g,b,size
   #m "goto " ; x ; " " ; y
   #m "size " ; size
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "circlefilled " ; d
   #m "up"
   #m "goto " ; x ; " " ; y + 60
   #m "down"
   'in faked 3d
   for RR=d to 1 step -1
       a=(1-RR/d)^.5
       clr$=rgb$(r*a,g*a,b*a)
       #m "color " ; clr$
       #m "backcolor " ; clr$
       #m "place " ; x-(d-RR)/5 ; " " ; y-(d-RR)/5 + 60
       #m "circlefilled " ; RR
       '#m "circle " ; RR
   next
   #m "up"
end sub
sub remove.al.atoms
 if s.tel = 0 then exit sub
 for i = 0 to s.tel
   #m "spriteimage spr" ; i ; " empty"
 next i
 s.tel = 0
end sub
sub add.atom x , y , z , i$
if not(spritesAdded) then
 #m "addsprite spr" ; s.tel ; " " ; i$
 '#m "centersprite spr" ; s.tel
end if
 call spot x , y , z
 s.x( s.tel ) = x
 s.y( s.tel ) = y
 s.z( s.tel ) = z
 s.tel = s.tel + 1
end sub
function rad( deg )
 rad = deg * pi / 180
end function
function rad2( d , i )
 rad = d * pi * 2 / i
end function
function rgb$( r , g , b )
 r = int( r ) and 255
 g = int( g ) and 255
 b = int( b ) and 255
 rgb$ = str$( r ) ; " " ; g ; " " ; b
end function
function rainbow$( deg )
 r = sin( rad( deg ) ) * 127 + 128
 g = sin( rad( deg - 120 ) ) * 127 + 128
 b = sin( rad( deg + 120 ) ) * 127 + 128
 rainbow$ = rgb$( r , g , b )
end function
''bluatigro 18 nov 2016
''3d engine block
''needs math block

[basis3D]
 dim m( ( mmax + 5 ) * 4 * 4 + 16 ) , cam( 6 )
 dim skx( 64 ) , sky( 64 ) , skz( 64 )
 call startmatrix
return

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

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

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
 call copy0 rotx
 call copy0 roty
 call copy0 rotz
 call copy0 trans
''create rotation matrix's
 m( in( rotx , 1 , 1 ) ) = cos( toRad* yz  )
 m( in( rotx , 1 , 2 ) ) = 0-sin( toRad* yz  )
 m( in( rotx , 2 , 1 ) ) = sin( toRad* yz  )
 m( in( rotx , 2 , 2 ) ) = cos( toRad* yz  )

 m( in( roty , 0 , 0 ) ) = cos( toRad* xz  )
 m( in( roty , 0 , 2 ) ) = 0-sin( toRad* xz )
 m( in( roty , 2 , 0 ) ) = sin( toRad* xz )
 m( in( roty , 2 , 2 ) ) = cos( toRad* xz )

 m( in( rotz , 0 , 0 ) ) = cos( toRad* xy )
 m( in( rotz , 0 , 1 ) ) = 0-sin( toRad* xy )
 m( in( rotz , 1 , 0 ) ) = sin( toRad* xy )
 m( in( rotz , 1 , 1 ) ) = cos( toRad* 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 copy0 b
''matrix( b ) = unity matrix
 for i = 0 to 3
   for j = 0 to 3
     m( in( b , i , j ) ) = 0
   next j
   m( in( b , i , i ) ) = 1
 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
'      dest=in( c , i , j )
     dest= c*16 + i + j*4
     m( dest) = 0
     for k = 0 to 3
'        m( dest ) = m( dest ) _
'        + m( in( a , i , k ) ) * m( in( b , k , j ) )
       m( dest ) = m( dest ) _
       + m(  a*16 + i + k*4 ) * m( b*16 + k + j*4 )
     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]

tsh73 :
i remodeled the code
i do not ad sprites anymore

error :
my sprites stay left top

''bluatigro 6 may 2018
''robot sim
 global mmax
 mmax = 20
 gosub [basis3D]
 gosub [sprite]
 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
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi
global s.max , s.tel , state , key$ , factor
winx = WindowWidth
winy = WindowHeight
global leftno,rightno, arm,elbow,leg,knee
leftno = 0
rightno = 32
arm = 0
elbow 1
leg = 3
knee = 4

pi = atn( 1 ) * 4
s.max = 40
factor = 1
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "robot sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.clear 60 , 60
 call sprite.ellipse 30,30 , 25,25 _
 , "yellow" , "yellow" , 1
 #m "getbmp yellow25 0 0 60 120"
 call sprite.clear 60 , 60
 call sprite.ellipse 30,30 , 10,10 _
 , "blue" , "blue" , 1
 #m "getbmp blue10 0 0 60 120"
 call sprite.clear 60 , 60
 call sprite.ellipse 30,30 , 10,10 _
 , "red" , "red" , 1
 #m "getbmp red10 0 0 60 120"
 for i = 0 to s.max
   #m "addsprite spr" ; i ; " red10 blue10 yellow25"
   ry( i ) = i
 next i

 #m "font 50 bold"
 #m "fill black"
 call text 100 , 100 , "robot sim ." _
 , "green" , "black"

 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 call camara 0,0,0 , 0,0,0 , 1
 timer 40 , [timer]
wait
[timer]
 scan
 call skelet leftno+arm, pend(angle,30) , 0 , 0
 call skelet leftno+elbow , -30 , 0 , 0
 call skelet rightno+arm , pend(angle+180,30) , 0 , 0
 call skelet rightno+elbow , -30 , 0 , 0
 call skelet leftno+leg , pend(angle+180,30) , 0 , 0
 call skelet leftno+knee , pend(angle+90,30)+30 , 0 , 0
 call skelet rightno+leg , pend(angle,30) , 0 , 0
 call skelet rightno+knee , pend(angle-90,30)+30 , 0 , 0
 call link 1 , 0,0,0 , angle/10,0,0 , xyz , 0
   call add.atom 0 , 0,0,0 , "yellow25"
   call add.atom 1 , 0,50,0 , "yellow25"
   call child 2 , 30,20,0 , leftno+arm , xzy , 1
     call add.atom 2 , 0,0,0 , "red10"
     call add.atom 3 , 0,-20,0 , "red10"
     call child 3 , 0,-40,0 , leftno+elbow , xyz , 2
       call add.atom 4 , 0,0,0 , "red10"
       call add.atom 5 , 0,-20,0 , "red10"
       call add.atom 6 , 0,-40,0 , "red10"
   call child 2 , -30,20,0 , rightno+arm , xzy , 1
     call add.atom 7 , 0,0,0 , "blue10"
     call add.atom 8 , 0,-20,0 , "blue10"
     call child 3 , 0,-40,0 , rightno+elbow , xyz , 2
       call add.atom 9 , 0,0,0 , "blue10"
       call add.atom 10 , 0,-20,0 , "blue10"
       call add.atom 11 , 0,-40,0 , "blue10"
   call child 2 , 15,-35,0 , leftno+leg , yzx , 1
     call add.atom 12 , 0,0,0 , "red10"
     call add.atom 13 , 0,-20,0 , "red10"
     call child 3 , 0,-40,0 , leftno+knee , xyz , 2
       call add.atom 14 , 0,0,0 , "red10"
       call add.atom 15 , 0,-20,0 , "red10"
       call add.atom 16 , 0,-40,0 , "red10"
       call add.atom 17 , 0,-60,0 , "red10"
       call add.atom 18 , 0,-60,-20 , "red10"
   call child 2 , -15,-35,0 , rightno+leg , yzx , 1
     call add.atom 19 , 0,0,0 , "blue10"
     call add.atom 20 , 0,-20,0 , "blue10"
     call child 3 , 0,-40,0 , rightno+knee , xyz , 2
       call add.atom 21 , 0,0,0 , "blue10"
       call add.atom 22 , 0,-20,0 , "blue10"
       call add.atom 23 , 0,-40,0 , "blue10"
       call add.atom 24 , 0,-60,0 , "blue10"
       call add.atom 25 , 0,-60,-20 , "blue10"
 angle = angle + 5
 ''sort atom's
 for high = 1 to 25
   for low = 0 to high - 1
     if s.z( ry( high ) ) < s.z( ry( low ) ) then
       help = ry( high )
       ry( high ) = ry( low )
       ry( low ) = help
     end if
   next low
 next high
 ''draw molecule
 for i = 0 to s.tel - 1
   x = winx / 2 + s.x( ry( i ) )
   y = winy / 2 - s.y( ry( i ) )
   z = s.z( ry( i ) )
   #m "spritetoback spr" ; ry( i )
   #m "spritexy spr" ; ry( i ) ; " " _
   ; x ; " " ; y - z / 8
 next i
 #m "drawsprites"
wait
[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
 close #m
end
sub text x , y , txt$ , l$ , b$
 #m "goto " ; x ; " " ; y
 #m "color " ; l$
 #m "backcolor " ; b$
 #m "down"
 #m "\" ; txt$
 #m "up"
end sub
''bluatigro 21 apr 2017
''sprite module
[sprite]
 global sprite.width , sprite.height
return
sub sprite.clear w , h
   #m "fill white"
   #m "goto 0 " ; h
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled " ; w ; " " ; h * 2
   #m "up"
   sprite.width = w
   sprite.height = h
end sub
sub sprite.rectangle x1,y1,x2,y2,clr$
 #m "goto " ; x1 ; " " ; y1
 #m "size 1"
 #m "color black"
 #m "backcolor black"
 #m "down"
 #m "boxfilled " ; x2 ; " " ; y2
 #m "up"
 #m "goto " ; x1 ; " " ; y1 + sprite.height
 #m "color " ; clr$
 #m "backcolor " ; clr$
 #m "down"
 #m "boxfilled " ; x2 ; " " ; y2 + 60
 #m "up"
end sub
sub sprite.ellipse x,y,dx,dy,clr$,bclr$,size
   #m "goto " ; x ; " " ; y
   #m "size " ; size
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "ellipsefilled " ; dx ; " " ; dy
   #m "up"
   #m "goto " ; x ; " " ; y + sprite.height
   #m "down"
   #m "color " ; clr$
   #m "backcolor " ; bclr$
   #m "ellipsefilled " ; dx ; " " ; dy
   #m "up"
end sub
sub sprite.pie x,y,dx,dy,a,b,clr$,bclr$,size
   #m "goto " ; x ; " " ; y
   #m "size " ; size
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "piefilled " ; dx ; " " ; dy _
   ; " " ; a ; " " ; b
   #m "up"
   #m "goto " ; x ; " " ; y + sprite.height
   #m "down"
   #m "color " ; clr$
   #m "backcolor " ; bclr$
   #m "piefilled " ; dx ; " " ; dy _
   ; " " ; a ; " " ; b
   #m "up"
end sub
sub sprite.line x1,y1 , x2,y2 , clr$ , size
 #m "color black"
 #m "size " ; size
 #m "down"
 #m "line " ; x1 ; " " ; y1 _
 ; " " ; x2 ; " " ; y2
 #m "up"
 #m "color " ; clr$
 #m "down"
 #m "line " ; x1 ; " " ; y1 + sprite.height _
 ; " " ; x2 ; " " ; y2 + sprite.height
 #m "up"
end sub
sub sprite.getbmp bmnp$
 #m "getbmp " ; bmp$ ; " 0 0 " _
 ; sprite.width ; " " ; sprite.height * 2
end sub
''end sprite draw module
sub remove.al.atoms
 if s.tel = 0 then exit sub
 for i = 0 to s.tel
   #m "spriteimage spr" ; i ; " empty"
 next i
 s.tel = 0
end sub
sub add.atom no , x , y , z , i$
 #m "spriteimage spr" ; no ; " " ; i$
 call spot x , y , z
 s.x( no ) = x
 s.y( no ) = y
 s.z( no ) = z
end sub
function rad( deg )
 rad = deg * pi / 180
end function
function rad2( d , i )
 rad2 = d * pi * 2 / i
end function
function rgb$( r , g , b )
 r = int( r ) and 255
 g = int( g ) and 255
 b = int( b ) and 255
 rgb$ = str$( r ) ; " " ; g ; " " ; b
end function
function rainbow$( deg )
 r = sin( rad( deg ) ) * 127 + 128
 g = sin( rad( deg - 120 ) ) * 127 + 128
 b = sin( rad( deg + 120 ) ) * 127 + 128
 rainbow$ = rgb$( r , g , b )
end function

''bluatigro 6 may 2018
''3d engine module
''needs math module

[basis3D]
 dim m( in( mmax + 6 , 3 , 3 ) ) , cam( 6 )
 dim skx( 64 ) , sky( 64 ) , skz( 64 )
 call startmatrix
return

function pend( fase , amp )
 pend = sin( rad( fase ) ) * amp
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

sub skelet lim , x , y , z
''for animating avatar lim's
 if lim < 0 or lim > 64 then exit sub
 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



[tsh73]

my sprites stay left top

Your s.tel stays 0
Line
s.tel = s.tel + 1
in sub add.atom
is missing.

[bluatigro]

tsh73 :
s.tel is not nesesery anymore
sub add.atom has a no parameter

and even that does not explain the left top sprites
they shoot be in the middle of the sceen

i do somthing wrong but i do not see it

[tsh73]

s.tel is not nesesery anymore

code says:
''draw molecule
 for i = 0 to s.tel - 1

If s.tel is 0, there is no drawing at all.

[tsh73]

Indeed it started walking as I changed
for i = 0 to s.tel - 1
to
for i = 0 to 25

[bluatigro]

tsh73 :
thanks for spotting that

this is now a proof of consept
it is to slow for a game
i wil wait for LB5
before i make a game whit it