Sorry your browser is not supported!

Sync On
Sync Rate 60
Randomize Timer()
Autocam Off

Type Coordinates
   x as Float
   y as Float
   z as Float
Endtype
Global Object as Coordinates
Global Target as Coordinates
Global Total as Coordinates
Global Count as Float

Dim m(1000) as Float
R# = 3        :` resting length
K# = .5  :` spring coefficient
v# = 0.0       :` velocity
f# = 0.9       :` friction

Dim dots(1000) as Coordinates
Dim vels(1000) as Coordinates

For i = 1 to 1000
   Make Object Sphere i,.5,8,8
   Position Object i,0,0,0
   Turn Object Right i,rnd(360)
   Pitch Object Down i,rnd(360)
   Roll Object Left i,rnd(360)
   Move Object i,rnd(R#)+.1
   m(i)=rnd(500.0)/5.0+1.0
   Return_Object(i)
   dots(i).x=Object.x:dots(i).y=Object.y:dots(i).z=Object.z
Next i
Make Object Sphere 1001,.5,8,8
Position Object 1001,0,0,50


Count=249
Do
   Fix Object Pivot 1001
   Move Object Right 1001,MouseMoveX()/4
   Move Object Down 1001,MouseMoveY()/4
   Return_Object(1001)
   cx#=Object.x:cy#=Object.y:cz#=Object.z
   Total.x=0:Total.y=0:Total.z=0
   For i =1 to 1000
      Return_Target(i)
      Total.x=Target.x+Total.x
      Total.y=Target.y+Total.y
      Total.z=Target.z+Total.z
   Next i
   cx#=(cx#*500.0+Total.x)/1500.0:cy#=(cy#*500.0+Total.y)/1500.0:cz#=(cz#*500.0+Total.z)/1500.0
   For i = 1 to 1000
      Return_Target(i)
      dx#=Target.x-(cx#+dots(i).x)
      vels(i).x=Spring(vels(i).x,K#,dx#,m(i),f#)
      dy#=Target.y-(cy#+dots(i).y)
      vels(i).y=Spring(vels(i).y,K#,dy#,m(i),f#)
      dz#=Target.z-(cz#+dots(i).z)
      vels(i).z=Spring(vels(i).z,K#,dz#,m(i),f#)
      Position Object i,Target.x+vels(i).x,Target.y+vels(i).y,Target.z+vels(i).z
      Return_Target(i)
   Next i
   Set Cursor 0,0
   Print Screen FPS()
   Sync
Loop




Function Spring(vel#,spring#,dist#,resist#,frict#)
vel#=(vel# + (-spring# * dist#)/resist#)*frict#
EndFunction vel#


Function Return_Object(ObjectID)
Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
EndFunction

Function Return_Target(TargetID)
Target.x=Object Position X(TargetID):Target.y=Object Position Y(TargetID):Target.z=Object Position Z(TargetID)
EndFunction

`*** Cloth Physics by Ric ***

sync on
sync rate 40
autocam off
position camera 0,0,-150
hide mouse
color backdrop rgb(0,0,255)

`red texture
ink rgb(255,0,0),0
box 0,0,1,1
get image 1,0,0,1,1
`white texture
ink rgb(255,255,255),0
box 0,0,1,1
get image 2,0,0,1,1
`make flag
make object box 1,100,15,1
texture object 1,1
make object box 2,15,100,1
texture object 2,1
make object box 3,100,25,1
position object 3,0,0,.1
texture object 3,2
make object box 4,25,100,1
position object 4,0,0,.1
texture object 4,2
make object box 5,150,15,1
zrotate object 5,-45
position object 5,0,0,1
texture object 5,2
make object box 6,150,15,1
zrotate object 6,45
position object 6,0,0,1
texture object 6,2
make object box 7,150,5,1
zrotate object 7,45
position object 7,0,0,.5
texture object 7,1
make object box 8,150,5,1
zrotate object 8,-45
position object 8,0,0,.5
texture object 8,1
for ob=1 to 8
set object light ob,0
next ob
sync
`grab flag image
get image 3,screen width()/2-130,screen height()/2-130,screen width()/2+130,screen height()/2+130
`tidy up
for ob=1 to 8
delete object ob
next ob

`set initial physics variables
omega#=8
amp#=2.0
rows=50
columns=50
elasticity#=0.2
a=5
b=5
damping#=0.7

`set camera and lighting
position camera 70,55,0
point camera rows/2,0,columns/2
hide light 0
set ambient light 0
make light 1
position light 1,10,10,10
color backdrop 0


num=rows*columns
dim obnum(rows+1,columns+1)
dim v#(rows,columns) `set velocity array

`make matrix
make matrix 1,rows,columns,rows,columns

`give every matrix tile an x,z coordinate
for x=1 to rows
for z=1 to columns
obnum(x,z)=ob
ob=ob+1
next z
next x

`texture matrix
prepare matrix texture 1,3,rows,columns
tile=1
for x=rows-1 to 0 step -1
for z=0 to columns-1
set matrix tile 1,z,x,tile
inc tile
next z
next x

do

`oscillate wave generator point
y#=amp#*sin(theta#)
theta#=theta#+omega#
set matrix height 1,rows-a,b,y#

`apply spring physics to neighbouring matrix tiles
for x=0 to rows
for z=5 to columns
if x<rows
distxp1#=get matrix height(1,x+1,z)-get matrix height (1,x,z)
endif
if x>1
distxm1#=get matrix height(1,x-1,z)-get matrix height (1,x,z)
endif
if z<columns
distzp1#=get matrix height(1,x,z+1)-get matrix height (1,x,z)
endif
if z>1
distzm1#=get matrix height(1,x,z-1)-get matrix height (1,x,z)
endif
vectorsum#=distxp1#+distxm1#+distzp1#+distzm1#
a#=vectorsum#*elasticity#
v#(obnum(x,z))=v#(obnum(x,z))+a#
v#(obnum(x,z))=v#(obnum(x,z))*damping#

set matrix height 1,x,z,get matrix height(1,x,z)+v#(obnum(x,z))
`limit maximum amplitude
if get matrix height(1,x,z)>amp#*2 then set matrix height 1,x,z,amp#*2
if get matrix height(1,x,z)<-amp#*2 then set matrix height 1,x,z,-amp#*2
next z
next x
update matrix 1

`apply self regulating damping
if get matrix height (1,rows/4,columns/4)>amp#/2 or get matrix height (1,rows/4,columns/4)<-amp#/2
 if damping#>0.6 then dec damping#,0.0008
else
 if damping#<0.72 then inc damping#,0.0005
endif
text 0,40,"damping: "+str$(damping#)

sync
loop

Sync On
Sync Rate 60
Randomize Timer()
Autocam Off

Type Coordinates
   x as Float
   y as Float
   z as Float
Endtype
Global Object as Coordinates
Global Target as Coordinates
Global Total as Coordinates
Global Count as Float

set camera to image 0,1,512,512
  set camera aspect 800/600
  color backdrop RGB(150,150,220)
  sprite 1,0,0,1
  set sprite 1,0,1
  set sprite alpha 1,100
  size sprite 1,800,600

Create Bitmap 1,100,100
Set Current Bitmap 1
Box 0,0,99,99,RGB(255,128,0),RGB(164,169,213),RGB(233,235,169),RGB(89,91,0)
Get Image 2,0,0,99,99
Set Current Bitmap 0
Delete Bitmap 1

w=Screen Width():h=Screen Height()
Create Bitmap 1,w,h
Set Current Bitmap 1
Box 0,0,w/2,h-1,RGB(0,0,15),RGB(150,150,255),RGB(0,0,64),RGB(200,200,255)
Box w/2,0,w-1,h-1,RGB(0,0,64),RGB(200,200,255),RGB(0,0,15),RGB(150,150,255)
Get Image 3,0,0,w-1,h-1
Sprite 2,1,1,3
Set sprite alpha 2,100
`Set Sprite Priority 2,0
Set Current Bitmap 0

Dim m(1000) as Float
R# = 50        :` resting length
K# = 2         :` spring coefficient
v# = 0.0       :` velocity
f# = 0.9       :` friction

Dim dots(1000) as Coordinates
Dim vels(1000) as Coordinates

Global Fish as Float
Fish = 500


For i = 1 to Fish
   Fish(i)
   `Texture Object i,1
   Set Sphere Mapping On i,2
   Position Object i,rnd(20)-10,Rnd(20)-10,Rnd(20)-10
   Turn Object Right i,rnd(360)
   Pitch Object Down i,rnd(360)
   Roll Object Left i,rnd(360)
   Move Object i,rnd(R#)+.1
   m(i)=rnd(500.0)/10.0+100.0
   Return_Object(i)
   dots(i).x=Object.x:dots(i).y=Object.y:dots(i).z=Object.z
Next i
Make Object Sphere 1001,.5,8,8
Hide Object 1001
Position Object 1001,0,0,100
   Turn Object Right 1001,rnd(360)
   Pitch Object Down 1001,rnd(360)
   Roll Object Left 1001,rnd(360)

Count=249
Do
   Fix Object Pivot 1001
   Return_Object(1001)
   If rnd(300)=1 Then movex#=rnd(50.0)/10.0-3.0
   If rnd(300)=1 Then movey#=rnd(50.0)/10.0-3.0
   If rnd(300)=1 Then movez#=rnd(50.0)/10.0-3.0
   Position Object 1001,Object.x+movex#,Object.y+movey#,Object.z+movez#
   Return_Object(1001)
   If Object.x>80 or Object.x<-80
      Position Object 1001,Object.x-movex#,Object.y+movey#,Object.z+movez#
      movex#=-movex#
   Endif
   If Object.y>80 or Object.y<-80
      Position Object 1001,Object.x+movex#,Object.y-movey#,Object.z+movez#
      movey#=-movey#
   Endif
   If Object.z>250 or Object.z<50
      Position Object 1001,Object.x+movex#,Object.y+movey#,Object.z-movez#
      movez#=-movez#
   Endif
   cx#=Object.x:cy#=Object.y:cz#=Object.z
   Total.x=0:Total.y=0:Total.z=0
   For i =1 to Fish
      Return_Target(i)
      Total.x=Target.x+Total.x
      Total.y=Target.y+Total.y
      Total.z=Target.z+Total.z
   Next i
   cx#=(cx#*(Fish*.1)+Total.x)/(Fish*1.1):cy#=(cy#*(Fish*.1)+Total.y)/(Fish*1.1):cz#=(cz#*(Fish*.1)+Total.z)/(Fish*1.1)
   For i = 1 to Fish
      Return_Target(i)
      dx#=Target.x-(cx#+dots(i).x)
      dy#=Target.y-(cy#+dots(i).y)
      dz#=Target.z-(cz#+dots(i).z)
      d#=sqrt(dx#*dx#+dy#*dy#+dz#*dz#)
      vels(i).x=Spring(vels(i).x,K#,abs(dx#*d#)/dx#,m(i),f#)
      vels(i).y=Spring(vels(i).y,K#,abs(dy#*d#)/dy#,m(i),f#)
      vels(i).z=Spring(vels(i).z,K#,abs(dz#*d#)/dz#,m(i),f#)
      Position Object i,Target.x+vels(i).x,Target.y+vels(i).y,Target.z+vels(i).z
      Point Object i,(Object.x-cx#)*100+cx#,(Object.y-cy#)*100+cy#,(Object.z-cz#)*100+cy#
      Return_Target(i)
   Next i
   Set Cursor 0,0
   Print Screen FPS()
   Sync
Loop




Function Spring(vel#,spring#,dist#,resist#,frict#)
vel#=(vel# + (-spring# * dist#)/resist#)*frict#
EndFunction vel#


Function Return_Object(ObjectID)
Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
EndFunction

Function Return_Target(TargetID)
Target.x=Object Position X(TargetID):Target.y=Object Position Y(TargetID):Target.z=Object Position Z(TargetID)
EndFunction

Function Fish(ObjectID)
Make Object Sphere ObjectID,3,8,8
Make Mesh From Object ObjectID,ObjectID
Delete Object ObjectID
Make Object Triangle ObjectID,0,1,-1,0,-1,-1,0,0,1
Offset Limb ObjectID,0,0,0,-.8
Add Limb ObjectID,1,ObjectID
Offset Limb ObjectID,1,0,0,1
Scale Limb ObjectID,1,20,80,100
EndFunction

sync on
sync rate 0
hide mouse
set display mode 800,600,32

#CONSTANT TRUE = 1
#CONSTANT FALSE = 0

type vector
   x as float
   y as float
   z as float
endtype

type particle
   mass as float
   invMass as float
   position as vector
   velocity as vector
   acceleration as vector
   forces as vector
   locked as boolean
endtype

type particleRef
   r as integer
   c as integer
endtype

type spring
   p1 as particleRef
   p2 as particleRef
   k as float
   d as float
   L as float
endtype

type collision
   p1 as particleRef
   n as vector
endtype

Global NUMROWS = 8
Global NUMCOLS = 16
Global NUMSTRUCTURALSPRINGS
       NUMSTRUCTURALSPRINGS = NUMCOLS*(NUMROWS+1) + NUMROWS*(NUMCOLS+1) + NUMCOLS*NUMROWS*2

NUMFACES = NUMROWS*NUMCOLS*2
Global CLOTHWIDTH = 100
Global CLOTHHEIGHT = 50


#CONSTANT CSTEP = CLOTHWIDTH / NUMCOLS
#CONSTANT RSTEP = CLOTHHEIGHT / NUMROWS
#CONSTANT NUMVERTICES = (NUMROWS+1) * (NUMCOLS+1)


dim particles(NUMROWS+1, NUMCOLS+1) as particle
dim structuralSprings(NUMSTRUCTURALSPRINGS) as spring
dim collisions(NUMVERTICES) as collision

Global windVector as vector
windVector.x = 10
windVector.y = 0
windVector.z = 1



Global GRAVITY# = -100.0
Global SPRINGTENSION# = 500.0
Global SPRINGSHEAR# = 300.0
Global SPRINGDAMPING# = 3.0
Global YOFFSET# = 0
Global DRAGCOEFFICIENT# = 0.01
Global WINDFACTOR# = 30.0
Global FLAGPOLEHEIGHT# = 200.0
Global FLAGPOLERADIUS# = 10.0
Global COLLISIONTOLERANCE# = 0.05
Global KRESTITUTION# = 0.25
Global FRICTIONFACTOR# = 0.5
GLOBAL CLOTHMASS# = 20.0
Global MASSPERFACE#
       MASSPERFACE# = CLOTHMASS# / NUMFACES


initialize()

null = make vector3(11)

buildFlag(1, NUMCOLS, NUMROWS, CLOTHWIDTH, CLOTHHEIGHT)
load image "pyramid2.bmp", 1
texture object 1, 1


make matrix 1, 1000,1000,40,40

`set object wireframe 1, 1
position object 1, 0,150,0

make object cylinder 2, 100
scale object 2, FLAGPOLERADIUS#/2, FLAGPOLEHEIGHT#, FLAGPOLERADIUS#/2
position object 2, -(FLAGPOLERADIUS#/4),FLAGPOLEHEIGHT#/2, 0


position camera 200,0,-500

particles(3,3).locked = TRUE
particles(3,4).locked = TRUE

REPEAT

   camera()


   if inkey$() = "a"
      inc WINDFACTOR#, 1
   endif
   if inkey$() = "z"
      dec WINDFACTOR#, 1
   endif

   if spacekey()
      unlockAll()
   endif

   stepSimulation(0.006)


   set cursor 0,0
   showInfo()
   print
   print "wind: ",WINDFACTOR#
   print "fps: ",screen fps()

fastsync
UNTIL escapekey()

END



function showInfo()
   print "Flag/Cloth simulation"
   print "By: Phaelax"
   print "Reference: Ch.17 of "Physics for Game Developers""
endfunction


function camera()

   speed# = 5
   cx# = camera position x()
   cz# = camera position z()
   a# = camera angle y()
   cxa# = camera angle x()

   if shiftkey() then speed# = 10
   if upkey()=1
      cx#=newxvalue(cx#,a#,speed#)
      cz#=newzvalue(cz#,a#,speed#)
   endif
   if downkey()=1
      cx#=newxvalue(cx#,a#,-speed#)
      cz#=newzvalue(cz#,a#,-speed#)
   endif
   if leftkey()=1
      cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
      cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
   endif
   if rightkey()=1
      cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
      cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
   endif

   a#=wrapvalue(a#+(mousemovex()/3.0))
   cxa#=cxa#+(mousemovey()/3.0)
   if cxa#<-90.0 then cxa#=-90.0
   if cxa#>90.0 then cxa#=90.0
   position camera cx#,100,cz#
   rotate camera cxa#,a#,0
endfunction






function buildFlag(obj as integer, xsegs as float, zsegs as float, width as float, height as float)
   mesh = 1
   mem = 1
   header = 12
   size = 36
   vertCount = xsegs*zsegs*6
   totalSize = vertCount*size + header
   tx# = width/xsegs
   tz# = height/zsegs

   make memblock mem, totalSize
   write memblock dword mem, 0, 338
   write memblock dword mem, 4, size
   write memblock dword mem, 8, vertCount

   tile = 0
   for z = 1 to zsegs
      for x = 1 to xsegs
         location = tile*size*6 + header

         U1# = (x-1)/xsegs
         V1# = (z-1)/zsegs
         U2# = x/xsegs
         V2# = z/zsegs

         x1# = particles(z,x-1).position.x
         y1# = particles(z,x-1).position.y
         z1# = particles(z,x-1).position.z

         x2# = particles(z-1,x-1).position.x
         y2# = particles(z-1,x-1).position.y
         z2# = particles(z-1,x-1).position.z

         x3# = particles(z-1,x).position.x
         y3# = particles(z-1,x).position.y
         z3# = particles(z-1,x).position.z

         x4# = x1#
         y4# = y1#
         z4# = z1#

         x5# = x3#
         y5# = y3#
         z5# = z3#

         x6# = particles(z,x).position.x
         y6# = particles(z,x).position.y
         z6# = particles(z,x).position.z

         rem vert 1 - x,y,z, normals x,y,z, diffuse color
         write memblock float mem, location, x1#
         write memblock float mem, location+4, y1#
         write memblock float mem, location+8, z1#
         write memblock float mem, location+28, U1#
         write memblock float mem, location+32, V2#


         rem vert 2 - x,y,z
         temp_size = size
         write memblock float mem, location+temp_size, x2#
         write memblock float mem, location+temp_size+4, y2#
         write memblock float mem, location+temp_size+8, z2#
         write memblock float mem, location+temp_size+28, U1#
         write memblock float mem, location+temp_size+32, V1#

         rem vert 3 - x,y,z
         temp_size = size*2
         write memblock float mem, location+temp_size, x3#
         write memblock float mem, location+temp_size+4, y3#
         write memblock float mem, location+temp_size+8, z3#
         write memblock float mem, location+temp_size+28, U2#
         write memblock float mem, location+temp_size+32, V1#

         rem vert 4 - x,y,z
         temp_size = size*3
         write memblock float mem, location+temp_size, x4#
         write memblock float mem, location+temp_size+4, y4#
         write memblock float mem, location+temp_size+8, z4#
         write memblock float mem, location+temp_size+28, U1#
         write memblock float mem, location+temp_size+32, V2#

         rem vert 5 - x,y,z
         temp_size = size*4
         write memblock float mem, location+temp_size, x5#
         write memblock float mem, location+temp_size+4, y5#
         write memblock float mem, location+temp_size+8, z5#
         write memblock float mem, location+temp_size+28, U2#
         write memblock float mem, location+temp_size+32, V1#

         rem vert 6 - x,y,z
         temp_size = size*5
         write memblock float mem, location+temp_size, x6#
         write memblock float mem, location+temp_size+4, y6#
         write memblock float mem, location+temp_size+8, z6#
         write memblock float mem, location+temp_size+28, U2#
         write memblock float mem, location+temp_size+32, V2#

         inc tile, 1

      next x
   next z

   make mesh from memblock  mesh, mem
   make object obj,mesh,0
   set object cull obj, 0
   set object ambient obj, 0

endfunction






function calcForces()
   null = make vector3(1)
   null = make vector3(2)
   null = make vector3(3)
   null = make vector3(4)


   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         particles(r,c).forces.x = 0
         particles(r,c).forces.y = 0
         particles(r,c).forces.z = 0
      next c
   next r

   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         if particles(r,c).locked = FALSE
            rem gravity
            particles(r,c).forces.y = particles(r,c).forces.y + (GRAVITY#*particles(r,c).mass)

            rem viscous drag
            set vector3 1, -particles(r,c).velocity.x, -particles(r,c).velocity.y, -particles(r,c).velocity.z
            normalize vector3 1,1
            multiply vector3 1, length vector3(1)^2 * DRAGCOEFFICIENT#
            set vector3 2, particles(r,c).forces.x, particles(r,c).forces.y, particles(r,c).forces.z
            add vector3 1, 1, 2
            particles(r,c).forces.x = x vector3(1)
            particles(r,c).forces.y = y vector3(1)
            particles(r,c).forces.z = z vector3(1)

            rem wind
            set vector3 1, rnd(7)+5,0,rnd(3)-1
            normalize vector3 1, 1
            set vector3 2, particles(r,c).forces.x, particles(r,c).forces.y, particles(r,c).forces.z
            multiply vector3 1, rnd(WINDFACTOR#)
            add vector3 1, 2, 1
            particles(r,c).forces.x = x vector3(1)
            particles(r,c).forces.y = y vector3(1)
            particles(r,c).forces.z = z vector3(1)
         endif
      next c
   next r

   rem process spring forces
   for i = 0 to NUMSTRUCTURALSPRINGS-1
      r1 = structuralSprings(i).p1.r
      c1 = structuralSprings(i).p1.c
      r2 = structuralSprings(i).p2.r
      c2 = structuralSprings(i).p2.c

      set vector3 1, particles(r1,c1).position.x, particles(r1,c1).position.y, particles(r1,c1).position.z
      set vector3 2, particles(r2,c2).position.x, particles(r2,c2).position.y, particles(r2,c2).position.z
      rem d
      subtract vector3 3, 1, 2
      set vector3 1, particles(r1,c1).velocity.x, particles(r1,c1).velocity.y, particles(r1,c1).velocity.z
      set vector3 2, particles(r2,c2).velocity.x, particles(r2,c2).velocity.y, particles(r2,c2).velocity.z
      rem v
      subtract vector3 4, 1, 2

      copy vector3 1, 3
      copy vector3 2, 3

      L# = structuralSprings(i).L

      f1# = -(structuralSprings(i).k * (length vector3(3)-L#) + structuralSprings(i).d * (dot product vector3(4,3) / length vector3(3)))
      divide vector3 3, length vector3(3)
      multiply vector3 3, f1#
      set vector3 4, x vector3(3), y vector3(3), z vector3(3)
      multiply vector3 4, -1

      if particles(r1,c1).locked = FALSE
         particles(r1,c1).forces.x = particles(r1,c1).forces.x + x vector3(3)
         particles(r1,c1).forces.y = particles(r1,c1).forces.y + y vector3(3)
         particles(r1,c1).forces.z = particles(r1,c1).forces.z + z vector3(3)
      endif

      if particles(r2,c2).locked = FALSE
         particles(r2,c2).forces.x = particles(r2,c2).forces.x + x vector3(4)
         particles(r2,c2).forces.y = particles(r2,c2).forces.y + y vector3(4)
         particles(r2,c2).forces.z = particles(r2,c2).forces.z + z vector3(4)
      endif
   next i

   null = delete vector3(1)
   null = delete vector3(2)
   null = delete vector3(3)
   null = delete vector3(4)

endfunction


rem remove the inner IF statement to unlock ALL anchored points
function unlockAll()
   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         if r = 0 and c = 0
         else
            particles(r,c).locked = FALSE
         endif
      next c
   next r
endfunction


function initialize()

   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         rem calculate mass of this particle
         if (r = 0) and (c = 0)
            f = 1
         else
            if (r = NUMROWS) and (c = 0)
               f = 2
            else
               if (r = 0) and (c = NUMCOLS)
                  f = 2
               else
                  if (r = NUMROWS) and (c = NUMCOLS)
                     f = 1
                  else
                     if ((r = 0) or (r = NUMROWS)) and ((c <> 0) and (c <> NUMCOLS))
                        f = 3
                     else
                        f = 6
                     endif
                  endif
               endif
            endif
         endif

         particles(r,c).mass = (f * MASSPERFACE#) / 3
         particles(r,c).invMass = 1 / particles(r,c).mass

         rem set initial position of this particle
         particles(r,c).position.x = c * CSTEP
         particles(r,c).position.y = (CLOTHHEIGHT - (r * RSTEP)) + YOFFSET
         particles(r,c).position.z = 0

         rem set initial velocity and forces to zero
         particles(r,c).velocity.x = 0
         particles(r,c).velocity.y = 0
         particles(r,c).velocity.z = 0

         particles(r,c).acceleration.x = 0
         particles(r,c).acceleration.y = 0
         particles(r,c).acceleration.z = 0

         particles(r,c).forces.x = 0
         particles(r,c).forces.y = 0
         particles(r,c).forces.z = 0

         if (c = 0) and (r = 0 or r = NUMROWS)
            particles(r,c).locked = TRUE
         else
            particles(r,c).locked = FALSE
         endif
      next c
   next r


   null = make vector3(1)
   null = make vector3(2)
   count = 0

   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         rem setup the structural springs
         if (c < NUMCOLS)
            structuralSprings(count).p1.r = r
            structuralSprings(count).p1.c = c
            structuralSprings(count).p2.r = r
            structuralSprings(count).p2.c = c+1
            structuralSprings(count).k = SPRINGTENSION#
            structuralSprings(count).d = SPRINGDAMPING#
            set vector3 1, particles(r,c).position.x, particles(r,c).position.y, particles(r,c).position.z
            set vector3 2, particles(r,c+1).position.x, particles(r,c+1).position.y, particles(r,c+1).position.z
            subtract vector3 1,1,2
            structuralSprings(count).L = length vector3(1)
            inc count, 1
         endif
         if (r < NUMROWS)
            structuralSprings(count).p1.r = r
            structuralSprings(count).p1.c = c
            structuralSprings(count).p2.r = r+1
            structuralSprings(count).p2.c = c
            structuralSprings(count).k = SPRINGTENSION#
            structuralSprings(count).d = SPRINGDAMPING#
            set vector3 1, particles(r,c).position.x, particles(r,c).position.y, particles(r,c).position.z
            set vector3 2, particles(r+1,c).position.x, particles(r+1,c).position.y, particles(r+1,c).position.z
            subtract vector3 1,1,2
            structuralSprings(count).L = length vector3(1)
            inc count, 1
         endif
         if (r < NUMROWS) and (c < NUMCOLS)
            structuralSprings(count).p1.r = r
            structuralSprings(count).p1.c = c
            structuralSprings(count).p2.r = r+1
            structuralSprings(count).p2.c = c+1
            structuralSprings(count).k = SPRINGTENSION#
            structuralSprings(count).d = SPRINGDAMPING#
            set vector3 1, particles(r,c).position.x, particles(r,c).position.y, particles(r,c).position.z
            set vector3 2, particles(r+1,c+1).position.x, particles(r+1,c+1).position.y, particles(r+1,c+1).position.z
            subtract vector3 1,1,2
            structuralSprings(count).L = length vector3(1)
            inc count, 1
         endif
         if (c > 0) and (r < NUMROWS)
            structuralSprings(count).p1.r = r
            structuralSprings(count).p1.c = c
            structuralSprings(count).p2.r = r+1
            structuralSprings(count).p2.c = c-1
            structuralSprings(count).k = SPRINGTENSION#
            structuralSprings(count).d = SPRINGDAMPING#
            set vector3 1, particles(r,c).position.x, particles(r,c).position.y, particles(r,c).position.z
            set vector3 2, particles(r+1,c-1).position.x, particles(r+1,c-1).position.y, particles(r+1,c-1).position.z
            subtract vector3 1,1,2
            structuralSprings(count).L = length vector3(1)
            inc count, 1
         endif
      next c
   next r

   null = delete vector3(1)
   null = delete vector3(2)

endfunction





function resolveCollisions()

   null = make vector3(1)
   null = make vector3(2)
   null = make vector3(3)

   for i = 0 to NUMVERTICES-1
      if collisions(i).p1.r <> -1
         r = collisions(i).p1.r
         c = collisions(i).p1.c

         set vector3 1, collisions(i).n.x, collisions(i).n.y, collisions(i).n.z
         set vector3 2, particles(r,c).velocity.x, particles(r,c).velocity.y, particles(r,c).velocity.z
         copy vector3 3, 1
         multiply vector3 3,dot product vector3(1,2)
         set vector3 1, particles(r,c).velocity.x, particles(r,c).velocity.y, particles(r,c).velocity.z
         subtract vector3 1, 1, 3

         multiply vector3 3,-(KRESTITUTION#+1)
         multiply vector3 1, FRICTIONFACTOR#
         add vector3 1, 3, 1
         particles(r,c).velocity.x = x vector3(1)
         particles(r,c).velocity.y = y vector3(1)
         particles(r,c).velocity.z = z vector3(1)
      endif
   next i

endfunction





function updateClothGeometry()

   VB LOCK VERTEX DATA FOR LIMB 1, 0

   vert = 0
   for z = 1 to NUMROWS
      for x = 1 to NUMCOLS
         x1# = particles(z,x-1).position.x
         y1# = particles(z,x-1).position.y
         z1# = particles(z,x-1).position.z

         x2# = particles(z-1,x-1).position.x
         y2# = particles(z-1,x-1).position.y
         z2# = particles(z-1,x-1).position.z

         x3# = particles(z-1,x).position.x
         y3# = particles(z-1,x).position.y
         z3# = particles(z-1,x).position.z

         x4# = x1#
         y4# = y1#
         z4# = z1#

         x5# = x3#
         y5# = y3#
         z5# = z3#

         x6# = particles(z,x).position.x
         y6# = particles(z,x).position.y
         z6# = particles(z,x).position.z

         `VB SET VERTEX DATA POSITION vert, particles(z,x).position.x, particles(z,x).position.y, particles(z,x).position.z
         VB SET VERTEX DATA POSITION vert, x1#, y1#, z1#
         VB SET VERTEX DATA POSITION vert+1, x2#, y2#, z2#
         VB SET VERTEX DATA POSITION vert+2, x3#, y3#, z3#
         VB SET VERTEX DATA POSITION vert+3, x4#, y4#, z4#
         VB SET VERTEX DATA POSITION vert+4, x5#, y5#, z5#
         VB SET VERTEX DATA POSITION vert+5, x6#, y6#, z6#

         inc vert, 6
      next x
   next z

   VB UNLOCK VERTEX DATA

endfunction





function stepSimulation(dt as float)

   rem calculate all the forces
   calcForces()

   rem integrate
   for r = 0 to NUMROWS
      for c = 0 to NUMCOLS
         set vector3 11, particles(r,c).forces.x,particles(r,c).forces.y,particles(r,c).forces.z
         multiply vector3 11, particles(r,c).invMass
         particles(r,c).acceleration.x = x vector3(11)
         particles(r,c).acceleration.y = y vector3(11)
         particles(r,c).acceleration.z = z vector3(11)

         multiply vector3 11, dt
         particles(r,c).velocity.x = particles(r,c).velocity.x + x vector3(11)
         particles(r,c).velocity.y = particles(r,c).velocity.y + y vector3(11)
         particles(r,c).velocity.z = particles(r,c).velocity.z + z vector3(11)

         particles(r,c).position.x = particles(r,c).position.x + particles(r,c).velocity.x * dt
         particles(r,c).position.y = particles(r,c).position.y + particles(r,c).velocity.y * dt
         particles(r,c).position.z = particles(r,c).position.z + particles(r,c).velocity.z * dt
      next c
   next r

   rem check for collision
   `check = checkForCollision()
   `if check = TRUE then resolveCollisions()

   updateClothGeometry()

endfunction

sync on
sync rate 60
autocam off
hide mouse
randomize timer()
`load image "Grass.bmp",1
ink rgb(0,255,0),0
box 0,0,100,100
get image 1,0,0,100,100
make matrix 1, 1000, 1000, 60, 60
prepare matrix texture 1, 1, 1, 1
smooth_matrix(1,2,60,60)
update matrix 1
color backdrop 0
make light 1
hide light 0
lightz=0
light=0

DO
   if light=0
   if lightz<50
   lightz=lightz+1
   else light=1
   endif
   endif
   if light=1
   lightz=lightz-1
   if lightz<2
   light=0
   endif
   endif
   position light 1,0,0,lightz
   shadow(1,2,10,30,30)
   shadow(3,4,50,100,100)

   gosub camera_stuff
   sync
LOOP

function smooth_matrix(number as integer, iter as integer, xsegs as integer, zsegs as integer)

   dim heights#(xsegs, zsegs)

   rem store original heights
   for z = 0 to zsegs
      for x = 0 to xsegs
         heights#(x,z) = get matrix height(number,x,z)
      next x
   next z

   for t = 1 to iter
      for z = 0 to zsegs
         for x = 0 to xsegs
            count = 0
            h1# = 0
            h2# = 0
            h3# = 0
            h4# = 0
            h5# = 0
            h6# = 0
            h7# = 0
            h8# = 0

           if z < zsegs
               if x > 0 then h1# = heights#(x-1,z+1) : inc count
               h2# = heights#(x,z+1) : inc count
               if x < xsegs then h3# = heights#(x+1,z+1) : inc count
            endif

            if x > 0 then h4# = heights#(x-1,z) : inc count
            if x < xsegs then h5# = heights#(x+1,z) : inc count

            if z > 0
               if x > 0 then h6# = heights#(x-1,z-1) : inc count
               h7# = heights#(x,z-1) : inc count
               if x < xsegs then h8# = heights#(x+1,z-1) : inc count
            endif

            avg# = (h1#+h2#+h3#+h4#+h5#+h6#+h7#+h8#) / count

            set matrix height number,x,z,avg#
            heights#(x,z) = avg#

         next x
      next z
   next t

   rem delete array
   undim heights#()

endfunction

camera_stuff:
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5

  if shiftkey() then speed# = 10
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

   `if shiftkey() then inc cy#, 2
   `if controlkey() then dec cy#, 2

  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get ground height(1,cx#,cz#)
  position camera cx#,cy#+50,cz#
  rotate camera wrapvalue(cxa#),a#,0
RETURN


function shadow(objnum,shadownum,objsize,xpos,ypos)
if object exist(objnum)=0
make object sphere objnum,objsize
ypos=get ground height(1,xpos,ypos)
position object objnum,xpos,ypos+objsize/2,xpos
endif
if object exist(shadownum)=0
make object sphere shadownum,objsize
endif
litpos=light position z(1)
objsize=object size(objnum)
objposz=object position z(objnum)
objposy=object position y(objnum)
objposx=object position x(objnum)
scale object shadownum,100,10,160
set object ambient shadownum,0
yrotate object shadownum,litpos*1.5
position object shadownum,objposx+litpos*.18*objsize*.1,objposy-objsize,objposz+objsize*1.2-litpos*.12*objsize*.2
color object shadownum,RGB(0,0,0)
sync
endfunction

sync on
sync rate 60
autocam off
hide mouse
randomize timer()
`load image "Grass.bmp",1
ink rgb(0,255,0),0
box 0,0,100,100
get image 1,0,0,100,100
make matrix 1, 1000, 1000, 60, 60
prepare matrix texture 1, 1, 1, 1
smooth_matrix(1,2,60,60)
update matrix 1
color backdrop 0
make light 1
hide light 0
lightz=0
light=0

DO
   if light=0
   if lightz<50
   lightz=lightz+1
   else light=1
   endif
   endif
   if light=1
   lightz=lightz-1
   if lightz<2
   light=0
   endif
   endif
   position light 1,0,50,lightz
   shadow(1,2,10,30,30)
   shadow(3,4,50,100,100)

   gosub camera_stuff
   sync
LOOP

function smooth_matrix(number as integer, iter as integer, xsegs as integer, zsegs as integer)

   dim heights#(xsegs, zsegs)

   rem store original heights
   for z = 0 to zsegs
      for x = 0 to xsegs
         heights#(x,z) = get matrix height(number,x,z)
      next x
   next z

   for t = 1 to iter
      for z = 0 to zsegs
         for x = 0 to xsegs
            count = 0
            h1# = 0
            h2# = 0
            h3# = 0
            h4# = 0
            h5# = 0
            h6# = 0
            h7# = 0
            h8# = 0

           if z < zsegs
               if x > 0 then h1# = heights#(x-1,z+1) : inc count
               h2# = heights#(x,z+1) : inc count
               if x < xsegs then h3# = heights#(x+1,z+1) : inc count
            endif

            if x > 0 then h4# = heights#(x-1,z) : inc count
            if x < xsegs then h5# = heights#(x+1,z) : inc count

            if z > 0
               if x > 0 then h6# = heights#(x-1,z-1) : inc count
               h7# = heights#(x,z-1) : inc count
               if x < xsegs then h8# = heights#(x+1,z-1) : inc count
            endif

            avg# = (h1#+h2#+h3#+h4#+h5#+h6#+h7#+h8#) / count

            set matrix height number,x,z,avg#
            heights#(x,z) = avg#

         next x
      next z
   next t

   rem delete array
   undim heights#()

endfunction

camera_stuff:
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5

  if shiftkey() then speed# = 10
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

   `if shiftkey() then inc cy#, 2
   `if controlkey() then dec cy#, 2

  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get ground height(1,cx#,cz#)
  position camera cx#,cy#+50,cz#
  rotate camera wrapvalue(cxa#),a#,0
RETURN


function shadow(objnum,shadownum,objsize,xpos,ypos)
if object exist(objnum)=0
make object sphere objnum,objsize,20,20
ypos=get ground height(1,xpos,ypos)
position object objnum,xpos,ypos+objsize/2,xpos
endif
if object exist(shadownum)=0
make object sphere shadownum,objsize,20,20
endif
litpos=light position z(1)
objsize=object size(objnum)
objposz=object position z(objnum)
objposy=object position y(objnum)
objposx=object position x(objnum)
scale object shadownum,100,10,160
set object ambient shadownum,0
yrotate object shadownum,litpos*1.5
position object shadownum,objposx+litpos*.18*objsize*.1,objposy-objsize,objposz+objsize*1.2-litpos*.12*objsize*.2
color object shadownum,RGB(0,0,0)
endfunction

if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 60
autocam off
hide mouse
ink rgb(120,160,185),0
box 0,0,97,97
get image 1,0,0,100,100
make matrix 1, 1000, 1000, 20, 20
position matrix 1,-500,0,-500
prepare matrix texture 1, 1, 1, 1
ghost matrix on 1,3
update matrix 1
color backdrop 0
set ambient light 0
make light 1
set light range 1,2000
hide light 0
make object sphere 100,20
set object light 100,0


global a#
global cxa#
global cx#
global cy#
global cz#
cz#=-400
global theta#

make_objects()

DO
  move_light()
  update_shadow()
  camera_stuff()
  sync
LOOP

function camera_stuff()
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5

  if shiftkey() then speed# = 10
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get ground height(1,cx#,cz#)
  position camera cx#,cy#+50,cz#
  rotate camera wrapvalue(cxa#),a#,0

endfunction

function make_objects()

ink rgb(155,155,255),0
box 0,0,10,10
get image 2,0,0,10,10
make object sphere 1,50,30,30
texture object 1,2
set object specular power 1,30
set object specular 1,rgb(250,150,150)
set object smoothing 1,100
set object diffuse 1,rgb(200,170,140)
position object 1,-100,25,0
make object sphere 2,50,20,20
make mesh from object 2,2
add limb 1,1,2
delete object 2
delete mesh 2
color limb 1,1,0


ink rgb(0,255,0),0
box 0,0,10,10
get image 4,0,0,10,10
make object cylinder 5,50
texture object 5,4
set object specular power 5,30
set object specular 5,rgb(250,150,150)
set object smoothing 5,100
set object diffuse 5,rgb(200,170,140)
position object 5,0,25,0
make object cylinder 6,50
xrotate object 6,90
fix object pivot 6
make mesh from object 2,6
add limb 5,1,2
delete object 6
delete mesh 2
color limb 5,1,0

ink rgb(255,0,0),0
box 0,0,10,10
get image 3,0,0,10,10
make object cone 3,50
texture object 3,3
set object specular power 3,30
set object specular 3,rgb(250,150,150)
set object smoothing 3,100
set object diffuse 3,rgb(200,170,140)
position object 3,100,25,0
make object cone 4,50
xrotate object 4,90
fix object pivot 4
make mesh from object 2,4
add limb 3,1,2
delete object 4
delete mesh 2
color limb 3,1,0

make object sphere 101,50
texture object 101,2
fade object 101,30
position object 101,-100,-25,0
xrotate object 101,-180
make object cone 103,50
texture object 103,3
fade object 103,60
position object 103,100,-25,0
xrotate object 103,-180
make object cylinder 105,50
texture object 105,4
fade object 105,30
position object 105,0,-25,0
xrotate object 105,-180

endfunction

function move_light()

lightx#=260*sin(theta#)
lightz#=150*cos(theta#)
lighty#=180+150*cos(theta#/1.4)
inc theta#
position light 1,lightx#,lighty#,lightz#
position object 100,lightx#,lighty#,lightz#
endfunction

function update_shadow()

for object=1 to 5 step 2
horizontal_distance#=sqrt((light position x(1)-object position x(object))^2+(light position z(1)-object position z(object))^2)
vertical_distance#=light position y(1)-object position y(object)
offset#=24+(horizontal_distance#/vertical_distance#)
offset limb object,1,0,-25,offset#
scale limb object,1,100,2,100+2*offset#
bearing#=atanfull(light position x(1)-object position x(object),light position z(1)-object position z(object))
rotate object object,0,bearing#-180,0
next object

endfunction

if check display mode(1024,768,32)=1 then set display mode 1024,768,32
sync on
sync rate 60
autocam off
hide mouse
ink rgb(120,160,185),0
box 0,0,97,97
get image 1,0,0,100,100
make matrix 1, 1000, 1000, 20, 20
position matrix 1,-500,0,-500
prepare matrix texture 1, 1, 1, 1
ghost matrix on 1,3
update matrix 1
color backdrop 0
set ambient light 0
make light 1
set light range 1,2000
hide light 0
make object sphere 100,20
set object light 100,0


global a#
global cxa#
global cx#
global cy#
global cz#
cz#=-400
global theta#

make_objects()

DO
  move_light()
  update_shadow()
  camera_stuff()
  sync
LOOP

function camera_stuff()
  oldcx#=cx#
  oldcz#=cz#
  speed# = 5

  if shiftkey() then speed# = 10
  if upkey()=1
    cx#=newxvalue(cx#,a#,speed#)
    cz#=newzvalue(cz#,a#,speed#)
  endif
  if downkey()=1
    cx#=newxvalue(cx#,a#,-speed#)
    cz#=newzvalue(cz#,a#,-speed#)
  endif
  if leftkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
  endif
  if rightkey()=1
    cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
    cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
  endif

  a#=wrapvalue(a#+(mousemovex()/3.0))
  cxa#=cxa#+(mousemovey()/3.0)
  if cxa#<-90.0 then cxa#=-90.0
  if cxa#>90.0 then cxa#=90.0
  cy# = get ground height(1,cx#,cz#)
  position camera cx#,cy#+50,cz#
  rotate camera wrapvalue(cxa#),a#,0

endfunction

function make_objects()

ink rgb(155,155,255),0
box 0,0,10,10
get image 2,0,0,10,10
make object sphere 1,50,30,30
texture object 1,2
set object specular power 1,30
set object specular 1,rgb(250,150,150)
set object smoothing 1,100
set object diffuse 1,rgb(200,170,140)
position object 1,-100,25,0
make object sphere 2,50,20,20
make mesh from object 2,2
add limb 1,1,2
delete object 2
delete mesh 2
color limb 1,1,0


ink rgb(0,255,0),0
box 0,0,10,10
get image 4,0,0,10,10
make object cylinder 5,50
texture object 5,4
set object specular power 5,30
set object specular 5,rgb(250,150,150)
set object smoothing 5,100
set object diffuse 5,rgb(200,170,140)
position object 5,0,25,0
make object cylinder 6,50
xrotate object 6,90
fix object pivot 6
make mesh from object 2,6
add limb 5,1,2
delete object 6
delete mesh 2
color limb 5,1,0

ink rgb(255,0,0),0
box 0,0,10,10
get image 3,0,0,10,10
make object cone 3,50
texture object 3,3
set object specular power 3,30
set object specular 3,rgb(250,150,150)
set object smoothing 3,100
set object diffuse 3,rgb(200,170,140)
position object 3,100,25,0
make object cone 4,50
xrotate object 4,90
fix object pivot 4
make mesh from object 2,4
add limb 3,1,2
delete object 4
delete mesh 2
color limb 3,1,0

make object sphere 101,50
texture object 101,2
fade object 101,30
position object 101,-100,-25,0
xrotate object 101,-180
make object cone 103,50
texture object 103,3
fade object 103,60
position object 103,100,-25,0
xrotate object 103,-180
make object cylinder 105,50
texture object 105,4
fade object 105,30
position object 105,0,-25,0
xrotate object 105,-180

endfunction

function move_light()

lightx#=260*sin(theta#)
lightz#=150*cos(theta#)
lighty#=180+150*cos(theta#/1.4)
inc theta#
position light 1,lightx#,lighty#,lightz#
position object 100,lightx#,lighty#,lightz#
endfunction

function update_shadow()

for object=1 to 5 step 2
horizontal_distance#=sqrt((light position x(1)-object position x(object))^2+(light position z(1)-object position z(object))^2)
vertical_distance#=light position y(1)-object position y(object)
offset#=24+(horizontal_distance#/vertical_distance#)
offset limb object,1,0,-25,offset#
scale limb object,1,100,2,100+2*offset#
bearing#=atanfull(light position x(1)-object position x(object),light position z(1)-object position z(object))
rotate object object,0,bearing#-180,0
next object

endfunction

global newornot
global level
dim sco_name$(9)
dim sco_score(9)
newornot=0
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
Ink RGB(255,255,255),0
set text font "tahoma"
set text size 28
`load sound "blip.wav",1
`load sound "metalclank.wav",2
`load music "dust.mp3",1
`load music "ancient_sighs.mp3",2
character()
wait key

Menu:
`loop music 1
backdrop off
buttons()
initscores()
do
sync
background()
buttons()
loop

make:
hide mouse
`create green texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 103,0,0,100,100

cls

`create purple texture
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 102,0,0,100,100

cls

`create blue texture
if level<3
hereb4=0
newornot=0
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=3
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=5
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=7
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=9
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/1.04,x+y,x+y/17),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=11
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y/2.3,x+y/23.1),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=13
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/5.66,x+y/1.14,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=15
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

`create star texture
for x=0 to 100
for y=0 to 100
d=rnd(20)
ink rgb(100+rnd(100),100+rnd(100),rnd(100)+100),0
if d=1 then dot x,y
next y
next x
get image 1,0,0,100,100

`create tile texture
if level<3
cls
ink rgb(0,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=3
cls
ink rgb(255,0,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=5
cls
ink rgb(0,255,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=7
cls
ink rgb(255,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=9
cls
ink rgb(245,255,15),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=11
cls
ink rgb(255,110,11),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=13
cls
ink rgb(45,223,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=15
cls
ink rgb(255,255,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if escapekey()=1 then end
set text font "sf automaton_mod"
set text size 25

`create starsphere
make object sphere 1000,-1000,50,50
texture object 1000,1
scale object texture 1000,5,5
xrotate object 1000,-90

`player paddle
make object sphere 1,20,20,20
scale object 1,100,400,100
ghost object on 1
texture object 1,102
set object emissive 1,rgb(200,200,200)
set object specular 1,rgb(250,250,250)
set object specular power 1,10
set object fog 1,0
set object collision on 1
set object collision to boxes 1


`reflection of player paddle
clone object 302,1 `top
scale object 302,100,400,100
fade object 302,90
clone object 303,1 `bottom
scale object 303,100,400,100
fade object 303,90

`computer paddle
make object sphere 2,20,20,20
scale object 2,100,400,100
ghost object on 2
texture object 2,103
set object emissive 2,rgb(200,200,200)
set object specular 2,rgb(250,250,250)
set object specular power 2,10
set object fog 2,0
set object collision on 2
set object collision to boxes 2

`reflection of computer paddle
clone object 304,2 `top
scale object 304,100,400,100
fade object 304,90
clone object 305,2 `bottom
scale object 305,100,400,100
fade object 305,90

`ball
make object sphere 3,20,40,40
texture object 3,101
set object specular 3,rgb(200,200,200)
set object specular power 3,15
set object emissive 3,rgb(150,150,100)
set object ambient 3,0
set object collision on 3
set object fog 3,0

`reflection of ball
clone object 300,3 `top reflection
fade object 300,50
clone object 301,3 `bottom reflection
fade object 301,50

`bottom wall
make object plain 4,500,800
xrotate object 4,90
set object collision on 4
texture object 4,2
scale object texture 4,5,5
set object transparency 4,1

`top wall
make object plain 5,500,800
xrotate object 5,90
set object collision on 5
texture object 5,2
scale object texture 5,5,5
set object transparency 5,1

`back wall
make object plain 6,500,100
texture object 6,101
scale object texture 6,2,10
set object texture 6,2,0
set object transparency 6,1
set object fog 6,0
ghost object on 6

`position walls
position object 4,0,-150,100
position object 5,0,150,100
position object 6,0,0,300

`restart point for new game (the goto command is not dead yet!)
newgame:
if newornot = 0
for object=300 to 305
hide object object
next object

`zoom in
paddlex#=0
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
position object 3,0,0,0


zrotate camera 0
camz#=-2000.0
camrl#=0
position camera 0,0,0,camz#
while camz#<-500.0
inc camz#,10
inc camrl#,.1589
roll camera right camrl#
position camera 0,0,camz#
sync
endwhile
position camera 0,0,0,-500

`set paddle positions

while paddlex#<180
inc paddlex#
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
sync
endwhile

do
text screen width()/2-100,200,"Gravity on? [Y]es [N]o"
if inkey$()="y" then gravity=1:exit
if inkey$()="n" then gravity=0:exit
sync
loop

text screen width()/2-70,240,"GET READY!"
sync
wait 600

for object=300 to 305
show object object
next object

`set initial variables
level=1
pscore=0
cscore=0
pv#=10 `player paddle velocity
bvx#=10 `ball velocity
crntmscspd#=100
newornot=0
here1=1
here2=1
here3=1
here4=1
here5=1
here6=1
here7=1
if gravity=1
cv#=3.5 `computer paddle velocity
g#=0.5
else
cv#=2
g#=0
endif
endif

`restart point for new serve or new level
restart:
randomize timer()
wait 800
py#=-10+rnd(20) `player's initial y position
cy#=-10+rnd(20)           `computer's initial y position
bx#=0           `ball x
by#=0           `ball y
bvy#=1.5+rnd(10)/10          `ball direction (in degrees:- horizontal=0)
bvx#=abs(bvx#)
`main loop

do
`set sound volume 1,80 : set sound volume 2,80
`set music volume 1,100

`player input
remstart
if upkey()>0 and object collision (1,5)=0
   py#=py#+pv#
endif

if downkey()>0 and object collision (1,4)=0
   py#=py#-pv#
endif
remend


py#=py#-mousemovey()
if py#>110 then py#=110
if py#<-110 then py#=-110

`move player paddle
position object 1,-180,py#,100
position object 302,-180,-py#-300,100
position object 303,-180,-py#+300,100
`position object 401,-180,py#,100

`ball motion
bvy#=bvy#+g#
bx#=bx#+bvx#
by#=by#-bvy#

`collision with court
if by#>140
`play sound 2
by#=by#-10
bvy#=bvy#*-1
endif

if by#<-140
`play sound 2
by#=by#+10
bvy#=bvy#*-1
endif

`collision with player paddle
if object collision(3,0)=1
  `play sound 1
  bvx#=bvx#*-1 `reverse velocity
  bx#=-150 `prevent embedding
`measure offset between player paddle and ball and adjust direction
    po#=by#-py#
    bvy#=bvy#-po#*0.15
Endif

`and same for computer paddle.....
If object collision(3,0) = 2
If object collision(3,0) = 2
`play sound 1
bvx#=bvx#*-1
bx#=150
co#=by#-cy#
bvy#=bvy#-co#*0.15
Endif

if bvy#>15.0 then bvy#=15.0
if bvy#<-15.0 then bvy#=-15.0

`new ball position
position object 3,bx#,by#,100
position object 300,bx#,-by#+300,100
position object 301,bx#,-by#-300,100

`computer paddle A.I.

`return to middle
if bvx#<0
  if cy#>2 then a#=-cv#
  if cy#<2 then a#=cv#
  if cy#<=2 and cy#>=-2 then a#=0
  cy#=cy#+a#
endif

`move towards ball
if bvx#>0
  if by#>cy# then a#=cv#
  if by#<cy# then a#=-cv#
  cy#=cy#+a#
endif

position object 2,180,cy#,100
position object 304,180,-cy#+300,100
position object 305,180,-cy#-300,100

`win or lose
if object position x(3) < -250
   cscore=cscore+1
   vb#=vb#*-1
   goto restart
endif

if object position x(3) > 250
  pscore = pscore +1
  goto restart
endif

`print score
text screen width()/2-20,screen height()/2-12,str$(pscore)+" : "+str$(cscore)

`goto next level, increase difficulty and reset scores
if pscore>2
   crntmscspd#=crntmscspd#+10
   bv#=bv#+0.5
   pv#=pv#+0.3
   cv#=cv#+0.5
   level=level+1
   pscore=0
   cscore=0
 `  set music speed 2,crntmscspd#
   goto restart
endif

`display level
text screen width()/2-40,screen height()/2-100,"Level "+str$(level)


`game over text
if cscore>2
goto highscore
endif

if inkey$()="q" or inkey$()="Q"
level=0
cscore=0
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then delete sound 1
if sound exist(2) then delete sound 2
if music exist(1) then delete music 1
show mouse
ink 0,0
cls
goto Menu
endif

if level>4 and level<11
  `scroll textures
  scroll object texture 1000,0,-0.014
  scroll object texture 4,0,0.08
  scroll object texture 5,0,0.08

  if clockwise=1 then roll camera right 0.1
  if camera angle z()>30 then clockwise=0:turn camera left 0.1
  if clockwise=0 then roll camera left 0.1
  if camera angle z()<-30 then clockwise=1:turn camera right 0.1

else

 `scroll textures
  scroll object texture 1000,0,-0.004
  scroll object texture 4,0,0.004
  scroll object texture 5,0,0.004

endif

if level>10 and level<16
  `scroll textures
  scroll object texture 1000,0,-0.028
  scroll object texture 4,0,0.16
  scroll object texture 5,0,0.16

  if clockwise=1 then roll camera right 0.2
  if camera angle z()>30 then clockwise=0:turn camera left 0.2
  if clockwise=0 then roll camera left 0.2
  if camera angle z()<-30 then clockwise=1:turn camera right 0.2

endif

if level>14 and level<21
  `scroll textures
  scroll object texture 1000,0,-0.042
  scroll object texture 4,0,0.24
  scroll object texture 5,0,0.24

  if clockwise=1 then roll camera right 0.3
  if camera angle z()>30 then clockwise=0:turn camera left 0.3
  if clockwise=0 then roll camera left 0.3
  if camera angle z()<-30 then clockwise=1:turn camera right 0.3

endif

If here1=1
If level=3
set text font "sf automaton_mod"
ink rgb(0,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 1st opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here1=0
goto make
endif
endif

If here2=1
If level=5
set text font "sf automaton_mod"
ink rgb(255,0,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 2nd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here2=0
goto make
endif
endif

If here3=1
If level=7
set text font "sf automaton_mod"
ink rgb(0,255,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 3rd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here3=0
goto make
endif
endif

If here4=1
If level=9
set text font "sf automaton_mod"
ink rgb(255,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 4th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here4=0
goto make
endif
endif

If here5=1
If level=11
set text font "sf automaton_mod"
ink rgb(255,110,11),0
set text size 25
do
text screen width()/2-300,200,"You have beat 5th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here5=0
goto make
endif
endif

If here6=1
If level=13
set text font "sf automaton_mod"
ink rgb(45,223,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 6th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here6=0
goto make
endif
endif

If here7=1
If level=15
set text font "sf automaton_mod"
ink rgb(255,255,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 7th opponent would you like to continue? [Y]es [N]o"
text screen width()/2-150,200,"<<This is your last opponent>>"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here7=0
goto make
endif
endif

sync
loop

highscore:
for p=0 to 9
if level>sco_score(p) or level=sco_score(p)`if score higher or the same
high_score=p+1                       `important counter for the writing of the high score list
gotscore=1
entry=1
clear entry buffer
exit
endif
next p

if gotscore=0
gotscore=2
endif

If gotscore=1
Ink RGB(255,140,243),0
repeat
text screen width()/2-100,screen height()/2-60,"ENTER HIGH SCORE"
new$=entry$()
for n=1 to len(new$)
if asc (mid$(new$,n))=8
line$=left$(line$,len(line$)-1) ` backspace in score entry
else
if len(line$)<10 then line$=line$+mid$(new$,n) `limit letters in entry to 9
endif
next n
clear entry buffer
center text screen width()/2,screen height()/2,line$ `displays what you enter
sync
until returnkey()=1
for b=9 to high_score-1 step -1
if b-1>0 or b-1=0`-----------action if array exist
sco_name$(b)=sco_name$(b-1)
sco_score(b)=sco_score(b-1)
endif
next b
sco_name$(high_score-1)=line$
sco_score(high_score-1)=level
high_score=0
`--------------------save score board to file
if file exist("scores.dat") then delete file "scores.dat"
open to write 1,"scores.dat"
for k=0 to 9
write string 1,sco_name$(k)
write file 1,sco_score(k)
next k
close file 1
level=0
cscore=0
sync
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
if music exist(2) then set music speed 2,100
show mouse
ink 0,0
cls
goto Menu
endif

If gotscore=2
set text font "sf automaton_mod"
ink rgb(0,200,0),0
Set text size 42
text screen width()/2-100,screen height()/2+200,"Game Over"
Set text size 22
text screen width()/2-130,screen height()/2+250,"(Press Any Key To Continue)"
sync
wait key
sync
ink rgb(0,0,255),0
level=0
cscore=0
for x=1 to 100
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
if music exist(2) then set music speed 2,100
show mouse
ink 0,0
cls
Ink RGB(255,255,255),0
goto Menu
Endif

function over(but,x1,y1,x2,y2)
if mousex()>x1 and mousex()<X2
if mousey()>y1 and mousey()<Y2
over_area=1
endif
endif
endfunction over_area
function buttons()
if image exist(1)=0 then load image "button.bmp",1
if image exist(2)=0 then load image "buttonover.bmp",2
if over(1,screen width()/2-70,screen height()/2-200,screen width()/2+84,screen height()/2-158)=1
if mouseclick()=1
sync on
sync rate 50
autocam off
hide light 0
color backdrop rgb(0,0,0)
set ambient light 80
if light exist(1)=0 then make light 1
position light 1,100,100,20
set light range 1,100000
color light 1,rgb(255,220,180)
`stop music 1
`loop music 2
fog on
fog color 0
fog distance 850
hide mouse
goto make
endif
paste image 2,screen width()/2-70,screen height()/2-200
Ink 0,0
text screen width()/2-50,screen height()/2-195,"New Game"
else
paste image 1,screen width()/2-70,screen height()/2-200
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-195,"New Game"
endif

if over(1,screen width()/2-70,screen height()/2-150,screen width()/2+84,screen height()/2-108)=1
if mouseclick()=1 then scores()
paste image 2,screen width()/2-70,screen height()/2-150
Ink 0,0
text screen width()/2-50,screen height()/2-145,"Highscores"
else
paste image 1,screen width()/2-70,screen height()/2-150
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-145,"Highscores"
endif

if over(1,screen width()/2-70,screen height()/2-100,screen width()/2+84,screen height()/2-58)=1
if mouseclick()=1 then credits()
paste image 2,screen width()/2-70,screen height()/2-100
Ink 0,0
text screen width()/2-50,screen height()/2-95,"Credits"
else
paste image 1,screen width()/2-70,screen height()/2-100
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-95,"Credits"
endif

if over(1,screen width()/2-70,screen height()/2-50,screen width()/2+84,screen height()/2-8)=1
paste image 2,screen width()/2-70,screen height()/2-50
if mouseclick()=1
exit prompt "                                    Thanks For Playing","Tsunami Entertainment -- horlocker@yahoo.com"
end
endif
Ink 0,0
text screen width()/2-50,screen height()/2-45,"Exit"
else
paste image 1,screen width()/2-70,screen height()/2-50
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-45,"Exit"
endif
endfunction
Function background()
ink rgb(0,0,196),0
random# = rnd(1024)
random2# = rnd(768)
line random#,random#,random#+1,random2#
set text font "sf automaton_mod"
set text size 28
endfunction
Function initscores()
if file exist("scores.dat")=0
sco_name$(0)="Nick"
sco_score(0)=10
sco_name$(1)="Tera"
sco_score(1)=9
sco_name$(2)="The Queen"
sco_score(2)=8
sco_name$(3)="Pat"
sco_score(3)=7
sco_name$(4)="Thomas"
sco_score(4)=6
sco_name$(5)="Cody"
sco_score(5)=5
sco_name$(6)="Josh"
sco_score(6)=4
sco_name$(7)="Justin"
sco_score(7)=3
sco_name$(8)="Holly"
sco_score(8)=2
sco_name$(9)="James"
sco_score(9)=1
endif
if file exist("scores.dat")>0
open to read 1,"scores.dat"
for a=0 to 9
read string 1,sco_name$(a)
read file 1,sco_score(a)
next a
close file 1
endif
Endfunction
Function scores()
x=370
y=580
y2=380
crntcolor#=0
ink 0,0
box x,y2,x+370,y+10
ink rgb(248,217,1),0
y=380
for a=0 to 9
if a<9 then text x,y,"0"+str$(a+1)+". "+sco_name$(a)
if a<9 then text x+200,y,"................."+str$(sco_score(a))
if a=9 then text x,y,str$(a+1)+". "+sco_name$(a)
if a=9 then text x+200,y,"................."+str$(sco_score(a))
inc y,20
next a
set text font "sf automaton_mod"
sync
Endfunction
Function credits()
ink 0,0
box 370,380,740,590
ink rgb(248,217,1),0
center text 550,380,"[Producer]"
center text 550,410,"Nicholas"
center text 550,440,"[Special Thanks To]"
center text 550,470,"Ric"
center text 550,500,"[And]"
center text 550,530,"www.thegamecreators.com"
Endfunction
Function character()
if file exist("chara.dat")=0
Ink RGB(0,0,255),0
repeat
text screen width()/2-100,screen height()/2-60,"ENTER YOUR NAME!"
new$=entry$()
for n=1 to len(new$)
if asc (mid$(new$,n))=8
line$=left$(line$,len(line$)-1) ` backspace in score entry
else
if len(line$)<11 then line$=line$+mid$(new$,n) `limit letters in entry to 9
endif
next n
clear entry buffer
center text screen width()/2,screen height()/2,line$ `displays what you enter
sync
until returnkey()=1
user_name$(1)=line$
user_paddle(1)=paddle
if file exist("chara.dat") then delete file "chara.dat"
open to write 2,"chara.dat"
for k=0 to 5
write string 2,user_name$(k)
write file 2,user_paddle(k)
next k
close file 1
if file exist("chara.dat")>0
open to read 2,"chara.dat"
for x=0 to 9
read string 2,user_name$(x)
read file 2,user_paddle(x)
next x
close file 2
Endfunction

global dim user_name$(5)
global dim user_paddle(5)

global newornot
global level
dim sco_name$(9)
dim sco_score(9)
newornot=0
if check display mode(1024,768,32)=1 then set display mode 1024,768,32
Ink RGB(255,255,255),0
set text font "tahoma"
set text size 28
`load sound "blip.wav",1
`load sound "metalclank.wav",2
`load music "dust.mp3",1
`load music "ancient_sighs.mp3",2
character()
wait key

Menu:
`loop music 1
backdrop off
buttons()
initscores()
do
sync
background()
buttons()
loop

make:
hide mouse
`create green texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 103,0,0,100,100

cls

`create purple texture
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 102,0,0,100,100

cls

`create blue texture
if level<3
hereb4=0
newornot=0
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=3
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=5
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=7
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=9
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/1.04,x+y,x+y/17),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=11
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y/2.3,x+y/23.1),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=13
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/5.66,x+y/1.14,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=15
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

`create star texture
for x=0 to 100
for y=0 to 100
d=rnd(20)
ink rgb(100+rnd(100),100+rnd(100),rnd(100)+100),0
if d=1 then dot x,y
next y
next x
get image 1,0,0,100,100

`create tile texture
if level<3
cls
ink rgb(0,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=3
cls
ink rgb(255,0,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=5
cls
ink rgb(0,255,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=7
cls
ink rgb(255,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=9
cls
ink rgb(245,255,15),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=11
cls
ink rgb(255,110,11),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=13
cls
ink rgb(45,223,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=15
cls
ink rgb(255,255,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if escapekey()=1 then end
set text font "sf automaton_mod"
set text size 25

`create starsphere
make object sphere 1000,-1000,50,50
texture object 1000,1
scale object texture 1000,5,5
xrotate object 1000,-90

`player paddle
make object sphere 1,20,20,20
scale object 1,100,400,100
ghost object on 1
texture object 1,102
set object emissive 1,rgb(200,200,200)
set object specular 1,rgb(250,250,250)
set object specular power 1,10
set object fog 1,0
set object collision on 1
set object collision to boxes 1


`reflection of player paddle
clone object 302,1 `top
scale object 302,100,400,100
fade object 302,90
clone object 303,1 `bottom
scale object 303,100,400,100
fade object 303,90

`computer paddle
make object sphere 2,20,20,20
scale object 2,100,400,100
ghost object on 2
texture object 2,103
set object emissive 2,rgb(200,200,200)
set object specular 2,rgb(250,250,250)
set object specular power 2,10
set object fog 2,0
set object collision on 2
set object collision to boxes 2

`reflection of computer paddle
clone object 304,2 `top
scale object 304,100,400,100
fade object 304,90
clone object 305,2 `bottom
scale object 305,100,400,100
fade object 305,90

`ball
make object sphere 3,20,40,40
texture object 3,101
set object specular 3,rgb(200,200,200)
set object specular power 3,15
set object emissive 3,rgb(150,150,100)
set object ambient 3,0
set object collision on 3
set object fog 3,0

`reflection of ball
clone object 300,3 `top reflection
fade object 300,50
clone object 301,3 `bottom reflection
fade object 301,50

`bottom wall
make object plain 4,500,800
xrotate object 4,90
set object collision on 4
texture object 4,2
scale object texture 4,5,5
set object transparency 4,1

`top wall
make object plain 5,500,800
xrotate object 5,90
set object collision on 5
texture object 5,2
scale object texture 5,5,5
set object transparency 5,1

`back wall
make object plain 6,500,100
texture object 6,101
scale object texture 6,2,10
set object texture 6,2,0
set object transparency 6,1
set object fog 6,0
ghost object on 6

`position walls
position object 4,0,-150,100
position object 5,0,150,100
position object 6,0,0,300

`restart point for new game (the goto command is not dead yet!)
newgame:
if newornot = 0
  for object=300 to 305
    hide object object
  next object


  `zoom in
  paddlex#=0
  position object 1,-paddlex#,0,0
  position object 2,paddlex#,0,0
  position object 3,0,0,0


  zrotate camera 0
  camz#=-2000.0
  camrl#=0
  position camera 0,0,0,camz#
  while camz#<-500.0
  inc camz#,10
  inc camrl#,.1589
  roll camera right camrl#
  position camera 0,0,camz#
  sync
  endwhile
  position camera 0,0,0,-500

  `set paddle positions

  while paddlex#<180
    inc paddlex#
    position object 1,-paddlex#,0,0
    position object 2,paddlex#,0,0
    sync
  endwhile

  do
    text screen width()/2-100,200,"Gravity on? [Y]es [N]o"
    if inkey$()="y" then gravity=1:exit
    if inkey$()="n" then gravity=0:exit
    sync
  loop

  text screen width()/2-70,240,"GET READY!"
  sync
  wait 600

  for object=300 to 305
    show object object
  next object

  `set initial variables
  level=1
  pscore=0
  cscore=0
  pv#=10 `player paddle velocity
  bvx#=10 `ball velocity
  crntmscspd#=100
  newornot=0
  here1=1
  here2=1
  here3=1
  here4=1
  here5=1
  here6=1
  here7=1
  if gravity=1
    cv#=3.5 `computer paddle velocity
    g#=0.5
  else
    cv#=2
  g#=0
  endif
endif

`restart point for new serve or new level
restart:
randomize timer()
wait 800
py#=-10+rnd(20) `player's initial y position
cy#=-10+rnd(20)           `computer's initial y position
bx#=0           `ball x
by#=0           `ball y
bvy#=1.5+rnd(10)/10          `ball direction (in degrees:- horizontal=0)
bvx#=abs(bvx#)
`main loop

do
`set sound volume 1,80 : set sound volume 2,80
`set music volume 1,100

`player input
remstart
if upkey()>0 and object collision (1,5)=0
   py#=py#+pv#
endif

if downkey()>0 and object collision (1,4)=0
   py#=py#-pv#
endif
remend


py#=py#-mousemovey()
if py#>110 then py#=110
if py#<-110 then py#=-110

`move player paddle
position object 1,-180,py#,100
position object 302,-180,-py#-300,100
position object 303,-180,-py#+300,100
`position object 401,-180,py#,100

`ball motion
bvy#=bvy#+g#
bx#=bx#+bvx#
by#=by#-bvy#

`collision with court
if by#>140
`play sound 2
by#=by#-10
bvy#=bvy#*-1
endif

if by#<-140
`play sound 2
by#=by#+10
bvy#=bvy#*-1
endif

`collision with player paddle
if object collision(3,0)=1
  `play sound 1
  bvx#=bvx#*-1 `reverse velocity
  bx#=-150 `prevent embedding
`measure offset between player paddle and ball and adjust direction
    po#=by#-py#
    bvy#=bvy#-po#*0.15
Endif

`and same for computer paddle.....
If object collision(3,0) = 2
`If object collision(3,0) = 2
`play sound 1
bvx#=bvx#*-1
bx#=150
co#=by#-cy#
bvy#=bvy#-co#*0.15
Endif


if bvy#>15.0 then bvy#=15.0
if bvy#<-15.0 then bvy#=-15.0

`new ball position
position object 3,bx#,by#,100
position object 300,bx#,-by#+300,100
position object 301,bx#,-by#-300,100

`computer paddle A.I.

`return to middle
if bvx#<0
  if cy#>2 then a#=-cv#
  if cy#<2 then a#=cv#
  if cy#<=2 and cy#>=-2 then a#=0
  cy#=cy#+a#
endif

`move towards ball
if bvx#>0
  if by#>cy# then a#=cv#
  if by#<cy# then a#=-cv#
  cy#=cy#+a#
endif

position object 2,180,cy#,100
position object 304,180,-cy#+300,100
position object 305,180,-cy#-300,100

`win or lose
if object position x(3) < -250
   cscore=cscore+1
   vb#=vb#*-1
   goto restart
endif

if object position x(3) > 250
  pscore = pscore +1
  goto restart
endif

`print score
text screen width()/2-20,screen height()/2-12,str$(pscore)+" : "+str$(cscore)

`goto next level, increase difficulty and reset scores
if pscore>2
   crntmscspd#=crntmscspd#+10
   bv#=bv#+0.5
   pv#=pv#+0.3
   cv#=cv#+0.5
   level=level+1
   pscore=0
   cscore=0
 `  set music speed 2,crntmscspd#
   goto restart
endif

`display level
text screen width()/2-40,screen height()/2-100,"Level "+str$(level)


`game over text
if cscore>2
goto highscore
endif

if inkey$()="q" or inkey$()="Q"
level=0
cscore=0
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then delete sound 1
if sound exist(2) then delete sound 2
if music exist(1) then delete music 1
show mouse
ink 0,0
cls
goto Menu
endif

if level>4 and level<11
  `scroll textures
  scroll object texture 1000,0,-0.014
  scroll object texture 4,0,0.08
  scroll object texture 5,0,0.08

  if clockwise=1 then roll camera right 0.1
  if camera angle z()>30 then clockwise=0:turn camera left 0.1
  if clockwise=0 then roll camera left 0.1
  if camera angle z()<-30 then clockwise=1:turn camera right 0.1

else

 `scroll textures
  scroll object texture 1000,0,-0.004
  scroll object texture 4,0,0.004
  scroll object texture 5,0,0.004

endif

if level>10 and level<16
  `scroll textures
  scroll object texture 1000,0,-0.028
  scroll object texture 4,0,0.16
  scroll object texture 5,0,0.16

  if clockwise=1 then roll camera right 0.2
  if camera angle z()>30 then clockwise=0:turn camera left 0.2
  if clockwise=0 then roll camera left 0.2
  if camera angle z()<-30 then clockwise=1:turn camera right 0.2

endif

if level>14 and level<21
  `scroll textures
  scroll object texture 1000,0,-0.042
  scroll object texture 4,0,0.24
  scroll object texture 5,0,0.24

  if clockwise=1 then roll camera right 0.3
  if camera angle z()>30 then clockwise=0:turn camera left 0.3
  if clockwise=0 then roll camera left 0.3
  if camera angle z()<-30 then clockwise=1:turn camera right 0.3

endif

If here1=1
If level=3
set text font "sf automaton_mod"
ink rgb(0,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 1st opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here1=0
goto make
endif
endif

If here2=1
If level=5
set text font "sf automaton_mod"
ink rgb(255,0,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 2nd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here2=0
goto make
endif
endif

If here3=1
If level=7
set text font "sf automaton_mod"
ink rgb(0,255,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 3rd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here3=0
goto make
endif
endif

If here4=1
If level=9
set text font "sf automaton_mod"
ink rgb(255,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 4th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here4=0
goto make
endif
endif

If here5=1
If level=11
set text font "sf automaton_mod"
ink rgb(255,110,11),0
set text size 25
do
text screen width()/2-300,200,"You have beat 5th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here5=0
goto make
endif
endif

If here6=1
If level=13
set text font "sf automaton_mod"
ink rgb(45,223,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 6th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here6=0
goto make
endif
endif

If here7=1
If level=15
set text font "sf automaton_mod"
ink rgb(255,255,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 7th opponent would you like to continue? [Y]es [N]o"
text screen width()/2-150,200,"<<This is your last opponent>>"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here7=0
goto make
endif
endif

sync
loop

highscore:
for p=0 to 9
if level>sco_score(p) or level=sco_score(p)`if score higher or the same
high_score=p+1                       `important counter for the writing of the high score list
gotscore=1
entry=1
clear entry buffer
exit
endif
next p

if gotscore=0
gotscore=2
endif

If gotscore=1
Ink RGB(255,140,243),0
repeat
text screen width()/2-100,screen height()/2-60,"ENTER HIGH SCORE"
new$=entry$()
for n=1 to len(new$)
if asc (mid$(new$,n))=8
line$=left$(line$,len(line$)-1) ` backspace in score entry
else
if len(line$)<10 then line$=line$+mid$(new$,n) `limit letters in entry to 9
endif
next n
clear entry buffer
center text screen width()/2,screen height()/2,line$ `displays what you enter
sync
until returnkey()=1
for b=9 to high_score-1 step -1
if b-1>0 or b-1=0`-----------action if array exist
sco_name$(b)=sco_name$(b-1)
sco_score(b)=sco_score(b-1)
endif
next b
sco_name$(high_score-1)=line$
sco_score(high_score-1)=level
high_score=0
`--------------------save score board to file
if file exist("scores.dat") then delete file "scores.dat"
open to write 1,"scores.dat"
for k=0 to 9
write string 1,sco_name$(k)
write file 1,sco_score(k)
next k
close file 1
level=0
cscore=0
sync
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
if music exist(2) then set music speed 2,100
show mouse
ink 0,0
cls
goto Menu
endif

If gotscore=2
set text font "sf automaton_mod"
ink rgb(0,200,0),0
Set text size 42
text screen width()/2-100,screen height()/2+200,"Game Over"
Set text size 22
text screen width()/2-130,screen height()/2+250,"(Press Any Key To Continue)"
sync
wait key
sync
ink rgb(0,0,255),0
level=0
cscore=0
for x=1 to 100
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
if music exist(2) then set music speed 2,100
show mouse
ink 0,0
cls
Ink RGB(255,255,255),0
goto Menu
Endif

function over(but,x1,y1,x2,y2)
if mousex()>x1 and mousex()<X2
if mousey()>y1 and mousey()<Y2
over_area=1
endif
endif
endfunction over_area
function buttons()
if image exist(1)=0 then load image "C:\Documents and Settings\Richard\Desktop\button.bmp",1
if image exist(2)=0 then load image "C:\Documents and Settings\Richard\Desktop\untitled.bmp",2
if over(1,screen width()/2-70,screen height()/2-200,screen width()/2+84,screen height()/2-158)=1
if mouseclick()=1
sync on
sync rate 50
autocam off
hide light 0
color backdrop rgb(0,0,0)
set ambient light 80
if light exist(1)=0 then make light 1
position light 1,100,100,20
set light range 1,100000
color light 1,rgb(255,220,180)
`stop music 1
`loop music 2
fog on
fog color 0
fog distance 850
hide mouse
goto make
endif
paste image 2,screen width()/2-70,screen height()/2-200
Ink 0,0
text screen width()/2-50,screen height()/2-195,"New Game"
else
paste image 1,screen width()/2-70,screen height()/2-200
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-195,"New Game"
endif

if over(1,screen width()/2-70,screen height()/2-150,screen width()/2+84,screen height()/2-108)=1
if mouseclick()=1 then scores()
paste image 2,screen width()/2-70,screen height()/2-150
Ink 0,0
text screen width()/2-50,screen height()/2-145,"Highscores"
else
paste image 1,screen width()/2-70,screen height()/2-150
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-145,"Highscores"
endif

if over(1,screen width()/2-70,screen height()/2-100,screen width()/2+84,screen height()/2-58)=1
if mouseclick()=1 then credits()
paste image 2,screen width()/2-70,screen height()/2-100
Ink 0,0
text screen width()/2-50,screen height()/2-95,"Credits"
else
paste image 1,screen width()/2-70,screen height()/2-100
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-95,"Credits"
endif

if over(1,screen width()/2-70,screen height()/2-50,screen width()/2+84,screen height()/2-8)=1
paste image 2,screen width()/2-70,screen height()/2-50
if mouseclick()=1
exit prompt "                                    Thanks For Playing","Tsunami Entertainment -- horlocker@yahoo.com"
end
endif
Ink 0,0
text screen width()/2-50,screen height()/2-45,"Exit"
else
paste image 1,screen width()/2-70,screen height()/2-50
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-45,"Exit"
endif
endfunction
Function background()
ink rgb(0,0,196),0
random# = rnd(1024)
random2# = rnd(768)
line random#,random#,random#+1,random2#
set text font "sf automaton_mod"
set text size 28
endfunction
Function initscores()
if file exist("scores.dat")=0
sco_name$(0)="Nick"
sco_score(0)=10
sco_name$(1)="Tera"
sco_score(1)=9
sco_name$(2)="The Queen"
sco_score(2)=8
sco_name$(3)="Pat"
sco_score(3)=7
sco_name$(4)="Thomas"
sco_score(4)=6
sco_name$(5)="Cody"
sco_score(5)=5
sco_name$(6)="Josh"
sco_score(6)=4
sco_name$(7)="Justin"
sco_score(7)=3
sco_name$(8)="Holly"
sco_score(8)=2
sco_name$(9)="James"
sco_score(9)=1
endif
if file exist("scores.dat")>0
open to read 1,"scores.dat"
for a=0 to 9
read string 1,sco_name$(a)
read file 1,sco_score(a)
next a
close file 1
endif
Endfunction
Function scores()
x=370
y=580
y2=380
crntcolor#=0
ink 0,0
box x,y2,x+370,y+10
ink rgb(248,217,1),0
y=380
for a=0 to 9
if a<9 then text x,y,"0"+str$(a+1)+". "+sco_name$(a)
if a<9 then text x+200,y,"................."+str$(sco_score(a))
if a=9 then text x,y,str$(a+1)+". "+sco_name$(a)
if a=9 then text x+200,y,"................."+str$(sco_score(a))
inc y,20
next a
set text font "sf automaton_mod"
sync
Endfunction
Function credits()
ink 0,0
box 370,380,740,590
ink rgb(248,217,1),0
center text 550,380,"[Producer]"
center text 550,410,"Nicholas"
center text 550,440,"[Special Thanks To]"
center text 550,470,"Ric"
center text 550,500,"[And]"
center text 550,530,"www.thegamecreators.com"
Endfunction

Function character()
if file exist("chara.dat")=0
  Ink RGB(0,0,255),0
  repeat
    text screen width()/2-100,screen height()/2-60,"ENTER YOUR NAME!"
    new$=entry$()
    for n=1 to len(new$)
      if asc (mid$(new$,n))=8
        line$=left$(line$,len(line$)-1) ` backspace in score entry
      else
        if len(line$)<11 then line$=line$+mid$(new$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line$ `displays what you enter
    sync
  until returnkey()=1
  user_name$(1)=line$
  user_paddle(1)=paddle
  if file exist("chara.dat") then delete file "chara.dat"
  open to write 2,"chara.dat"
  for k=0 to 5
    write string 2,user_name$(k)
    write file 2,user_paddle(k)
  next k
  close file 1
  if file exist("chara.dat")>0
    open to read 2,"chara.dat"
    for x=0 to 9
      read string 2,user_name$(x)
      read file 2,user_paddle(x)
    next x
    close file 2
  endif
endif
Endfunction

sync on
hide mouse
autocam off
position camera 0,0,-180
color backdrop 0
make light 1
position light 1,50,50,-100
set text font "sf automaton_mod"
set text size 20

`create green texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 1,0,0,100,100

cls

`create blue texture
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,0),0
      dot x,y
   next y
next x
get image 2,0,0,100,100

cls

`create blue texture
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y),0
      dot x,y
   next y
next x
get image 3,0,0,100,100


`player paddle
make object sphere 1,20,20,20
scale object 1,100,400,100

set object emissive 1,rgb(200,200,200)
set object specular 1,rgb(250,250,250)
set object specular power 1,10

player_colour=1

do

text 0,0,"Use left and right keys to select colour"
if leftkey()=1 and player_colour>1 then dec player_colour:wait 300
if rightkey()=1 and player_colour<3 then inc player_colour:wait 300

texture object 1,player_colour
pitch object up 1,1
sync

loop

global dim user_name$(5)
global dim user_paddle(5)

Private Sub SaveScore()
    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    xmlhttp.open "get", "http://www.mywebsite.com/savescores.asp?score=100&username=Chris64", False
    xmlhttp.send
    currentScoreTable=xmlhttp.responseText
    msgbox currentScoreTable
End Sub

<%
score=request.querystring("score")
scorepos=-1
'find position where this new score is the highest
for i=0 to 9
    if cint(score)>cint(application("score"&i)) then
        scorepos=i
    end if
next
'move all lower scores one position down
if scorepos>0 then
    for i=9 to scorepos+1 step -1
        application("score"&i)=application("score"&i-1)
        application("user"&i)=application("user"&i-1)
    next
    application("score"&scorepos)=score
    application("user"&scorepos)=request.querystring("username")
end if
'output scores
for i=0 to 9
    response.write application("score"&i)&": "&application("user"&i)&vbcrlf
next
%>

if username="kimosabi"
if password=username_password
read string
http://www.sell4fun.com/scores/kimosabi.dat (&...)
read file
http://www.sell4fun.com/paddle/kimosabi.dat (&...)
endif
endif

if check display mode(1024,768,32)=1 then set display mode 1024,768,32
global newornot
global level
global crntx
global crnty
dim sco_name$(9)
dim sco_score(9)
dim user_name$(9)
dim user_paddle(9)
newornot=0
Ink RGB(255,255,255),0
set text font "tahoma"
set text size 28
load sound "blip.wav",1
load sound "metalclank.wav",2
load music "dust.mp3",1
load music "ancient_sighs.mp3",2
paddleclr()

Menu:
loop music 1
backdrop off
buttons()
initscores()
do
sync
background()
buttons()
loop

make:
hide mouse
`create white texture
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y*10,x+y*10,x+y*10),0
      dot x,y
   next y
next x
get image 103,0,0,100,10
cls

`create player texture
if crnty=190
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y*crntx,0,0),0
      dot x,y
   next y
next x
get image 102,0,0,100,10
cls
endif

if crnty=290
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y*crntx,0),0
      dot x,y
   next y
next x
get image 102,0,0,100,10
cls
endif

if crnty=390
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y*crntx),0
      dot x,y
   next y
next x
get image 102,0,0,100,10
cls
endif

if crnty=490
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y*crntx,0,x+y*crntx),0
      dot x,y
   next y
next x
get image 102,0,0,100,10
cls
endif

if crnty=590
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y*crntx,x+y*crntx,0),0
      dot x,y
   next y
next x
get image 102,0,0,100,10
cls
endif

`create blue texture
if level<3
hereb4=0
newornot=0
for x=0 to 100
   for y=0 to 100
      ink rgb(0,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=3
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=5
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(0,x+y,0),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=7
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,0,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=9
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/1.04,x+y,x+y/17),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=11
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y/2.3,x+y/23.1),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=13
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y/5.66,x+y/1.14,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

if level=15
hereb4=1
newornot = 1
for x=0 to 100
   for y=0 to 100
      ink rgb(x+y,x+y,x+y),0
      dot x,y
   next y
next x
get image 101,0,0,100,100
endif

`create star texture
for x=0 to 100
for y=0 to 100
d=rnd(20)
ink rgb(100+rnd(100),100+rnd(100),rnd(100)+100),0
if d=1 then dot x,y
next y
next x
get image 1,0,0,100,100

`create tile texture
if level<3
cls
ink rgb(0,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=3
cls
ink rgb(255,0,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=5
cls
ink rgb(0,255,0),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=7
cls
ink rgb(255,0,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=9
cls
ink rgb(245,255,15),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=11
cls
ink rgb(255,110,11),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=13
cls
ink rgb(45,223,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if level=15
cls
ink rgb(255,255,255),0
box 0,0,10,10
box 10,10,20,20
get image 2,0,0,20,20
endif

if escapekey()=1 then end
set text font "sf automaton_mod"
set text size 25

`create starsphere
make object sphere 1000,-1000,50,50
texture object 1000,1
scale object texture 1000,5,5
xrotate object 1000,-90

`player paddle
make object sphere 1,20,20,20
scale object 1,100,400,100
ghost object on 1
texture object 1,102
set object emissive 1,rgb(200,200,200)
set object specular 1,rgb(250,250,250)
set object specular power 1,10
set object fog 1,0
set object collision on 1
set object collision to boxes 1


`reflection of player paddle
clone object 302,1 `top
scale object 302,100,400,100
fade object 302,90
clone object 303,1 `bottom
scale object 303,100,400,100
fade object 303,90

`computer paddle
make object sphere 2,20,20,20
scale object 2,100,400,100
ghost object on 2
texture object 2,103
set object emissive 2,rgb(200,200,200)
set object specular 2,rgb(250,250,250)
set object specular power 2,10
set object fog 2,0
set object collision on 2
set object collision to boxes 2

`reflection of computer paddle
clone object 304,2 `top
scale object 304,100,400,100
fade object 304,90
clone object 305,2 `bottom
scale object 305,100,400,100
fade object 305,90

`ball
make object sphere 3,20,40,40
texture object 3,101
set object specular 3,rgb(200,200,200)
set object specular power 3,15
set object emissive 3,rgb(150,150,100)
set object ambient 3,0
set object collision on 3
set object fog 3,0

`reflection of ball
clone object 300,3 `top reflection
fade object 300,50
clone object 301,3 `bottom reflection
fade object 301,50

`bottom wall
make object plain 4,500,800
xrotate object 4,90
set object collision on 4
texture object 4,2
scale object texture 4,5,5
set object transparency 4,1

`top wall
make object plain 5,500,800
xrotate object 5,90
set object collision on 5
texture object 5,2
scale object texture 5,5,5
set object transparency 5,1

`back wall
make object plain 6,500,100
texture object 6,101
scale object texture 6,2,10
set object texture 6,2,0
set object transparency 6,1
set object fog 6,0
ghost object on 6

`position walls
position object 4,0,-150,100
position object 5,0,150,100
position object 6,0,0,300

`restart point for new game (the goto command is not dead yet!)
newgame:
if newornot = 0
for object=300 to 305
hide object object
next object

`zoom in
paddlex#=0
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
position object 3,0,0,0


zrotate camera 0
camz#=-2000.0
camrl#=0
position camera 0,0,0,camz#
while camz#<-500.0
inc camz#,10
inc camrl#,.1589
roll camera right camrl#
position camera 0,0,camz#
sync
endwhile
position camera 0,0,0,-500

`set paddle positions

while paddlex#<180
inc paddlex#
position object 1,-paddlex#,0,0
position object 2,paddlex#,0,0
sync
endwhile

do
text screen width()/2-100,200,"Gravity on? [Y]es [N]o"
if inkey$()="y" then gravity=1:exit
if inkey$()="n" then gravity=0:exit
sync
loop

text screen width()/2-70,240,"GET READY!"
sync
wait 600

for object=300 to 305
show object object
next object

`set initial variables
level=1
pscore=0
cscore=0
pv#=10 `player paddle velocity
bvx#=10 `ball velocity
crntmscspd#=100
newornot=0
here1=1
here2=1
here3=1
here4=1
here5=1
here6=1
here7=1
if gravity=1
cv#=3.5 `computer paddle velocity
g#=0.5
else
cv#=2
g#=0
endif
endif

`restart point for new serve or new level
restart:
randomize timer()
wait 800
py#=-10+rnd(20) `player's initial y position
cy#=-10+rnd(20)           `computer's initial y position
bx#=0           `ball x
by#=0           `ball y
bvy#=1.5+rnd(10)/10          `ball direction (in degrees:- horizontal=0)
bvx#=abs(bvx#)
`main loop

do
set sound volume 1,80 : set sound volume 2,80
set music volume 1,100

`player input
remstart
if upkey()>0 and object collision (1,5)=0
   py#=py#+pv#
endif

if downkey()>0 and object collision (1,4)=0
   py#=py#-pv#
endif
remend


py#=py#-mousemovey()
if py#>110 then py#=110
if py#<-110 then py#=-110

`move player paddle
position object 1,-180,py#,100
position object 302,-180,-py#-300,100
position object 303,-180,-py#+300,100
`position object 401,-180,py#,100

`ball motion
bvy#=bvy#+g#
bx#=bx#+bvx#
by#=by#-bvy#

`collision with court
if by#>140
play sound 2
by#=by#-10
bvy#=bvy#*-1
endif

if by#<-140
play sound 2
by#=by#+10
bvy#=bvy#*-1
endif

`collision with player paddle
if object collision(3,0)=1
  play sound 1
  bvx#=bvx#*-1 `reverse velocity
  bx#=-150 `prevent embedding
`measure offset between player paddle and ball and adjust direction
    po#=by#-py#
    bvy#=bvy#-po#*0.15
Endif

`and same for computer paddle.....
If object collision(3,0) = 2
If object collision(3,0) = 2
play sound 1
bvx#=bvx#*-1
bx#=150
co#=by#-cy#
bvy#=bvy#-co#*0.15
Endif

if bvy#>15.0 then bvy#=15.0
if bvy#<-15.0 then bvy#=-15.0

`new ball position
position object 3,bx#,by#,100
position object 300,bx#,-by#+300,100
position object 301,bx#,-by#-300,100

`computer paddle A.I.

`return to middle
if bvx#<0
  if cy#>2 then a#=-cv#
  if cy#<2 then a#=cv#
  if cy#<=2 and cy#>=-2 then a#=0
  cy#=cy#+a#
endif

`move towards ball
if bvx#>0
  if by#>cy# then a#=cv#
  if by#<cy# then a#=-cv#
  cy#=cy#+a#
endif

position object 2,180,cy#,100
position object 304,180,-cy#+300,100
position object 305,180,-cy#-300,100

`win or lose
if object position x(3) < -250
   cscore=cscore+1
   vb#=vb#*-1
   goto restart
endif

if object position x(3) > 250
  pscore = pscore +1
  goto restart
endif

`print score
text screen width()/2-20,screen height()/2-12,str$(pscore)+" : "+str$(cscore)

`goto next level, increase difficulty and reset scores
if pscore>2
   crntmscspd#=crntmscspd#+10
   bv#=bv#+0.5
   pv#=pv#+0.3
   cv#=cv#+0.5
   level=level+1
   pscore=0
   cscore=0
   set music speed 2,crntmscspd#
   goto restart
endif

`display level
text screen width()/2-40,screen height()/2-100,"Level "+str$(level)


`game over text
if cscore>2
goto highscore
endif

if inkey$()="q" or inkey$()="Q"
level=0
cscore=0
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then delete sound 1
if sound exist(2) then delete sound 2
if music exist(1) then delete music 1
show mouse
ink 0,0
cls
goto Menu
endif

if level>4 and level<11
  `scroll textures
  scroll object texture 1000,0,-0.014
  scroll object texture 4,0,0.08
  scroll object texture 5,0,0.08

  if clockwise=1 then roll camera right 0.1
  if camera angle z()>30 then clockwise=0:turn camera left 0.1
  if clockwise=0 then roll camera left 0.1
  if camera angle z()<-30 then clockwise=1:turn camera right 0.1

else

 `scroll textures
  scroll object texture 1000,0,-0.004
  scroll object texture 4,0,0.004
  scroll object texture 5,0,0.004

endif

if level>10 and level<16
  `scroll textures
  scroll object texture 1000,0,-0.028
  scroll object texture 4,0,0.16
  scroll object texture 5,0,0.16

  if clockwise=1 then roll camera right 0.2
  if camera angle z()>30 then clockwise=0:turn camera left 0.2
  if clockwise=0 then roll camera left 0.2
  if camera angle z()<-30 then clockwise=1:turn camera right 0.2

endif

if level>14 and level<21
  `scroll textures
  scroll object texture 1000,0,-0.042
  scroll object texture 4,0,0.24
  scroll object texture 5,0,0.24

  if clockwise=1 then roll camera right 0.3
  if camera angle z()>30 then clockwise=0:turn camera left 0.3
  if clockwise=0 then roll camera left 0.3
  if camera angle z()<-30 then clockwise=1:turn camera right 0.3

endif

If here1=1
If level=3
set text font "sf automaton_mod"
ink rgb(0,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 1st opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here1=0
goto make
endif
endif

If here2=1
If level=5
set text font "sf automaton_mod"
ink rgb(255,0,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 2nd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here2=0
goto make
endif
endif

If here3=1
If level=7
set text font "sf automaton_mod"
ink rgb(0,255,0),0
set text size 25
do
text screen width()/2-300,200,"You have beat 3rd opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here3=0
goto make
endif
endif

If here4=1
If level=9
set text font "sf automaton_mod"
ink rgb(255,0,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 4th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here4=0
goto make
endif
endif

If here5=1
If level=11
set text font "sf automaton_mod"
ink rgb(255,110,11),0
set text size 25
do
text screen width()/2-300,200,"You have beat 5th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here5=0
goto make
endif
endif

If here6=1
If level=13
set text font "sf automaton_mod"
ink rgb(45,223,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 6th opponent would you like to continue? [Y]es [N]o"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here6=0
goto make
endif
endif

If here7=1
If level=15
set text font "sf automaton_mod"
ink rgb(255,255,255),0
set text size 25
do
text screen width()/2-300,200,"You have beat 7th opponent would you like to continue? [Y]es [N]o"
text screen width()/2-150,200,"<<This is your last opponent>>"
if inkey$()="n" then end
if inkey$()="y" then exit
if inkey$()="N" then end
if inkey$()="Y" then exit
sync
loop
for x = 1 to 1000
if object exist(x) then delete object x
next x
here7=0
goto make
endif
endif

sync
loop

highscore:
for p=0 to 9
if level>sco_score(p) or level=sco_score(p)`if score higher or the same
high_score=p+1                       `important counter for the writing of the high score list
gotscore=1
entry=1
clear entry buffer
exit
endif
next p

if gotscore=0
gotscore=2
endif

If gotscore=1
Ink RGB(255,140,243),0
repeat
text screen width()/2-100,screen height()/2-60,"ENTER HIGH SCORE"
new$=entry$()
for n=1 to len(new$)
if asc (mid$(new$,n))=8
line$=left$(line$,len(line$)-1) ` backspace in score entry
else
if len(line$)<10 then line$=line$+mid$(new$,n) `limit letters in entry to 9
endif
next n
clear entry buffer
center text screen width()/2,screen height()/2,line$ `displays what you enter
sync
until returnkey()=1
for b=9 to high_score-1 step -1
if b-1>0 or b-1=0`-----------action if array exist
sco_name$(b)=sco_name$(b-1)
sco_score(b)=sco_score(b-1)
endif
next b
sco_name$(high_score-1)=line$
sco_score(high_score-1)=level
high_score=0
`--------------------save score board to file
if file exist("scores.dat") then delete file "scores.dat"
open to write 1,"scores.dat"
for k=0 to 9
write string 1,sco_name$(k)
write file 1,sco_score(k)
next k
close file 1
level=0
cscore=0
sync
for x=1 to 1000
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
set music speed 2,100
show mouse
ink 0,0
cls
goto Menu
endif

If gotscore=2
set text font "sf automaton_mod"
ink rgb(0,200,0),0
Set text size 42
text screen width()/2-100,screen height()/2+200,"Game Over"
Set text size 22
text screen width()/2-130,screen height()/2+250,"(Press Any Key To Continue)"
sync
wait key
sync
ink rgb(0,0,255),0
level=0
cscore=0
for x=1 to 100
if object exist(x) then delete object x
if image exist(x) then delete image x
next x
if sound exist(1) then stop sound 1
if sound exist(2) then stop sound 2
if music exist(1) then stop music 1
if music exist(2) then stop music 2
set music speed 2,100
show mouse
ink 0,0
cls
Ink RGB(255,255,255),0
goto Menu
Endif

function over(but,x1,y1,x2,y2)
if mousex()>x1 and mousex()<X2
if mousey()>y1 and mousey()<Y2
over_area=1
endif
endif
endfunction over_area
function buttons()
if image exist(1)=0 then load image "button.bmp",1
if image exist(2)=0 then load image "buttonover.bmp",2
if over(1,screen width()/2-70,screen height()/2-200,screen width()/2+84,screen height()/2-158)=1
if mouseclick()=1
sync on
sync rate 50
autocam off
hide light 0
color backdrop rgb(0,0,0)
set ambient light 80
if light exist(1)=0 then make light 1
position light 1,100,100,20
set light range 1,100000
color light 1,rgb(255,220,180)
stop music 1
loop music 2
fog on
fog color 0
fog distance 850
hide mouse
goto make
endif
paste image 2,screen width()/2-70,screen height()/2-200
Ink 0,0
text screen width()/2-50,screen height()/2-195,"New Game"
else
paste image 1,screen width()/2-70,screen height()/2-200
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-195,"New Game"
endif

if over(1,screen width()/2-70,screen height()/2-150,screen width()/2+84,screen height()/2-108)=1
if mouseclick()=1 then scores()
paste image 2,screen width()/2-70,screen height()/2-150
Ink 0,0
text screen width()/2-50,screen height()/2-145,"Highscores"
else
paste image 1,screen width()/2-70,screen height()/2-150
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-145,"Highscores"
endif

if over(1,screen width()/2-70,screen height()/2-100,screen width()/2+84,screen height()/2-58)=1
if mouseclick()=1 then credits()
paste image 2,screen width()/2-70,screen height()/2-100
Ink 0,0
text screen width()/2-50,screen height()/2-95,"Credits"
else
paste image 1,screen width()/2-70,screen height()/2-100
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-95,"Credits"
endif

if over(1,screen width()/2-70,screen height()/2-50,screen width()/2+84,screen height()/2-8)=1
paste image 2,screen width()/2-70,screen height()/2-50
if mouseclick()=1
exit prompt "                                    Thanks For Playing","Tsunami Entertainment -- horlocker@yahoo.com"
end
endif
Ink 0,0
text screen width()/2-50,screen height()/2-45,"Exit"
else
paste image 1,screen width()/2-70,screen height()/2-50
Ink RGB(255,255,255),0
text screen width()/2-50,screen height()/2-45,"Exit"
endif
endfunction
Function background()
ink rgb(0,0,196),0
random# = rnd(1024)
random2# = rnd(768)
line random#,random#,random#+1,random2#
set text font "sf automaton_mod"
set text size 28
endfunction
Function initscores()
if file exist("scores.dat")=0
sco_name$(0)="Nick"
sco_score(0)=10
sco_name$(1)="Tera"
sco_score(1)=9
sco_name$(2)="The Queen"
sco_score(2)=8
sco_name$(3)="Pat"
sco_score(3)=7
sco_name$(4)="Thomas"
sco_score(4)=6
sco_name$(5)="Cody"
sco_score(5)=5
sco_name$(6)="Josh"
sco_score(6)=4
sco_name$(7)="Justin"
sco_score(7)=3
sco_name$(8)="Holly"
sco_score(8)=2
sco_name$(9)="James"
sco_score(9)=1
endif
if file exist("scores.dat")>0
open to read 1,"scores.dat"
for a=0 to 9
read string 1,sco_name$(a)
read file 1,sco_score(a)
next a
close file 1
endif
Endfunction
Function scores()
x=370
y=580
y2=380
crntcolor#=0
ink 0,0
box x,y2,x+370,y+10
ink rgb(248,217,1),0
y=380
for a=0 to 9
if a<9 then text x,y,"0"+str$(a+1)+". "+sco_name$(a)
if a<9 then text x+200,y,"................."+str$(sco_score(a))
if a=9 then text x,y,str$(a+1)+". "+sco_name$(a)
if a=9 then text x+200,y,"................."+str$(sco_score(a))
inc y,20
next a
set text font "sf automaton_mod"
sync
Endfunction
Function credits()
ink 0,0
box 370,380,740,590
ink rgb(248,217,1),0
center text 550,380,"[Producer]"
center text 550,410,"Nicholas"
center text 550,440,"[Special Thanks To]"
center text 550,470,"Ric"
center text 550,500,"[And]"
center text 550,530,"www.thegamecreators.com"
Endfunction
Function character()
if file exist("chara.dat")=0
  Ink RGB(0,0,255),0
  repeat
    text screen width()/2-100,screen height()/2-60,"ENTER YOUR NAME!"
    new$=entry$()
    for n=1 to len(new$)
      if asc (mid$(new$,n))=8
        line$=left$(line$,len(line$)-1) ` backspace in score entry
      else
        if len(line$)<11 then line$=line$+mid$(new$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line$ `displays what you enter
    sync
  until returnkey()=1
  user_name$(1)=line$
  user_paddle(1)=paddle
  if file exist("chara.dat") then delete file "chara.dat"
  open to write 2,"chara.dat"
  for k=0 to 5
    write string 2,user_name$(k)
    write file 2,user_paddle(k)
  next k
  close file 1
  if file exist("chara.dat")>0
    open to read 2,"chara.dat"
    for x=0 to 9
      read string 2,user_name$(x)
      read file 2,user_paddle(x)
    next x
    close file 2
  endif
endif
Endfunction
Function paddleclr()
color backdrop 0
crnty=190
crntx=300
ink rgb(255,255,255),0
box 0,0,40,1
get image 12,0,0,40,1
cls
for x=25 to 250 step 25
ink rgb(x,0,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,100
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,x,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,200
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,0,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,300
delete image x
next x
for x=25 to 250 step 25
ink rgb(x,0,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,400
delete image x
next x
for x=25 to 250 step 25
ink rgb(x,x,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,500
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,x,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,600
delete image x
next x
get image 11,0,100,500,600
cls
repeat
paste image 11,250,150
paste image 12,crntx,crnty
if rightkey()=1
if crntx<700 then crntx=crntx+50
sleep 100
cls
endif
if leftkey()=1
if crntx>300 then crntx=crntx-50
sleep 100
cls
endif
if downkey()=1
if crnty<590 then crnty=crnty+100
sleep 100
cls
endif
if upkey()=1
if crnty>190 then crnty=crnty-100
sleep 100
cls
endif
until returnkey()=1
crntx=crntx-300
crntx=crntx/50
delete image 11
delete image 12
cls
endfunction

Function character()
repeat
text screen width()/2-140,screen height()/2-80,"1-CREATE NEW ACCOUNT"
text screen width()/2-143,screen height()/2-60,"2-LOGIN EXISTING NAME"
input "",selection
until returnkey()=1
if selection=1
if file exist("chara.dat")=0
  Ink RGB(0,0,255),0
  repeat
    cls
    text screen width()/2-130,screen height()/2-60,"ENTER YOUR USERNAME"
    new$=entry$()
    for n=1 to len(new$)
      if asc (mid$(new$,n))=8
        line$=left$(line$,len(line$)-1) ` backspace in score entry
      else
        if len(line$)<11 then line$=line$+mid$(new$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line$ `displays what you enter
    sync
  until returnkey()=1
  line$=left$(line$,0)
  sleep 300
  cls
  repeat
    cls
    text screen width()/2-130,screen height()/2-60,"ENTER YOUR PASSWORD"
    new2$=entry$()
    for n=1 to len(new2$)
      if asc (mid$(new2$,n))=8
        line2$=left$(line2$,len(line2$)-1) ` backspace in score entry
      else
        if len(line2$)<11 then line2$=line2$+mid$(new2$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line2$ `displays what you enter
    sync
  until returnkey()=1
  line2$=left$(line2$,0)
  cls
  sleep 300
  user_name$()=line$
  user_pass$()=line2$
  user_paddley()=crnty
  user_paddlex()=crntx
  if file exist("chara.dat")
  open to write 3,"chara2.dat"
  for k=0 to 9
    write string 3,user_name$(k)
    write string 3,user_pass$(k)
    write file 3,user_paddley(k)
    write file 3,user_paddlex(k)
  next k
  close file 1
  else
  open to write 2,"chara.dat"
  for k=0 to 9
    write string 2,user_name$(k)
    write string 2,user_pass$(k)
    write file 2,user_paddley(k)
    write file 2,user_paddlex(k)
  next k
  close file 1
  endif
  if file exist("chara2.dat")
  open to write 4,"chara3.dat"
  for k=0 to 9
    write string 4,user_name$(k)
    write string 4,user_pass$(k)
    write file 4,user_paddley(k)
    write file 4,user_paddlex(k)
  next k
  close file 1
  endif
  if file exist("chara3.dat")
  open to write 5,"chara4.dat"
  for k=0 to 9
    write string 5,user_name$(k)
    write string 5,user_pass$(k)
    write file 5,user_paddley(k)
    write file 5,user_paddlex(k)
  next k
  close file 1
  endif
  if file exist("chara4.dat")
  open to write 6,"chara5.dat"
  for k=0 to 9
    write string 6,user_name$(k)
    write string 6,user_pass$(k)
    write file 6,user_paddley(k)
    write file 6,user_paddlex(k)
  next k
  close file 1
  endif
  endif
  endif

  repeat
    cls
    text screen width()/2-130,screen height()/2-60,"ENTER YOUR USERNAME"
    new$=entry$()
    for n=1 to len(new$)
      if asc (mid$(new$,n))=8
        line$=left$(line$,len(line$)-1) ` backspace in score entry
      else
        if len(line$)<11 then line$=line$+mid$(new$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line$ `displays what you enter
    sync
  until returnkey()=1
  line$=left$(line$,0)
  sleep 300
  cls
  repeat
    cls
    text screen width()/2-130,screen height()/2-60,"ENTER YOUR PASSWORD"
    new2$=entry$()
    for n=1 to len(new2$)
      if asc (mid$(new2$,n))=8
        line2$=left$(line2$,len(line2$)-1) ` backspace in score entry
      else
        if len(line2$)<11 then line2$=line2$+mid$(new2$,n) `limit letters in entry to 9
      endif
    next n
    clear entry buffer
    center text screen width()/2,screen height()/2,line2$ `displays what you enter
    sync
  until returnkey()=1
  line2$=left$(line2$,0)
  sleep 300
  cls
  here=0
  here1=0
  here2=0
  here3=0
  here4=0
  repeat
  if file exist("chara.dat")>0 and here=0
    open to read 2,"chara.dat"
    for x=0 to 9
      read string 2,user_name$(x)
      read string 2,user_pass$(x)
      read file 2,user_paddley(x)
      read file 2,user_paddlex(x)
    next x
    close file 2
    here=1
    goto again
  endif
  if file exist("chara2.dat")>0 and here1=0
    open to read 3,"chara2.dat"
    for x=0 to 9
      read string 3,user_name$(x)
      read string 3,user_pass$(x)
      read file 3,user_paddley(x)
      read file 3,user_paddlex(x)
    next x
    close file 3
    here1=1
    goto again
  endif
  if file exist("chara3.dat")>0 and here2=0
    open to read 4,"chara3.dat"
    for x=0 to 9
      read string 4,user_name$(x)
      read string 4,user_pass$(x)
      read file 4,user_paddley(x)
      read file 4,user_paddlex(x)
    next x
    close file 4
    here2=1
    goto again
  endif
  if file exist("chara4.dat")>0 and here3=0
    open to read 5,"chara4.dat"
    for x=0 to 9
      read string 5,user_name$(x)
      read string 5,user_pass$(x)
      read file 5,user_paddley(x)
      read file 5,user_paddlex(x)
    next x
    close file 5
    here3=1
    goto again
  endif
  if file exist("chara5.dat")>0 and here4=0
    open to read 6,"chara5.dat"
    for x=0 to 9
      read string 6,user_name$(x)
      read string 6,user_pass$(x)
      read file 6,user_paddley(x)
      read file 6,user_paddlex(x)
    next x
    close file 6
    here4=1
    goto again
    again:
  endif
  until line$=user_name$ and line2$=user_pass$ or done=1

  if line$=user_name$
  if line2$=user_pass$
  sleep 300
  else
  text screen width()/2-100,screen height()/2-60,"WRONG USERNAME OR PASSWORD"
  goto login
  wait key
  endif
  else
  text screen width()/2-100,screen height()/2-60,"WRONG USERNAME OR PASSWORD"
  goto login
  sleep 300
  wait key
  endif
Endfunction
Function paddleclr()
color backdrop 0
crnty=190
crntx=300
ink rgb(255,255,255),0
box 0,0,40,1
get image 12,0,0,40,1
cls
for x=25 to 250 step 25
ink rgb(x,0,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,100
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,x,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,200
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,0,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,300
delete image x
next x
for x=25 to 250 step 25
ink rgb(x,0,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,400
delete image x
next x
for x=25 to 250 step 25
ink rgb(x,x,0),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,500
delete image x
next x
for x=25 to 250 step 25
ink rgb(0,x,x),0
box 0,0,40,40
get image x/25,0,0,40,40
next x
for x=1 to 10
paste image x,x*50,600
delete image x
next x
get image 11,0,100,500,600
cls
repeat
paste image 11,250,150
paste image 12,crntx,crnty
if rightkey()=1
if crntx<700 then crntx=crntx+50 : play sound 3
sleep 100
cls
endif
if leftkey()=1
if crntx>300 then crntx=crntx-50 : play sound 3
sleep 100
cls
endif
if downkey()=1
if crnty<590 then crnty=crnty+100 : play sound 3
sleep 100
cls
endif
if upkey()=1
if crnty>190 then crnty=crnty-100 : play sound 3
sleep 100
cls
endif
until returnkey()=1
crntx=crntx-300
crntx=crntx/50
delete image 11
delete image 12
cls
endfunction