isometic 3d sprite's example

[bluatigro]

now you can build 3d isometeric games whit LB


it has 1 disadvantage :

al sprite's must be in the same array variablename


''bluatigro 15 apr 2018

''isometric 3d sprites



WindowWidth = DisplayWidth

WindowHeight = DisplayHeight

global winx , winy , angle , pi , s.max

winx = WindowWidth

winy = WindowHeight

pi = atn( 1 ) * 4

s.max = 40

dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )

nomainwin

open "isometric game demo" for graphics as #m

 #m "trapclose [quit]"

 #m "goto 30 30"

 #m "down"

 #m "color black"

 #m "backcolor black"

 #m "circlefilled 30"

 #m "up"

 for i = 0 to s.max

   #m "goto 0 60"

   #m "down"

   #m "color black"

   #m "backcolor black"

   #m "boxfilled 60 120"

   #m "up"

   #m "goto 30 90"

   #m "down"

   #m "color " ; rainbow$( i * 360 / s.max )

   #m "backcolor " ; rainbow$( i * 360 / s.max )

   #m "circlefilled 30"

   #m "up"

   #m "getbmp bmp" ; i ; " 0 0 60 120"

   #m "addsprite spr" ; i ; " bmp" ; i

   ry( i ) = i

 next i

 timer 40 , [timer]

wait

[timer]

 for i = 0 to s.max

   hoek = angle + i * 360 / s.max

   s.x( i ) = winx / 2 + sin( rad( hoek ) ) * 300

   s.y( i ) = winy / 2

   s.z( i ) = cos( rad( hoek ) ) * 300

 next i

 for high = 1 to s.max

   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

 for i = 0 to s.max

   #m "spritetoback spr" ; ry( i )

   #m "spritexy spr" ; ry( i ) ; " " _

   ; s.x( ry( i ) ) ; " " _

   ; s.y( ry( i ) ) - s.z( ry( i ) ) / 4

 next i

 #m "drawsprites"

 angle = angle + 5

wait

[quit]

 close #m

end

function rad( deg )

 rad = deg * pi / 180

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




[Rod]

The code does not run! Also because you have inserted it under preview it is TWICE as long as it needs be. Post the code under the BBCode tab, that does not double space the code.


            

[bluatigro]

Rod :
there is somthing wrong :
if i post code it get's on 2 place's
about the last post :
by me it does work

update :

real pecspertive 3d sprite's

error :
i see anoing stripe's below my sphere's


''bluatigro 15 apr 2018
''pecspertive 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , s.max
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 #m "size 10"
 #m "goto 50 50"
 #m "down"
 #m "color black"
 #m "backcolor black"
 #m "circle 30"
 #m "up"
 for i = 0 to s.max
   #m "goto 0 100"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 100 200"
   #m "up"
   #m "goto 50 150"
   #m "down"
   #m "color " ; rainbow$( i * 360 / s.max )
   #m "backcolor " ; rainbow$( i * 360 / s.max )
   #m "circle 30"
   #m "up"
   #m "getbmp bmp" ; i ; " 0 0 100 200"
   #m "addsprite spr" ; i ; " bmp" ; i
   #m "centersprite spr" ; i
   ry( i ) = i
   ''create world
   s.x( i ) = range( -300 , 300 )
   s.y( i ) = range( -200 , 200 )
   s.z( i ) = range( -300 , 300 )
 next i
 #m "fill black"
 #m "getbmp back 0 0 1 1"
 #m "background back"
 timer 40 , [timer]
wait
[timer]
 s = sin( rad( 1 ) )
 c = cos( rad( 1 ) )
 ''rotate the world
 for i = 0 to s.max
   x = s.x( i ) * c - s.z( i ) * s
   z = s.x( i ) * s + s.z( i ) * c
   s.x( i ) = x
   s.z( i ) = z
 next i
 ''do not change below this line
 ''sort sphere's
 for high = 1 to s.max
   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
 ''put spehere's on screen
 for i = 0 to s.max
   factor = s.z( ry( i ) ) + 1000
   x = int( winx / 2 + s.x( ry( i ) ) / factor * 1000 )
   y = int( winy / 2 - s.y( ry( i ) ) / factor * 1000 )
   size = int( 100 / factor * 1000 )
   #m "spritescale spr" ; ry( i ) ; " " ; size
   #m "spritetoback spr" ; ry( i )
   #m "spritexy spr" ; ry( i ) ; " " ; x ; " " ; y
 next i
 #m "drawsprites"
 angle = angle + 5
wait
[quit]
 close #m
end
function range( l , h )
 range = rnd(0) * ( h - l ) + l
end function
function rad( deg )
 rad = deg * pi / 180
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



[Rod]

Looks cool, the line is caused by the size 10 statement, use that only when drawing the circle, it should be size 1 for boxfilled.

[bluatigro]

now you can build rotaing molecule's
rem :
the color's are not the same as in science
the symbol's are missing
the size is not good
but you get the point

''bluatigro 15 apr 2018
''isometric 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , s.max , s.tel
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
clr$ = "black red green yellow blue pink cyan white"
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 #m "goto 30 30"
 #m "size 1"
 #m "down"
 #m "color black"
 #m "backcolor black"
 #m "circlefilled 25"
 #m "up"
 for i = 1 to 8
   #m "goto 0 60"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 60 120"
   #m "up"
   #m "goto 30 90"
   #m "down"
   #m "color black"
   #m "backcolor " ; word$( clr$ , i )
   #m "circlefilled 25"
   #m "up"
   #m "getbmp " ; word$( clr$ , i ) _
       ; " 0 0 60 120"
 next i
 for i = 0 to s.max
   ry( i ) = i
 next i
 ''example molecule [ is not exsisting one ]
 call add.atom 30 , 30 , 30 , "black"
 call add.atom 30 , 30 , -30 , "red"
 call add.atom 30 , -30 , 30 , "green"
 call add.atom 30 , -30 , -30 , "yellow"
 call add.atom -30 , 30 , 30 , "blue"
 call add.atom -30 , 30 , -30 , "pink"
 call add.atom -30 , -30 , 30 , "cyan"
 call add.atom -30 , -30 , -30 , "white"

 timer 40 , [timer]
wait
[timer]
 ''rotate molecule
 s = sin( rad( 5 ) )
 c = cos( rad( 5 ) )
 for i = 0 to s.tel - 1
   x = s.x( i ) * c - s.z( i ) * s
   z = s.x( i ) * s + s.z( i ) * c
   s.x( i ) = x
   s.z( i ) = z
 next i
 ''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
 ''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 ) ) / 4
 next i
 #m "drawsprites"
 angle = angle + 1
wait
[quit]
 close #m
end
sub remove.al.atoms
 if s.tel = 0 then exit sub
 for i = 0 to s.tel
   #m "removesprite spr" ; i
 next i
 s.tel = 0
end sub
sub add.atom x , y , z , i$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 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


Rod :
thans for idea for removing stripes

''bluatigro 15 apr 2018
''pecspertive 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , s.max
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 #m "size 10"
 #m "goto 50 50"
 #m "down"
 #m "color black"
 #m "backcolor black"
 #m "circle 30"
 #m "up"
 for i = 0 to s.max
   #m "goto 0 100"
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 100 200"
   #m "up"
   #m "size 10"
   #m "goto 50 150"
   #m "down"
   #m "color " ; rainbow$( i * 360 / s.max )
   #m "backcolor " ; rainbow$( i * 360 / s.max )
   #m "circle 30"
   #m "up"
   #m "getbmp bmp" ; i ; " 0 0 100 200"
   #m "addsprite spr" ; i ; " bmp" ; i
   #m "centersprite spr" ; i
   ry( i ) = i
   ''create world
   s.x( i ) = range( -200 , 200 )
   s.y( i ) = range( -200 , 200 )
   s.z( i ) = range( -200 , 200 )
 next i
 #m "fill black"
 #m "getbmp back 0 0 1 1"
 #m "background back"
 timer 40 , [timer]
wait
[timer]
 s = sin( rad( 1 ) )
 c = cos( rad( 1 ) )
 ''rotate the world
 for i = 0 to s.max
   x = s.x( i ) * c - s.z( i ) * s
   z = s.x( i ) * s + s.z( i ) * c
   s.x( i ) = x
   s.z( i ) = z
 next i
 ''do not change below this line
 ''sort sphere's
 for high = 1 to s.max
   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
 ''put spehere's on screen
 for i = 0 to s.max
   factor = s.z( ry( i ) ) + 1000
   x = int( winx / 2 + s.x( ry( i ) ) / factor * 1000 )
   y = int( winy / 2 - s.y( ry( i ) ) / factor * 1000 )
   size = int( 100 / factor * 1000 )
   #m "spritescale spr" ; ry( i ) ; " " ; size
   #m "spritetoback spr" ; ry( i )
   #m "spritexy spr" ; ry( i ) ; " " ; x ; " " ; y
 next i
 #m "drawsprites"
 angle = angle + 5
wait
[quit]
 close #m
end
function range( l , h )
 range = rnd(0) * ( h - l ) + l
end function
function rad( deg )
 rad = deg * pi / 180
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]

update :

try at a pacman game whit isometric sprite's


error :
the sprite's don't look good
the ghost move code isn't good
[ i REMed it so it can't interfeer ]


''bluatigro 15 apr 2018
''pac man whit 3d world

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , s.max , s.tel , key$
global p.x , p.y , p.z
dim g.x( 4 ) , g.y( 4 ) , g.z( 4 )
p.x = 6
p.y = 0
p.z = 6
for i = 0 to 4
 g.x( i ) = 2
 g.y( i ) = 0
 g.z( i ) = 2
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 400
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
dim maze$( 20 , 20 ) , s.alive( s.max )
nomainwin
clr$ = "yellow brown red darkred " _
    + "pink darkpink blue darkblue " _
    + "green darkgreen cyan darkcyan " _
    + "white black darkgray lightgray"
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 for i = 1 to 16
   d = 25
   if i = 3 then
     d = 10
   end if
   if i = 11 then
     d = 15
   end if
   #m "goto 30 30"
   #m "size 5"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "circlefilled " ; d
   #m "up"
   #m "goto 0 60"
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 60 120"
   #m "up"
   #m "goto 30 90"
   #m "size 5"
   #m "down"
   #m "color black"
   #m "backcolor " ; word$( clr$ , i )
   #m "circlefilled " ; d
   #m "up"
   #m "getbmp " ; word$( clr$ , i ) _
       ; " 0 0 60 120"
 next i
 for i = 0 to s.max
   ry( i ) = i
   s.alive( i ) = 1
 next i
 s.tel = 0
 call add.atom 0 , 0 , 28 , "yellow"
 for i = 0 to 4
   call add.atom -60*4 , 0 , 29-60*4 , "lightgray"
 next i
 j = 0
 while maze$ <> "end"
   j = j + 1
   read maze$
   l = len( maze$ )
   for i = 1 to l
     maze$( i , j ) = mid$( maze$ , i , 1 )
     select case mid$( maze$ , i , 1 )
       case "m"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "blue"
       case "."
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "red"
       case "@"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "cyan"
       case else
     end select
   next i
 wend
 data "mmmmmmmmmmm"
 data "m@.......@m"
 data "m.mmmmmmm.m"
 data "m.m.....m.m"
 data "m.m.mmm.m.m"
 data "m.........m"
 data "m.m.mmm.m.m"
 data "m.m.....m.m"
 data "m.mmmmmmm.m"
 data "m@.......@m"
 data "mmmmmmmmmmm"
 data "end"

 #m "when characterInput [key]"
 #m "setfocus"

 timer 250 , [timer]
wait
[timer]
 scan
 select case key$
   case chr$( _VK_UP )
     if maze$( p.x , p.z + 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) + 60
       p.z = p.z + 1
     end if
   case chr$( _VK_DOWN )
     if maze$( p.x , p.z - 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) - 60
       p.z = p.z - 1
     end if
   case chr$( _VK_LEFT )
     if maze$( p.x - 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) - 60
       p.x = p.x - 1
     end if
   case chr$( _VK_RIGHT )
     if maze$( p.x + 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) + 60
       p.x = p.x + 1
     end if
   case else
 end select
''  for i = 0 to 4
''    dx = range.int( -1 , 1 )
''    dz = range.int( -1 , 1 )
''    while maze$( g.x( i ) + dx _
''               , g.z( i ) + dz ) = "#"
''      dx = range.int( -1 , 1 )
''      dz = range.int( -1 , 1 )
''    wend
''    g.x( i ) = g.x( i ) + dx
''    g.z( i ) = g.z( i ) + dz
''ghost's have number 1 ... 5 so i have to ad 1
''    s.x( i + 1 ) = s.x( i + 1 ) + dx * 60
''    s.z( i + 1 ) = s.z( i + 1 ) + dz * 60
''  next i
 key$ = ""
 #m "spritecollides spr0 list$"
 i = 1
 while word$( list$ , i ) <> ""
   q$ = word$( list$ , i )
   q = val( right$( q$ , len( q$ ) - 3 ) )
''    s.alive( q ) = 0
   i = i + 1
 wend
 ''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
 ''draw world
 for i = 0 to s.tel - 1
   if s.alive( ry( i ) ) then
     #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 ) ) / 2
   end if
 next i
 #m "drawsprites"
wait
[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
 close #m
end
function range.int( l , h )
 range.int = int( rnd(0) * ( h - l + 1 ) + 1 )
end function
sub add.atom x , y , z , i$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 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]

update :
game : name the molecule
i got the color code's from a book

i wil ad more molecules in the future

i want the symbol's on the atom's


''bluatigro 16 apr 2018
''name the molecule : whit 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi
global s.max , s.tel , state , key$
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 for i = 1 to 8
   read name$ , clr$ , d
 #m "goto 30 30"
 #m "size 5"
 #m "down"
 #m "color black"
 #m "backcolor black"
 #m "circlefilled " ; d
 #m "up"
   #m "goto 0 60"
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 60 120"
   #m "up"
   #m "goto 30 90"
   #m "size 5"
   #m "down"
   #m "color black"
   #m "backcolor " ; clr$
   #m "circlefilled " ; d
   #m "up"
   #m "getbmp " ; name$ _
       ; " 0 0 60 120"
 next i
 for i = 0 to s.max
   ry( i ) = i
 next i
data "H" , "white" , 15
data "C" ,"black" , 20
data "N" , "blue" , 20
data "O" , "red" , 20
data "F" , "green" , 20
data "P" , "255 127 0" , 25
data "S" , "yellow" , 25
data "Cl" , "darkgreen" , 25

 #m "font 30 bold"
 #m "fill lightgray"
 call text 10 , 40 , "name the molecule ." _
 , "black" , "lightgray"
 call text 10 , 100 , "H" , "black" , "white"
 call text 50 , 100 , "C" , "white" , "black"
 call text 90 , 100 , "N" , "white" , "blue"
 call text 130 , 100 , "O" , "white" , "red"
 call text 10 , 170 , "F" , "black" , "green"
 call text 50 , 170 , "P" , "white" , "255 127 0"
 call text 90 , 170 , "S" , "black" , "yellow"
 call text 130 , 170 , "Cl" , "white" , "darkgreen"
 for i = 0 to s.max
   #m "addsprite spr" ; i ; " H C N O F P S"
 next i
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 if key$ = " " then
   state = state + 1
   if state >= 2 then
     state = 0
   end if
 end if
 key$ = ""
 call remove.al.atoms
 select case state
   case 0
     call add.atom -20 , 0 , 0 , "O"
     call add.atom 20 , 0 , 0 , "O"
   case 1
     call add.atom 0 , 0 , 0 , "C"
     call add.atom -30 , 0 , 0 , "O"
     call add.atom 30 , 0 , 0 , "O"
   case else
 end select
 ''rotate molecule
 s = sin( rad( angle ) )
 c = cos( rad( angle ) )
 for i = 0 to s.tel - 1
   x = s.x( i ) * c - s.z( i ) * s
   z = s.x( i ) * s + s.z( i ) * c
   s.x( i ) = x
   s.z( i ) = z
 next i
 ''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
 ''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 ) ) / 4
 next i
 #m "drawsprites"
 angle = angle + 5
wait
[key]
 key$ = Inkey$
 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 remove.al.atoms
 if s.tel = 0 then exit sub
 for i = 0 to s.tel
   #m "spritexy spr" ; i ; " -200 -200"
 next i
 s.tel = 0
end sub
sub add.atom x , y , z , i$
 #m "spriteimage spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 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]

update :
3d pac man whit better sprite's

error :
the ghost's don't move good


''bluatigro 15 apr 2018
''pac man whit 3d world

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , s.max , s.tel , key$
global p.x , p.y , p.z
dim g.x( 4 ) , g.y( 4 ) , g.z( 4 )
p.x = 6
p.y = 0
p.z = 6
for i = 0 to 4
 g.x( i ) = 2
 g.y( i ) = 0
 g.z( i ) = 2
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 400
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
dim maze$( 20 , 20 ) , s.alive( s.max )
nomainwin
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
   call sprite.cls
   call sprite.rond 30 , 30 , 25 , "black" , "yellow" , 5
   call sprite.rond 15 , 30 , 10 , "black" , "white" , 1
   call sprite.rond 15 , 30 , 7 , "black" , "black" , 1
   call sprite.rond 45 , 30 , 10 , "black" , "white" , 1
   call sprite.rond 45 , 30 , 7 , "black" , "black" , 1    
   #m "getbmp player 0 0 60 120"
   call sprite.cls
   call sprite.rond 30 , 30 , 25 , "black" , "Red" , 5
   call sprite.rond 15 , 30 , 10 , "black" , "white" , 1
   call sprite.rond 15 , 30 , 7 , "black" , "black" , 1
   call sprite.rond 45 , 30 , 10 , "black" , "white" , 1
   call sprite.rond 45 , 30 , 7 , "black" , "black" , 1
   #m "getbmp hunt 0 0 60 120"
   call sprite.cls
   call sprite.rond 30 , 30 , 25 , "black" , "blue" , 5
   #m "getbmp wall 0 0 60 120"
   call sprite.cls
   call sprite.rond 30 , 30 , 10 , "black" , "cyan" , 5
   #m "getbmp pil 0 0 60 120"
   call sprite.cls
   call sprite.rond 30 , 30 , 15 , "black" , "cyan" , 5
   #m "getbmp super 0 0 60 120"
 for i = 0 to s.max
   ry( i ) = i
   s.alive( i ) = 1
 next i
 s.tel = 0
 call add.atom 0 , 0 , 28 , "player"
 for i = 0 to 4
   call add.atom -60*4 , 0 , 29-60*4 , "hunt"
 next i
 j = 0
 while maze$ <> "end"
   j = j + 1
   read maze$
   l = len( maze$ )
   for i = 1 to l
     maze$( i , j ) = mid$( maze$ , i , 1 )
     select case mid$( maze$ , i , 1 )
       case "m"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "wall"
       case "."
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "pil"
       case "@"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "super"
       case else
     end select
   next i
 wend
 data "mmmmmmmmmmm"
 data "m@.......@m"
 data "m.mmmmmmm.m"
 data "m.m.....m.m"
 data "m.m.mmm.m.m"
 data "m.........m"
 data "m.m.mmm.m.m"
 data "m.m.....m.m"
 data "m.mmmmmmm.m"
 data "m@.......@m"
 data "mmmmmmmmmmm"
 data "end"

 #m "when characterInput [key]"
 #m "setfocus"

 timer 250 , [timer]
wait
[timer]
 scan
 select case key$
   case chr$( _VK_UP )
     if maze$( p.x , p.z + 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) + 60
       p.z = p.z + 1
     end if
   case chr$( _VK_DOWN )
     if maze$( p.x , p.z - 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) - 60
       p.z = p.z - 1
     end if
   case chr$( _VK_LEFT )
     if maze$( p.x - 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) - 60
       p.x = p.x - 1
     end if
   case chr$( _VK_RIGHT )
     if maze$( p.x + 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) + 60
       p.x = p.x + 1
     end if
   case else
 end select
''  for i = 0 to 4
''    dx = range.int( -1 , 1 )
''    dz = range.int( -1 , 1 )
''    while maze$( g.x( i ) + dx _
''               , g.z( i ) + dz ) = "#"
''      dx = range.int( -1 , 1 )
''      dz = range.int( -1 , 1 )
''    wend
''    g.x( i ) = g.x( i ) + dx
''    g.z( i ) = g.z( i ) + dz
''    s.x( i + 1 ) = s.x( i + 1 ) + dx * 60
''    s.z( i + 1 ) = s.z( i + 1 ) + dz * 60
''  next i
 key$ = ""
 #m "spritecollides spr0 list$"
 i = 1
 while word$( list$ , i ) <> ""
   q$ = word$( list$ , i )
   q = val( right$( q$ , len( q$ ) - 3 ) )
''    s.alive( q ) = 0
   i = i + 1
 wend
 ''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
 ''draw world
 for i = 0 to s.tel - 1
   if s.alive( ry( i ) ) then
     #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 ) ) / 2
   end if
 next i
 #m "drawsprites"
wait
[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
 close #m
end
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.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
function range.int( l , h )
 range.int = int( rnd(0) * ( h - l + 1 ) + 1 )
end function
sub add.atom x , y , z , i$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 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



i added more chemical's to name the chemical

error :
i get a out of array spr error


''bluatigro 16 apr 2018
''name the chemical | molecule : whit 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi
global s.max , s.tel , state , key$
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
 for i = 1 to 8

  read name$ , clr$ , d
 #m "goto 30 30"
 #m "size 5"
 #m "down"
 #m "color black"
 #m "backcolor black"
 #m "circlefilled " ; d
 #m "up"
   #m "goto 0 60"
   #m "size 1"
   #m "down"
   #m "color black"
   #m "backcolor black"
   #m "boxfilled 60 120"
   #m "up"
   #m "goto 30 90"
   #m "size 5"
   #m "down"
   #m "color black"
   #m "backcolor " ; clr$
   #m "circlefilled " ; d
   #m "up"
   #m "getbmp " ; name$ _
       ; " 0 0 60 120"
 next i
 for i = 0 to s.max
   ry( i ) = i
 next i
data "H" , "white" , 15
data "C" ,"black" , 20
data "N" , "blue" , 20
data "O" , "red" , 20
data "F" , "green" , 20
data "P" , "255 127 0" , 25
data "S" , "yellow" , 25
data "Cl" , "darkgreen" , 25
data "end" , "" , 1

 #m "font 30 bold"
 #m "fill lightgray"
 call text 100 , 40 , "name the chemical | molecule ." _
 , "black" , "lightgray"
 call text 10 , 100 , "H" , "black" , "white"
 call text 50 , 100 , "C" , "white" , "black"
 call text 90 , 100 , "N" , "white" , "blue"
 call text 130 , 100 , "O" , "white" , "red"
 call text 10 , 170 , "F" , "black" , "green"
 call text 50 , 170 , "P" , "white" , "255 127 0"
 call text 90 , 170 , "S" , "black" , "yellow"
 call text 130 , 170 , "Cl" , "white" , "darkgreen"
 for i = 0 to s.max
   #m "addsprite spr" ; i ; " H C N O F P S Cl"
 next i
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 if key$ = " " then
   state = state + 1
   ''call remove.al.atoms
   if state >= 13 then
     state = 0
   end if
 end if
 key$ = ""
 s.tel = 0
 select case state
 ''air chemical's
   case 0  ''O2
     call add.atom -40 , 0 , 0 , "O"
     call add.atom 40 , 0 , 0 , "O"
   case 1  ''N2
     call add.atom -40 , 0 , 0 , "N"
     call add.atom 40 , 0 , 0 , "N"
   case 2  ''CO2
     call add.atom 0 , 0 , 0 , "C"
     call add.atom -60 , 0 , 0 , "O"
     call add.atom 60 , 0 , 0 , "O"
   case 3  ''O3"
     call add.atom 0 , 0 , 0 , "O"
     call add.atom -40 , -20 , 0 , "O"
     call add.atom 40 , -20 , 0 , "O"
   case 4  ''H2O
     call add.atom 0 , 0 , 0 , "O"
     call add.atom -40 , -20 , 0 , "H"
     call add.atom 40 , -20 , 0 , "H"
   case 5   ''NH3
     call add.atom 0 , 0 , 0 , "N"
     call add.atom -40 , -20 , 0 , "H"
     call add.atom 40 , -20 , 0 , "H"
     call add.atom 0 , 40 , 0 , "H"
   case 6  ''SO2
     call add.atom 0 , 0 , 0 , "S"
     call add.atom -50 , -25 , 0 , "O"
     call add.atom 50 , -25 , 0 , "O"
   case 7  ''SO3
     call add.atom 0 , 0 , 0 , "S"
     call add.atom -50 , -25 , 0 , "O"
     call add.atom 50 , -25 , 0 , "O"    
     call add.atom 0 , 50 , 0 , "O"
   case 8  ''SO4
     call add.atom 0 , 0 , 0 , "S"
     call add.atom 40 , 40 , 40 , "O"
     call add.atom -40 , -40 , 40 , "O"      
     call add.atom -40 , 40 , -40 , "O"
     call add.atom 40 , -40 , -40 , "O"  
   case 9  ''NO
     call add.atom -40 , 0 , 0 , "N"
     call add.atom 40 , 0 , 0 , "O"
   case 10 ''NO2
     call add.atom 0 , 0 , 0 , "N"
     call add.atom -40 , -20 , 0 , "O"
     call add.atom 40 , -20 , 0 , "O"
   case 11  ''NHO3
     call add.atom 0 , 0 , 0 , "N"
     call add.atom -40 , -20 , 0 , "O"
     call add.atom 40 , -20 , 0 , "O"
     call add.atom 0 , 40 , 0 , "O"
     call add.atom 40 , 60 , 0 , "H"
   case 12 'O2
     call add.atom 0 , 40 , 0 , "O"
     call add.atom 0 , -40 , 0 , "O"
     call add.atom -40 , 60 , 0 , "H"
     call add.atom 40 , -60 , 0 , "H"
   case 13'C2H3O5N  
   case else
 end select
 ''rotate molecule
 s = sin( rad( angle ) )
 c = cos( rad( angle ) )
 for i = 0 to s.tel - 1
   x = s.x( i ) * c - s.z( i ) * s
   z = s.x( i ) * s + s.z( i ) * c
   s.x( i ) = x
   s.z( i ) = z
 next i
 ''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
 ''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 ) ) / 4
 next i
 #m "drawsprites"
 angle = angle + 5
wait
[key]
 key$ = Inkey$
 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 remove.al.atoms
 if s.tel = 0 then exit sub
 for i = 0 to s.tel
   #m "spritexy spr" ; i ; " 0 0"
   #m "spritescale spr" ; i ; " 1"
 next i
 s.tel = 0
end sub
sub add.atom x , y , z , i$
 #m "spriteimage spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 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]

update :
solar system sim
rem :
the data of day's and distance's and size's in not good
but you get the picture

''bluatigro 18 apr 2018
''solar system sim : whit 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , day
global s.max , s.tel , state , key$
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 40
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max ) , ry( s.max )
nomainwin
open "solar system sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.cls
 call sprite.rond 30 , 30 , 25 _
 , "red" , "255 127 0" , 5
 call sprite.rond 30 , 30 , 15 _
 , "yellow" , "white" , 5
 #m "getbmp sun 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 10 _
 , "blue" , "blue" , 1
 #m "getbmp earth 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 5 _
 , "lightgray" , "lightgray" , 1
 #m "getbmp moon 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "red" , "red" , 1
 #m "getbmp mars 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "darkgray" , "darkgray" , 1
 #m "getbmp mercure 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "yellow" , "yellow" , 1
 #m "getbmp venus 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 , "solarsystem sim ." _
 , "green" , "black"
 call add.atom 0 , 0 , 0 , "sun"
 call add.atom 0 , 0 , 0 , "mercure"
 call add.atom 0 , 0 , 0 , "venus"
 call add.atom 0 , 0 , 0 , "earth"
 call add.atom 0 , 0 , 0 , "moon"
 call add.atom 0 , 0 , 0 , "mars"
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 ''the sun don't move
 ''mercure
 s.x( 1 ) = sin( rad( day , 88 ) ) * 66
 s.z( 1 ) = cos( rad( day , 88 ) ) * 66
 ''venus
 s.x( 2 ) = sin( rad( day , 127 ) ) * 120
 s.z( 2 ) = cos( rad( day , 127 ) ) * 120
 ''earth
 s.x( 3 ) = sin( rad( day , 365 ) ) * 200
 s.z( 3 ) = cos( rad( day , 365 ) ) * 200
 ''moon
 s.x( 4 ) = s.x( 3 ) _
 + sin( rad( day , 28 ) ) * 25
 s.z( 4 ) = s.z( 3 ) _
 + cos( rad( day , 28 ) ) * 25
 ''mars
 s.x( 5 ) = sin( rad( day , 600 ) ) * 250
 s.z( 5 ) = cos( rad( day , 600 ) ) * 250
 day = day + 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
 ''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$ = Inkey$
 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 back"
   #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 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$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 rad( 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]

update :
solar system sim now whit good day's ans distance
the size's are not good
i did that on wil
so you can see all stuff


''bluatigro 19 apr 2018
''solar system sim : whit 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , day , year
global s.max , s.tel , state , key$ , factor
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
open "solar system sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.cls
 call sprite.rond 30 , 30 , 25 _
 , "red" , "255 127 0" , 5
 call sprite.rond 30 , 30 , 15 _
 , "yellow" , "white" , 5
 #m "getbmp sun 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "darkgray" , "darkgray" , 1
 #m "getbmp mercure 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "yellow" , "yellow" , 1
 #m "getbmp venus 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 10 _
 , "blue" , "blue" , 1
 #m "getbmp earth 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 5 _
 , "lightgray" , "lightgray" , 1
 #m "getbmp moon 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "red" , "red" , 1
 #m "getbmp mars 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 20 _
 , "yellow" , "red" , 7
 #m "getbmp jupiter 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "yellow" , "yellow" , 1
 #m "getbmp saturn 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "blue" , "blue" , 1
 #m "getbmp neptune 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "yellow" , "yellow" , 1
 #m "getbmp uranus 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "lightgray" , "lightgray" , 1
 #m "getbmp pluto 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 , "solarsystem sim ." _
 , "green" , "black"
 call add.atom 0 , 0 , 0 , "sun"
 call add.atom 0 , 0 , 0 , "mercure"
 call add.atom 0 , 0 , 0 , "venus"
 call add.atom 0 , 0 , 0 , "earth"
 call add.atom 0 , 0 , 0 , "moon"
 call add.atom 0 , 0 , 0 , "mars"
 call add.atom 0 , 0 , 0 , "jupiter"
 call add.atom 0 , 0 , 0 , "saturn"
 call add.atom 0 , 0 , 0 , "neptune"
 call add.atom 0 , 0 , 0 , "uranus"
 call add.atom 0 , 0 , 0 , "pluto"
 
 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 if key$ = chr$( _VK_UP ) _
 and factor < 1 then
   factor = factor * 1.2
 end if
 if key$ = chr$( _VK_DOWN ) _
 and factor > 1/5 then
   factor = factor / 1.2
 end if
 key$ = ""
 ''the sun don't move
 ''mercure
 s.x( 1 ) = sin( rad( day , 88 ) ) _
 * 69.7 * factor
 s.z( 1 ) = cos( rad( day , 88 ) ) _
 * 69.7 * factor
 ''venus
 s.x( 2 ) = sin( rad( day , 224.7 ) ) _
 * 109 * factor
 s.z( 2 ) = cos( rad( day , 224.7 ) ) _
 * 109 * factor
 ''earth
 s.x( 3 ) = sin( rad( day , year ) ) _
 * 152.1 * factor
 s.z( 3 ) = cos( rad( day , year ) ) _
 * 152.1 * factor
 ''moon
 s.x( 4 ) = s.x( 3 ) _
 + sin( rad( day , 27.32 ) ) _
 * 10 * factor
 s.z( 4 ) = s.z( 3 ) _
 + cos( rad( day , 27.32 ) ) _
 * 10 * factor
 ''mars
 s.x( 5 ) = sin( rad( day , 687 ) ) _
 * 249.1 * factor
 s.z( 5 ) = cos( rad( day , 687 ) ) _
 * 249.1 * factor
 ''jupiter
 s.x( 6 ) = sin( rad( day , 11.96 * year ) ) _
 * 815.7 * factor
 s.z( 6 ) = cos( rad( day , 11.96 * year ) ) _
 * 815.7 * factor
 ''saturn
 s.x( 7 ) = sin( rad( day , 29.46 * year ) ) _
 * 1507 * factor
 s.z( 7 ) = cos( rad( day , 29.46 * year ) ) _
 * 1507 * factor
 ''neptune
 s.x( 8 ) = sin( rad( day , 84.01 * year ) ) _
 * 3004 * factor
 s.z( 8 ) = cos( rad( day , 84.01 * year ) ) _
 * 3004 * factor
 ''uranus
 s.x( 9 ) = sin( rad( day , 164.1 * year ) ) _
 * 4337 * factor
 s.z( 9 ) = cos( rad( day , 164.1 * year ) ) _
 * 4337 * factor
   ''pluto
 s.x( 10 ) = sin( rad( day , 247.7 * year ) ) _
 * 7375 * factor
 s.z( 10 ) = cos( rad( day , 247.7 * year ) ) _
 * 7375 * factor
   day = day + 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
 ''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 back"
   #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 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$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 rad( 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]

update :

building a set of sprite.* stuf

how to use my sprite.* code :

1 : gosub [sprite] in begin code

for every spritevar :

2 : call sprite.clear width , height

3 : draw what you want

4 : call sprite.getbmp bmp$

5 : use bmp in sprite

''bluatigro 15 apr 2018
''pac man whit 3d world

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , s.max , s.tel , key$
global p.x , p.y , p.z
dim g.x( 4 ) , g.y( 4 ) , g.z( 4 )
p.x = 6
p.y = 0
p.z = 6
for i = 0 to 4
 g.x( i ) = 2
 g.y( i ) = 0
 g.z( i ) = 2
next i
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
s.max = 600
dim s.x( s.max ) , s.y( s.max ) , s.z( s.max )
dim s.name$( s.max ) , ry( s.max )
dim maze$( 20 , 20 ) , s.state$( s.max )
nomainwin
gosub [sprite]
open "isometric game demo" for graphics as #m
 #m "trapclose [quit]"
   call sprite.clear 60 , 60
   call sprite.getbmp "empty"
   call sprite.clear 60 , 60
   call sprite.ellipse 30 , 30 , 25 , 25 _
   , "black" , "yellow" , 1
   call sprite.ellipse 20 , 30 , 10 , 10 _
   , "black" , "white" , 1
   call sprite.ellipse 20 , 30 , 7 , 7 _
   , "black" , "black" , 1
   call sprite.ellipse 40 , 30 , 10 , 10 _
   , "black" , "white" , 1
   call sprite.ellipse 40 , 30 , 7 , 7 _
   , "black" , "black" , 1    
   call sprite.getbmp "player"
   call sprite.clear 60 , 60
   call sprite.ellipse 30 , 30 , 25 , 25 _
   , "black" , "Red" , 1
   call sprite.ellipse 20 , 30 , 10 , 10 _
   , "black" , "white" , 1
   call sprite.ellipse 20 , 30 , 7 , 7 _
   , "black" , "black" , 1
   call sprite.ellipse 40 , 30 , 10 , 10 _
   , "black" , "white" , 1
   call sprite.ellipse 40 , 30 , 7  , 7 _
   , "black" , "black" , 1
   call sprite.getbmp "hunt"
   call sprite.clear 60 , 60
   call sprite.rectangle 10 , 10 , 50 , 20 _
   , "255 127 0"
   call sprite.rectangle 10 , 20 , 50 , 50 _
   , "127 63 0"
   call sprite.getbmp "wall"
   call sprite.clear 60 , 60
   call sprite.ellipse 30 , 30 , 10 , 10 _
   , "blue" , "blue" , 5
   call sprite.getbmp "pil"
   call sprite.clear 60 , 60
   call sprite.ellipse 30 , 30 , 15 , 15 _
   , "cyan" , "cyan" , 5
   #m "getbmp super 0 0 60 120"
 for i = 0 to s.max
   ry( i ) = i
   s.state$( i ) = "on"
 next i
 s.tel = 0
 call add.atom 0 , 0 , 28 , "player"
 for i = 0 to 4
   call add.atom -60*4 , 0 , 29-60*4 , "hunt"
   s.state$( i + 1 ) = "hunt"
 next i
 j = 0
 while maze$ <> "end"
   j = j + 1
   read maze$
   l = len( maze$ )
   for i = 1 to l
     maze$( i , j ) = mid$( maze$ , i , 1 )
     select case mid$( maze$ , i , 1 )
       case "m"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "wall"
       case "."
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "pil empty"
       case "@"
         call add.atom _
         ( i - .5 - l / 2 ) * 60 _
         , 0 , ( j - 5.5 ) * 60 , "super empty"
       case else
     end select
   next i
 wend
 data "mmmmmmmmmmm"
 data "m@.......@m"
 data "m.mmmmmmm.m"
 data "m.m.....m.m"
 data "m.m.mmm.m.m"
 data "m.........m"
 data "m.m.mmm.m.m"
 data "m.m.....m.m"
 data "m.mmmmmmm.m"
 data "m@.......@m"
 data "mmmmmmmmmmm"
 data "end"

 #m "when characterInput [key]"
 #m "setfocus"

 timer 250 , [timer]
wait
[timer]
 scan
 select case key$
   case chr$( _VK_UP )
     if maze$( p.x , p.z + 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) + 60
       p.z = p.z + 1
     end if
   case chr$( _VK_DOWN )
     if maze$( p.x , p.z - 1 ) <> "m" then
       s.z( 0 ) = s.z( 0 ) - 60
       p.z = p.z - 1
     end if
   case chr$( _VK_LEFT )
     if maze$( p.x - 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) - 60
       p.x = p.x - 1
     end if
   case chr$( _VK_RIGHT )
     if maze$( p.x + 1 , p.z ) <> "m" then
       s.x( 0 ) = s.x( 0 ) + 60
       p.x = p.x + 1
     end if
   case else
 end select
''  for i = 0 to 4
''    dx = rand.int( 2 ) - 1
''    dz = rand.int( 2 ) - 1
''    while maze$( g.x( i ) + dx _
''               , g.z( i ) + dz ) = "#"
''      dx = rand.int( 2 ) - 1
''      dz = rand.int( 2 ) - 1
''    wend
''    g.x( i ) = g.x( i ) + dx
''    g.z( i ) = g.z( i ) + dz
''    s.x( i + 1 ) = s.x( i + 1 ) + dx * 60
''    s.z( i + 1 ) = s.z( i + 1 ) + dz * 60
''  next i
 key$ = ""
 #m "spritecollides spr0 list$"
 i = 1
 while word$( list$ , i ) <> ""
   q$ = word$( list$ , i )
   q = val( right$( q$ , len( q$ ) - 3 ) )
   if ( s.name$ = "pil" _
   or s.name$ = "super" ) _
   and s.state$( q ) = "on" then
''      #m "spriteimage spr" ; q ; " empty"
''      s.state$( q ) = "off"
   end if
   if s.name$ = "hunt" _
   and s.state$( q ) = "hunt" then
''      timer 0
''      notice "GAME OVER"
   end if
   i = i + 1
 wend
 ''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
 ''draw world
 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 ) ) / 2
 next i
 #m "drawsprites"
wait
[key]
 key$ = right$( Inkey$ , 1 )
 if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
 close #m
end
''this wil be a module
[sprite]
 global sprite.width , sprite.height
return
sub sprite.clear w , h
''clear sprite and set dimension's
   #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$
''draw a rectangle on the sprite
 #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 + sprite.height
 #m "up"
end sub
sub sprite.ellipse x,y,dx,dy,pen$,brush$,size
''draw a ellipse on the sprite
   #m "goto " ; x ; " " ; y
   #m "size " ; size
   #m "down"
   #m "color back"
   #m "backcolor black"
   if brush$ = "trans" then
     #m "ellipse " ; dx ; " " ; dy
   else
     #m "ellipsefilled " ; dx ; " " ; dy
   end if
   #m "up"
   #m "goto " ; x ; " " ; y + sprite.height
   #m "down"
   #m "color " ; pen$
   #m "backcolor " ; brush$
   if brush$ = "trans" then
     #m "ellipse " ; dx ; " " ; dy
   else
     #m "ellipsefilled " ; dx ; " " ; dy
   end if
   #m "up"
end sub
sub sprite.getbmp bmp$
 #m "getbmp " ; bmp$ ; " 0 0 " _
 ; sprite.width ; " " ; sprite.height * 2
end sub
''end sprite module
function rand.int( h )
 dice = int( rnd(0) * ( h + 1 ) )
end function
sub add.atom x , y , z , i$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 s.x( s.tel ) = x
 s.y( s.tel ) = y
 s.z( s.tel ) = z
 s.name$( s.tel ) = word$( i$ , 1 )
 s.tel = s.tel + 1
end sub
function rad( deg )
 rad = deg * pi / 180
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]

update :
3d engine added

now you can link 3d sprites togeter

it is a litle slow
but a proof of concept


''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
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
open "robot sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.cls
 call sprite.rond 30,30 , 25 _
 , "yellow" , "yellow" , 1
 #m "getbmp yellow25 0 0 60 120"
 call sprite.cls
 call sprite.rond 30,30 , 10 _
 , "blue" , "blue" , 1
 #m "getbmp blue10 0 0 60 120"
 call sprite.cls
 call sprite.rond 30,30 , 10 _
 , "red" , "red" , 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
 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"

   ''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 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$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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( 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
 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]

solar sytem update :
tsh73 reported a error i fixed that

new and tested :

''bluatigro 22 apr 2018
''solar system sim : whit 3d sprites

WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , angle , pi , day , year
global s.max , s.tel , state , key$ , factor
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
open "solar system sim" for graphics as #m
 #m "trapclose [quit]"
 call sprite.cls
 call sprite.rond 30 , 30 , 25 _
 , "red" , "255 127 0" , 5
 call sprite.rond 30 , 30 , 15 _
 , "yellow" , "white" , 5
 #m "getbmp sun 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "darkgray" , "darkgray" , 1
 #m "getbmp mercure 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "yellow" , "yellow" , 1
 #m "getbmp venus 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 10 _
 , "blue" , "blue" , 1
 #m "getbmp earth 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 5 _
 , "lightgray" , "lightgray" , 1
 #m "getbmp moon 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "red" , "red" , 1
 #m "getbmp mars 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 20 _
 , "yellow" , "red" , 7
 #m "getbmp jupiter 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "yellow" , "yellow" , 1
 #m "getbmp saturn 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "blue" , "blue" , 1
 #m "getbmp neptune 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 18 _
 , "yellow" , "yellow" , 1
 #m "getbmp uranus 0 0 60 120"
 call sprite.cls
 call sprite.rond 30 , 30 , 7 _
 , "lightgray" , "lightgray" , 1
 #m "getbmp pluto 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 , "solarsystem sim ." _
 , "green" , "black"
 call add.atom 0 , 0 , 0 , "sun"
 call add.atom 0 , 0 , 0 , "mercure"
 call add.atom 0 , 0 , 0 , "venus"
 call add.atom 0 , 0 , 0 , "earth"
 call add.atom 0 , 0 , 0 , "moon"
 call add.atom 0 , 0 , 0 , "mars"
 call add.atom 0 , 0 , 0 , "jupiter"
 call add.atom 0 , 0 , 0 , "saturn"
 call add.atom 0 , 0 , 0 , "neptune"
 call add.atom 0 , 0 , 0 , "uranus"
 call add.atom 0 , 0 , 0 , "pluto"

 #m "getbmp screen 0 0 " ; winx ; " " ; winy
 #m "background screen"
 #m "when characterInput [key]"
 #m "setfocus"
 timer 40 , [timer]
wait
[timer]
 if key$ = chr$( _VK_UP ) _
 and factor < 1 then
   factor = factor * 1.2
 end if
 if key$ = chr$( _VK_DOWN ) _
 and factor > 1/5 then
   factor = factor / 1.2
 end if
 key$ = ""
 ''the sun don't move
 ''mercure
 s.x( 1 ) = sin( rad2( day , 88 ) ) _
 * 69.7 * factor
 s.z( 1 ) = cos( rad2( day , 88 ) ) _
 * 69.7 * factor
 ''venus
 s.x( 2 ) = sin( rad2( day , 224.7 ) ) _
 * 109 * factor
 s.z( 2 ) = cos( rad2( day , 224.7 ) ) _
 * 109 * factor
 ''earth
 s.x( 3 ) = sin( rad2( day , year ) ) _
 * 152.1 * factor
 s.z( 3 ) = cos( rad2( day , year ) ) _
 * 152.1 * factor
 ''moon
 s.x( 4 ) = s.x( 3 ) _
 + sin( rad2( day , 27.32 ) ) _
 * 10 * factor
 s.z( 4 ) = s.z( 3 ) _
 + cos( rad2( day , 27.32 ) ) _
 * 10 * factor
 ''mars
 s.x( 5 ) = sin( rad2( day , 687 ) ) _
 * 249.1 * factor
 s.z( 5 ) = cos( rad2( day , 687 ) ) _
 * 249.1 * factor
 ''jupiter
 s.x( 6 ) = sin( rad2( day , 11.96 * year ) ) _
 * 815.7 * factor
 s.z( 6 ) = cos( rad2( day , 11.96 * year ) ) _
 * 815.7 * factor
 ''saturn
 s.x( 7 ) = sin( rad2( day , 29.46 * year ) ) _
 * 1507 * factor
 s.z( 7 ) = cos( rad2( day , 29.46 * year ) ) _
 * 1507 * factor
 ''neptune
 s.x( 8 ) = sin( rad2( day , 84.01 * year ) ) _
 * 3004 * factor
 s.z( 8 ) = cos( rad2( day , 84.01 * year ) ) _
 * 3004 * factor
 ''uranus
 s.x( 9 ) = sin( rad2( day , 164.1 * year ) ) _
 * 4337 * factor
 s.z( 9 ) = cos( rad2( day , 164.1 * year ) ) _
 * 4337 * factor
   ''pluto
 s.x( 10 ) = sin( rad2( day , 247.7 * year ) ) _
 * 7375 * factor
 s.z( 10 ) = cos( rad2( day , 247.7 * year ) ) _
 * 7375 * factor
   day = day + 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
 ''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 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$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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 )
 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



[tsh73]

Robot speed-up
(comment nomainwin to see ms per page count)
on my machine it is about 3x faster.

Basically speed-up is due to
sub multiply a , b , c
- I inlined 
function in( no , x , y )

Also I got rid of calling
function rad( deg )
and changed
sub copy a , b
to
sub copy0 b

but I don't think it makes things much different.

''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
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"

   ''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$
 #m "addsprite spr" ; s.tel ; " " ; i$
 #m "centersprite spr" ; s.tel
 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

EDIT
and I changed sprites to 3d balls

[Rod]

Anatoly's code animates well on my machine. But looking at the main loop I am not understanding why we continually add sprites. I don't see them being deleted? Should they not just be repositioned? Add once position/zorder many?