backdrop on
color backdrop 0
sync on
sync rate 60
autocam off
 
global top as integer
dim level(2000,5)
dim explode(3760)
flushlevel()
gosub makegraphics
ink rgb(255,255,255),0
 
start:
 
flushlevel()
 
clear entry buffer
 
do
 
text 5,5,"Fast Game"
text 5,30,"1) Level Editor"
text 5,45,"2) Play Game"
text 5,60,"3) Quit"
text 5,85,"Programmed by John Price"
 
if scancode() = 2 then gosub editor
if scancode() = 3 then gosub playgame
if scancode() = 4 then end
 
sync
 
loop
 
editor:
 
flushlevel()
 
getfileinfo:
msg$ = ""
clear entry buffer
do
 
text 5,5,"Enter level number: "+msg$
text 5,30,"note: levels 1 to 5 are the packaged levels and cannot be edited"
if returnkey() = 1 then exit
if entry$() <> "" then msg$ = msg$ + entry$()
w = w - 1
if scancode() = 14 and w < 0 then msg$ = left$(msg$,len(msg$)-1) : w = 3
clear entry buffer
 
sync
 
loop
 
lvn = val(msg$)
if lvn < 1 then GOTO GETFILEINFO
if lvn < 6 then goto getfileinfo
lv$ = str$(lvn)+".lev"
 
if file exist(lv$) = 1
do
text 5,5,"Level "+str$(lvn)+" Exists!"
text 5,30,"Press 1 to Load"
text 5,45,"Press 9 to Delete"
if scancode() = 2 then gosub loadlevel : exit
if scancode() = 10 then delete file lv$ : goto getfileinfo
sync
loop
endif
 
ex# = 0
ez# = 0
typ = 3
wai = 0
 
make object box 3001,10,10,10 : offset limb 3001,0,0,5,0
make object box 3002,10,2,10 : offset limb 3002,0,0,1,0
make object sphere 3003,3 : offset limb 3003,0,0,5,0
make object box 3004,5,5,5 : offset limb 3004,0,0,4.5,0 : color object 3004,rgb(255,0,0)
make object box 3005,5,5,5 : offset limb 3005,0,0,4.5,0
make object cube 3006,3 : offset limb 3006,0,0,5,0
 make object box 3007,10,10,10 : offset limb 3007,0,0,5,0 : color object 3007,rgb(64,64,64)
do
 
text 5,5,"1 - 7"
text 5,20,"SPACE"
text 5,35,"RETURN"
text 5,50,"SHIFT"
text 5,65,"BACKSPACE"
text 150,5,"Pick Object"
text 150,20,"Place Object"
text 150,35,"Save Level"
text 150,50,"Delete Object"
text 150,65,"Quit To Main Menu"
select typ
 case 1 : text 5,480-30,"Wall" : endcase
 case 2 : text 5,480-30,"Floor" : endcase
 case 3 : text 5,480-30,"Pickup" : endcase
 case 4 : text 5,480-30,"Enemy" : endcase
 case 5 : text 5,480-30,"Start" : endcase
 case 6 : text 5,480-30,"Key" : endcase
 case 7 : text 5,480-30,"Door" : endcase
endselect
text 5,480-45,str$(ex#)+", "+str$(ez#)
 
for st = 1 to 7
hide object st+3000
position object st+3000,ex#,0,ez#
if typ = st then show object st+3000
next st
if scancode()-1 > 0 and scancode()-1 < 8 then typ = scancode()-1
 
if scancode() = 14
for cle = 3001 to 3007
delete object cle
next cle
flushlevel()
goto start
endif
 
wai = wai - 1
if upkey() = 1 and wai < 0 then ez# = ez# + 10 : wai = 10
if downkey() = 1 and wai < 0 then ez# = ez# - 10 : wai = 10
if leftkey() = 1 and wai < 0 then ex# = ex# - 10 : wai = 10
if rightkey() = 1 and wai < 0 then ex# = ex# + 10 : wai = 10
 
if shiftkey() = 1 and wai < 0
wai = 10
for co = 1 to top
if ex# = level(co,1) and ez# = level(co,2)
delete object co
level(co,1) = 0:level(co,2) = 0:level(co,3) = 0
endif
next co
endif
 
if spacekey() = 1 and wai < 0
wai = 10
top = top + 1
select typ
      case 1 : make object box top,10,10,10 : offset limb top,0,0,5,0 : endcase
      case 2 : make object box top,10,2,10 : offset limb top,0,0,1,0 : endcase
      case 3 : make object sphere top,3 : offset limb top,0,0,5,0 : endcase
      case 4 : make object box top,5,5,5 : offset limb top,0,0,4.5,0 : color object top,rgb(255,0,0) : endcase
      case 5 : make object box top,5,5,5 : offset limb top,0,0,4.5,0 : endcase
      case 6 : make object cube top,3 : offset limb top,0,0,5,0 : endcase
      case 7 : make object box top,10,10,10 : offset limb top,0,0,5,0 : color object top,rgb(64,64,64) : endcase
      endselect
position object top,ex#,0,ez#
level(top,1) = ex#
level(top,2) = ez#
level(top,3) = typ
endif
 
if returnkey() = 1 then gosub savelevel
 
position camera ex#,30,ez#-40
point camera ex#,0,ez#
 
sync
 
loop
 
return
 
playgame:
 
picklevel:
clear entry buffer
do
 
text 5,5,"Enter level number: "+msg$
text 5,30,"Levels 1 to 5 are the packaged levels"
if returnkey() = 1 then exit
if entry$() <> "" then msg$ = msg$ + entry$()
w = w - 1
if scancode() = 14 and w < 0 then msg$ = left$(msg$,len(msg$)-1) : w = 3
clear entry buffer
 
sync
 
loop
 
 
lvn = val(msg$)
lv$ = str$(lvn)+".lev"
if file exist(lv$) = 0 or lvn < 0 then goto picklevel
 
gosub loadlevel
 
make object box 3205,1,1.5,6
offset limb 3205,0,0,0,-2
make mesh from object 5,3205
delete object 3205
 
make object plain 3205,5,5
offset limb 3205,0,0,4.5,2.7
make mesh from object 6,3205
delete object 3205
 
for fps = 1 to top
   select level(fps,3)
 
   case 3
      ptc = ptc + 1
      color object fps,rgb(0,128,255)
      set alpha mapping on fps,60
   endcase
 
   case 4
 
      ADD LIMB fps,1,5 : offset limb fps,1,3,5,0 : color limb fps,1,rgb(255,255,0)
      ADD LIMB fps,2,5 : offset limb fps,2,-3,5,0 : color limb fps,2,rgb(255,255,0)
      ADD LIMB fps,3,6 : texture limb fps,3,2
      set object cull fps,0
      yrotate object fps,180
      fix object pivot fps
 
   endcase
 
   case 5
      px# = level(fps,1) : pz# = level(fps,2)
      delete object fps
      level(fps,1) = 0:level(fps,2) = 0:level(fps,3) = 0
   endcase
 
   endselect
next fps
 
make object box 3200,4,2,4
offset limb 3200,0,0,5.5,0
position object 3200,px#,0,pz#
color object 3200,rgb(255,0,0)
make object box 3201,1,4.5,1.5
offset limb 3201,0,0,-1.9,0
make mesh from object 1,3201
delete object 3201
add limb 3200,1,1:offset limb 3200,1,2.5,5.3,0:color limb 3200,1,rgb(0,255,0)
add limb 3200,2,1:offset limb 3200,2,-2.5,5.3,0:color limb 3200,2,rgb(0,255,0)
make object plain 3205,4,2
offset limb 3205,0,0,5.5,-2.025
make mesh from object 7,3205
delete object 3205
add limb 3200,3,7
set object cull 3200,0
texture limb 3200,3,3
 
health = 100
keys = 0
tt = timer()
time = 0
pa# = 0
 
do
 
if timer() => tt+1000
tt = timer()
time = time + 1
endif
 
text 5,5,"Health:"
text 5,25,"Gems:"
text 5,45,"Keys:"
text 5,65,"Time:"
text 150,5,str$(health)+"%"
text 150,25,str$(pig)+" / "+str$(ptc)
text 150,45,str$(keys)
text 150,65,str$(time)+" seconds"
 
if health <= 0
goto youdied
endif
 
if pig = ptc
goto youwon
endif
 
ox# = px#
oz# = pz#
if upkey() = 1 then px# = newxvalue(px#,pa#,.55) : pz# = newzvalue(pz#,pa#,.55) :  pan = pan + 7
pana# = sin(pan)*20
rotate limb 3200,1,pana#,0,0
rotate limb 3200,2,0-pana#,0,0
if leftkey() = 1 then pa# = pa# - 4.5
if rightkey() = 1 then pa# = pa# + 4.5
pa# = wrapvalue(pa#)
ear = ear + 5
ea# = sin(ear)*8
 
sw = sw - 1
if controlkey() = 1 and sw < 0
sw = 10
 
   for mb = 0 to 1
   for sfb = 3500 to 3540
      if object exist(sfb) = 0 then exit
   next sfb
   make object cylinder sfb,2
   color object sfb,rgb(128,128,0)
   scale object sfb,30,100,30
   set object cull sfb,0
   yrotate object sfb,pa#
   xrotate object sfb,90
   position object sfb,newxvalue(px#,wrapvalue(wrapvalue((pa#-30)+(60*mb))),3),4.5,newzvalue(pz#,wrapvalue(wrapvalue((pa#-30)+(60*mb))),3)
   next mb
 
endif
 
for cbc = 3500 to 3540
 
   if object exist(cbc) = 1
   position object cbc,newxvalue(object position x(cbc),object angle y(cbc),4),4.5,newzvalue(object position z(cbc),object angle y(cbc),4)
 
      for cbo = 1 to top
      select level(cbo,3)
 
         case 1
         if object position x(cbc) > level(cbo,1) - 6 and object position x(cbc) < level(cbo,1) + 6 and object position z(cbc) > level(cbo,2) - 6 and object position z(cbc) < level(cbo,2) + 6
            delete object cbc
            exit
         endif
         endcase
 
         case 4
 
         if object position x(cbc) > level(cbo,1) - 3 and object position x(cbc) < level(cbo,1) + 3 and object position z(cbc) > level(cbo,2) - 3 and object position z(cbc) < level(cbo,2) + 3
            delete object cbc
            LEVEL(cbo,4) = level(cbo,4) + 1
            exit
         endif
 
         endcase
 
      endselect
      next cbo
 
   endif
 
next cbc
 
for cex = 3750 to 3760
   if object exist(cex) = 1
      scale object cex, explode(cex), explode(cex), explode(cex)
      set alpha mapping on cex, 100-explode(cex)
         explode(cex) = explode(cex) + 10
      if explode(cex) > 100 then delete object cex
   endif
next cex
 
for cec = 3600 to 3700
 
   if object exist(cec) = 1
 
   position object cec,newxvalue(object position x(cec),object angle y(cec),3),object position y(cec),newzvalue(object position z(cec),object angle y(cec),3)
 
   if sqrt((px#-object position x(cec))^2+(pz#-object position z(cec))^2) < 2.5
 
      health = health - 5
      delete object cec
      exit
 
   endif
 
      for cbo = 1 to top
      select level(cbo,3)
 
         case 1
         if object position x(cec) > level(cbo,1) - 6 and object position x(cec) < level(cbo,1) + 6 and object position z(cec) > level(cbo,2) - 6 and object position z(cec) < level(cbo,2) + 6
            delete object cec
            exit
         endif
         endcase
 
         case 4
         if object position x(cec) > level(cbo,1) - 3 and object position x(cec) < level(cbo,1) + 3 and object position z(cec) > level(cbo,2) - 3 and object position z(cec) < level(cbo,2) + 3
            delete object cec
            exit
         endif
         endcase
 
      endselect
      next cbo
 
   endif
 
next cec
 
 
for cpc = 1 to top
 
   select level(cpc,3)
 
   case 1
   if px# > level(cpc,1) - 9 and px# < level(cpc,1) + 9 and pz# > level(cpc,2) - 9 and pz# < level(cpc,2) + 9
      if ox# > level(cpc,1) - 9 and ox# < level(cpc,1) + 9 and pz# > level(cpc,2) - 9 and pz# < level(cpc,2) + 9 then pz# = oz#
      if px# > level(cpc,1) - 9 and px# < level(cpc,1) + 9 and oz# > level(cpc,2) - 9 and oz# < level(cpc,2) + 9 then px# = ox#
   endif
   endcase
 
   case 7
   if px# > level(cpc,1) - 9 and px# < level(cpc,1) + 9 and pz# > level(cpc,2) - 9 and pz# < level(cpc,2) + 9
      if ox# > level(cpc,1) - 9 and ox# < level(cpc,1) + 9 and pz# > level(cpc,2) - 9 and pz# < level(cpc,2) + 9 then pz# = oz#
      if px# > level(cpc,1) - 9 and px# < level(cpc,1) + 9 and oz# > level(cpc,2) - 9 and oz# < level(cpc,2) + 9 then px# = ox#
 
   if keys > 0
   keys = keys - 1
 
      for ffe = 3750 to 3760
      if object exist(ffe) = 0
      make object sphere ffe,10
      position object ffe,level(cpc,1),4.5,level(cpc,2)
      color object ffe,rgb(255,255,0)
      explode(ffe) = 0
      exit
      endif
      next ffe
 
   level(cpc,1) = 0 : level(cpc,2) = 0 : level(cpc,3) = 0
   delete object cpc
   else
   center text 320,240,"You Will Need A Key To Pass!"
   endif
 
   endif
   endcase
 
   case 3
   if px# > level(cpc,1) - 5 and px# < level(cpc,1) + 5 and pz# > level(cpc,2) - 5 and pz# < level(cpc,2) + 5
      level(cpc,1) = 0 : level(cpc,2) = 0 : level(cpc,3) = 0
      delete object cpc
      pig = pig + 1
   endif
   endcase
 
   case 6
   if px# > level(cpc,1) - 5 and px# < level(cpc,1) + 5 and pz# > level(cpc,2) - 5 and pz# < level(cpc,2) + 5
      keys = keys + 1
      level(cpc,1) = 0 : level(cpc,2) = 0 : level(cpc,3) = 0
      delete object cpc
   endif
   endcase
 
   case 4
 
   oex# = level(cpc,1)
   oez# = level(cpc,2)
   nex# = object position x(cpc)
   nez# = object position z(cpc)
   yrotate object cpc, wrapvalue(atanfull(nex#-px#,nez#-pz#)+180)
 
   if sqrt((px#-nex#)^2+(pz#-nez#)^2) < 60
 
   level(cpc,5) = level(cpc,5) - 1
   if level(cpc,5) < 0 and object in screen(cpc)
   level(cpc,5) = 100
      for fff = 3600 to 3700
      if object exist(fff) = 0 then exit
      next fff
      make object sphere fff,3
      position object fff,newxvalue(level(cpc,1), object angle y(cpc), 3),2.5,newzvalue(level(cpc,2), object angle y(cpc), 3)
      yrotate object fff,object angle y(cpc)
      color object fff,rgb(255,128,64)
   endif
 
   nex# = newxvalue(object position x(cpc),object angle y(cpc),.15)
   nez# = newzvalue(object position z(cpc),object angle y(cpc),.15)
 
   endif
 
 
    for cec = 1 to top
    if cec <> cpc
      select level(cec,3)
 
         case 1
         if nex# > level(cec,1) - 10 and nex# < level(cec,1) + 10 and nez# > level(cec,2) - 10 and nez# < level(cec,2) + 10
         if oex# > level(cec,1) - 10 and oex# < level(cec,1) + 10 and nez# > level(cec,2) - 10 and nez# < level(cec,2) + 10 then nez# = oez#
         if nex# > level(cec,1) - 10 and nex# < level(cec,1) + 10 and oez# > level(cec,2) - 10 and oez# < level(cec,2) + 10 then nex# = oex#
         endif
         endcase
 
         case 7
         if nex# > level(cec,1) - 10 and nex# < level(cec,1) + 10 and nez# > level(cec,2) - 10 and nez# < level(cec,2) + 10
         if oex# > level(cec,1) - 10 and oex# < level(cec,1) + 10 and nez# > level(cec,2) - 10 and nez# < level(cec,2) + 10 then nez# = oez#
         if nex# > level(cec,1) - 10 and nex# < level(cec,1) + 10 and oez# > level(cec,2) - 10 and oez# < level(cec,2) + 10 then nex# = oex#
         endif
         endcase
 
         case 4
         if nex# > level(cec,1) - 7 and nex# < level(cec,1) + 7 and nez# > level(cec,2) - 7 and nez# < level(cec,2) + 7
         if oex# > level(cec,1) - 7 and oex# < level(cec,1) + 7 and nez# > level(cec,2) - 7 and nez# < level(cec,2) + 7 then nez# = oez#
         if nex# > level(cec,1) - 7 and nex# < level(cec,1) + 7 and oez# > level(cec,2) - 7 and oez# < level(cec,2) + 7 then nex# = oex#
         endif
         endcase
 
      endselect
    endif
    next cec
 
   if px# > nex# - 7 and px# < nex# + 7 and pz# > nez# - 7 and pz# < nez# + 7
      nex# = oex#
      nez# = oez#
      if ox# > nex# - 7 and ox# < nex# + 7 and pz# > nez# - 7 and pz# < nez# + 7 then pz# = oz#
      if px# > nex# - 7 and px# < nex# + 7 and oz# > nez# - 7 and oz# < nez# + 7 then px# = ox#
   endif
   rotate limb cpc,1,ea#,0,0
   rotate limb cpc,2,ea#,0,0
   position object cpc,nex#,0,nez#
   level(cpc,1) = nex#
   level(cpc,2) = nez#
   if level(cpc,4) > 3
 
      for ffe = 3750 to 3760
      if object exist(ffe) = 0
      make object sphere ffe,5
      position object ffe,level(cpc,1),4.5,level(cpc,2)
      color object ffe,rgb(255,255,0)
      explode(ffe) = 0
      exit
      endif
      next ffe
 
      level(cpc,1) = 0 : level(cpc,2) = 0 : level(cpc,3) = 0
      delete object cpc
   endif
 
   endcase
 
   endselect
 
next cpc
 
position object 3200,px#,0,pz#
yrotate object 3200,pa#
set camera to follow px#,0,pz#,0,30,25,5,0
point camera px#,2,pz#
 
sync
 
loop
 
return
 
savelevel:
 
if file exist(lv$) = 1 then delete file lv$
open to write 1,lv$
 
   write file 1,top
   for wd = 1 to top
   write file 1,level(wd,1)
   write file 1,level(wd,2)
   write file 1,level(wd,3)
   next wd
 
close file 1
 
return
 
loadlevel:
open to read 1,lv$
 
   read file 1,top
   for rd = 1 to top
   read file 1,level(rd,1)
   read file 1,level(rd,2)
   read file 1,level(rd,3)
 
   if level(rd,3) > 0
      select level(rd,3)
      case 1 : make object box rd,10,10,10 : offset limb rd,0,0,5,0 : color object rd,rgb(0,64,0) : endcase
      case 2 : make object box rd,10,2,10 : offset limb rd,0,0,1,0 : color object rd,rgb(0,0,64) : endcase
      case 3 : make object sphere rd,3 : offset limb rd,0,0,5,0 : endcase
      case 4 : make object box rd,5,5,5 : offset limb rd,0,0,4.5,0 : color object rd,rgb(255,0,0) : endcase
      case 5 : make object box rd,5,5,5 : offset limb rd,0,0,4.5,0 : endcase
      case 6 : make object cube rd,3 : offset limb rd,0,0,5,0 : color object rd,rgb(64,64,64) : endcase
      case 7 : make object box rd,10,10,10 : offset limb rd,0,0,5,0 : color object rd,rgb(64,64,64) : endcase
      endselect
      position object rd,level(rd,1),0,level(rd,2)
   endif
 
   next rd
 
close file 1
return
 
makegraphics:
 
create bitmap 1,128,128
ink rgb(255,0,0),0
box 0,0,128,128
ink rgb(255,255,255),0
box 20,20,53,53
box 80,20,112,53
ink 0,0
box 28,33,42,49
box 88,33,103,49
ink rgb(255,128,64),0
box 16,68,116,106
get image 2,0,0,128,128
delete bitmap 1
 
create bitmap 1,128,64
ink rgb(255,0,0),0
box 0,0,128,128
ink rgb(255,255,255),0
box 20,20,53,53
box 80,20,112,53
ink 0,0
box 28,33,42,49
box 88,33,103,49
get image 3,0,0,128,64
delete bitmap 1
 
return
 
youdied:
do
 
center text 320,100,"The Evil Robots Got You!"
center text 320,140,"Press Space To Return To The Main Menu"
 
if spacekey() = 1 then exit
 
sync
loop
goto start
 
youwon:
do
 
center text 320,100,"Well Done!"
center text 320,120,"You Passed The Level In "+str$(time)+" Seconds!!"
 
center text 320,160,"Press Space To Return To The Main Menu"
 
if spacekey() = 1 then exit
 
sync
loop
goto start
 
function flushlevel()
 
for dos = 3500 to 3540
if object exist(dos) = 1 then delete object dos
next dos
for dos = 3600 to 3700
if object exist(dos) = 1 then delete object dos
next dos
 
if object exist(3200) then delete object 3200
 
for fl = 1 to top
for fa = 1 to 5
if level(fl,fa) > 0 then delete object fl
level(fl,fa) = 0
next fa
next fl
top = 0
 
endfunction