Gravity

dim zone( 100 , 9 )
WindowWidth = 700 ''DisplayWidth
WindowHeight = 500 ''DisplayHeight
global black , red , green , yellow
global blue , magenta , cyan , white
global orange , gray , purple , pink
global visible , enable
visible = 1
enable = 2
black = rgb( 0 , 0 , 0 )
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
white = rgb( 255 , 255 , 255 )
pink = rgb( 255 , 127 , 127 )
orange = rgb( 255 , 127 , 0 )
gray = rgb( 127 , 127 , 127 )
purple = rgb( 127 , 0 , 127 )
''==============================================
''game declarations here
global blacknr , rednr , bluenr , greennr , yellownr
global bluespeedx , bluuespeedy
blacknr = 0 : rednr = 1 : bluenr = 2 : greennr = 3
bluespeedx = 2 : bluespeedy = 0 : yellownr = 4
call zoneblock blacknr ,-350, 0,0, 10,200,50,black
call zoneblock rednr , 350, 0,0, 10,200,50,red
call zonesphere bluenr , 0, 0,0, 30,blue
call zoneblock greennr , 0,-200,0,350,10,50,green
call zoneblock yellownr, 0, 200,0,350,10,50,yellow
nomainwin
timer 40 , [tmr]
open "Colision detection" for graphics as #m
#m "trapclose [quit]"
wait
end
[tmr]
''read human input here
''update game here
if zonehit( bluenr , blacknr ) then
bluespeedx = 2 + rnd( 0 )
end if
if zonehit( bluenr , greennr ) then
bluespeedy = 10 + rnd( 0 )
end if
if zonehit( bluenr , rednr ) then
bluespeedx = 0 - 2 - rnd( 0 )
end if
if zonehit( bluenr , yellownr ) then
bluespeedy = 0 - rnd( 0 )
end if
bluespeedy = bluespeedy - 0.2
zone( bluenr , 0 ) = zone( bluenr , 0 ) + bluespeedx
zone( bluenr , 1 ) = zone( bluenr , 1 ) + bluespeedy
#m "cls"
''draw game here
call zonedraw blacknr
call zonedraw rednr
call zonedraw greennr
call zonedraw yellownr
call zonedraw bluenr
#m "flush"
wait
end
''==============================================
sub zoneblock no , x , y , z , dx , dy , dz , clr
zone( no , 0 ) = x
zone( no , 1 ) = y
zone( no , 2 ) = z
zone( no , 3 ) = dx
zone( no , 4 ) = dy
zone( no , 5 ) = dz
zone( no , 6 ) = -1
zone( no , 7 ) = clr
zone( no , 8 ) = visible + enable
end sub
sub zonesphere no , x , y , z , r , clr
zone( no , 0 ) = x
zone( no , 1 ) = y
zone( no , 2 ) = z
zone( no , 3 ) = 0
zone( no , 4 ) = 0
zone( no , 5 ) = 0
zone( no , 6 ) = abs( r )
zone( no , 7 ) = clr
zone( no , 8 ) = visible + enable
end sub
sub zonedraw no
if not( zone( no , 8 ) and visible ) then
exit sub
end if
mx = WindowWidth / 2
my = WindowHeight / 2
clr = zone( no , 7 )
r = int( clr and 255 )
g = int( clr / 256 ) and 255
b = int( clr / 256 / 256 ) and 255
#m "color " ; r ; " " ; g ; " " ; b
#m "backcolor " ; r ; " " ; g ; " " ; b
x = 0 : y = 1 : z = 2
dx = 3 : dy = 4 : dz = 5 : r = 6
if zone( no , r ) < 0 then
#m "up"
#m "goto " _
; mx + zone( no , x ) + zone( no , dx ) ; " " _
; my - zone( no , y ) + zone( no , dy )
#m "down"
#m "boxfilled " _
; mx + zone( no , x ) - zone( no , dx ) ; " " _
; my - zone( no , y ) - zone( no , dy )
#m "up"
else
#m "goto " ; mx + zone( no , x ) _
; " " ; my - zone( no , y )
#m "down"
#m "circlefilled " ; zone( no , r )
#m "up"
end if
end sub
function zonehit( no1 , no2 )
if not( zone( no1 , 8 ) and enable ) _
or not( zone( no2 , 8 ) and enable ) then
zonehit = 0
end if
''zone 1 and zone 2 = block
if zone( no1 , 6 ) < 0 _
and zone( no2 , 6 ) < 0 then
dx = abs( zone( no1 , 0 ) - zone( no2 , 0 ) )
dy = abs( zone( no1 , 1 ) - zone( no2 , 1 ) )
dz = abs( zone( no1 , 2 ) - zone( no2 , 2 ) )
ax = zone( no1 , 3 ) + zone( no2 , 3 )
ay = zone( no1 , 4 ) + zone( no2 , 4 )
az = zone( no1 , 5 ) + zone( no2 , 5 )
zonehit = dx < ax and dy < ay and dz < ay
end if
''zone 1 and zone 2 = sphere
if zone( no1 , 6 ) > 0 _
and zone( no2 , 6 ) > 0 then
x1 = zone( no1 , 0 )
y1 = zone( no1 , 1 )
z1 = zone( no1 , 2 )
d1 = zone( no1 , 6 )
x2 = zone( no2 , 0 )
y2 = zone( no2 , 1 )
z2 = zone( no2 , 2 )
d2 = zone( no2 , 6 )
dis = sqr( ( x1 - x2 ) ^ 2 _
+ ( y1 - y2 ) ^ 2 _
+ ( z1 - z2 ) ^ 2 )
zonehit = dis < ( d1 + d2 )
end if
''zone 1 = sphere zone 2 = block
if zone( no1 , 6 ) > 0 _
and zone( no2 , 6 ) < 0 then
h = no1
no1 = no2
no2 = h
end if
''zone 1 = block zone 2 = sphere
diss = 0
x = 0 : y = 1 : z = 2 : dx = 3 : dy = 4 : dz = 5 : r = 6
if zone( no2 , x ) _
< ( zone( no1 , x ) - zone( no1 , dx ) ) then
diss = diss + ( zone( no2 , x ) _
- ( zone( no1 , x ) - zone( no1 , dx ) ) ) ^ 2
else
if zone( no2 , x ) _

• ( zone( no1 , x ) + zone( no1 , dx ) ) then

diss = diss + ( zone( no2 , x ) _
- ( zone( no1 , x ) + zone( no1 , dx ) ) ) ^ 2
end if
end if
if zone( no2 , y ) _
< ( zone( no1 , y ) - zone( no1 , dy ) ) then
diss = diss + ( zone( no2 , y ) _
- ( zone( no1 , y ) - zone( no1 , dy ) ) ) ^ 2
else
if zone( no2 , y ) _

• ( zone( no1 , y ) + zone( no1 , dy ) ) then

diss = diss + ( zone( no2 , y ) _
- ( zone( no1 , y ) + zone( no1 , dy ) ) ) ^ 2
end if
end if
if zone( no2 , z ) _
< ( zone( no1 , z ) - zone( no1 , dz ) ) then
diss = diss + ( zone( no2 , z ) _
- ( zone( no1 , z ) - zone( no1 , dz ) ) ) ^ 2
else
if zone( no2 , z ) _

• ( zone( no1 , z ) + zone( no1 , dz ) ) then

diss = diss + ( zone( no2 , z ) _
- ( zone( no1 , z ) + zone( no1 , dz ) ) ) ^ 2
end if
end if
zonehit = diss < zone( no2 , 6 ) ^ 2
end function
function rgb( r , g , b )
rgb = ( r and 255 ) _
+ ( g and 255 ) * 256 _
+ ( b and 255 ) * 256 * 256
end function
[quit]
close #m
end