A level editor I worked on for some time. Right now, it's on hold until further notice. Enjoy!

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    sync on
sync rate 0
set display mode 800,600,32
make camera 1
set current camera 1
autocam off
randomize timer()
dim todo$(1)
dim junk$(10)
dim junk(10)
dim foundfilesforload$(1024)
dim currentpart(1)=0
dim totalparts(1)=0
dim maxparts(1)=0
dim partnames$(5000)
dim parttype(5000)
dim partscalex(5000)
dim partscaley(5000)
dim partscalez(5000)
dim parttexture$(5000)
dim parttexturescalex(5000)
dim parttexturescaley(5000)
dim parttexturescrollx(5000)
dim parttexturescrolly(5000)
dim allparts(5000)
dim foundtexturesforload$(1024)
dim currenttexture$(1)
dim currenttexture(1)
dim maxtextures(1)
dim viewmode(1)
dim menu$(10,10)
dim menualign(10)
dim dirjunk$(10)
dim actorjunk$(10)
dim actorjunk(10)
dim mousemove_x(1)
dim mousemove_y(1)
dim grid(1)=0
dim quitt(1)=0
dim copy$(10)
dim currentlight(1)
dim lights(8)
dim lightsx(8)
dim lightsy(8)
dim lightsz(8)
dim lightsrx(8)
dim lightsry(8)
dim lightsrz(8)
dim lightsflags(8)
dim lightscolor(7,3)
dim lightsavailable(7)

begin:

dirjunk$(1)=get dir$()
dirjunk$(2)=dirjunk$(1)+"\models"
dirjunk$(3)=dirjunk$(1)+"\textures"
dirjunk$(4)=dirjunk$(1)+"\maps"

startup()

settings("StudioSettings.ini")

do
   if mousey()<25 then filemenu()
   if todo$(1)<>"" then dothis(todo$(1))
   onscreentext()
   checkforinput()
   if quitt(1)=1 then exit
loop

rem -------------------------------------------------------------------------
function checkforinput()
cx#=camera angle x(1)
cy#=camera angle y(1)
mousemove_y(1)=mousemovex()
mousemove_x(1)=mousemovey()
if totalparts(1)>0
   if scancode()=46 then makecollisionpart()
   if scancode()=48 then makestaticbox()
   if scancode()=20 then changecurrtexture()
   if scancode()=51 then prevpart():unsleep(50)
   if scancode()=52 then nextpart():unsleep(50)
   if scancode()=61 then savemap():unsleep(500)
   if scancode()=47 then changeviewmode()
endif
select scancode()
case 38
shadowon():unsleep(500)
endcase
case 34
grid(1)=grid(1)+1
if grid(1)>2 then grid(1)=0
unsleep(200)
endcase
case 17
 move camera .25
endcase
case 31
 move camera -.25
endcase
case 45
if totalparts(1)>0
   if mouseclick()=1 then movepartx()
   if mouseclick()=2 then rotatepartx()
   if mouseclick()=3 then scalepartx()
endif
endcase
case 44
if totalparts(1)>0
   if mouseclick()=1 then movepartz()
   if mouseclick()=2 then rotatepartz()
   if mouseclick()=3 then scalepartz()
endif
endcase
case 21
if totalparts(1)>0
   if mouseclick()=1 then moveparty()
   if mouseclick()=2 then rotateparty()
   if mouseclick()=3 then scaleparty()
endif
endcase
case 19
if totalparts(1)>0
   if mouseclick()=1 then scaletexture()
   if mouseclick()=2 then scrolltexture()
endif
endcase
endselect
if scancode()=211 and totalparts(1)>1 then removepart(allparts(currentpart(1)))
if mouseclick()=4 or scancode()=57
if mousemove_x(1)<>0 then cx#=wrapvalue(cx#+mousemove_x(1))
xrotate camera 1, cx#
if mousemove_y(1)<>0 then cy#=wrapvalue(cy#+mousemove_y(1))
yrotate camera 1, cy#
endif
endfunction

rem -------------------------------------------------------------------------
function changeviewmode()
if viewmode(1)=1
viewmode(1)=2:goto exit020
endif
if viewmode(1)=2
viewmode(1)=3:goto exit020
endif
if viewmode(1)=3
if object exist(allparts(currentpart(1))) then set object allparts(currentpart(1)),1,1,1
viewmode(1)=4:goto exit020
endif
if viewmode(1)=4
if object exist(allparts(currentpart(1))) then set object allparts(currentpart(1)),0,1,1
viewmode(1)=1:goto exit020
endif
exit020:
colorparts()
unsleep(100)
endfunction

rem -------------------------------------------------------------------------
function addpart(parttype)
if totalparts(1)=maxparts(1) then todo$(1)="":exitfunction
if currentpart(1)<=1 then currentpart(1)=1
partname$=junk$(1):partnumber=findavailablepartnumber()
select parttype
case 0
   exitfunction
endcase
case 1
   type$=".x":partname$=getfileforload(dirjunk$(2),type$):load object partname$,partnumber:partnames$(partnumber)=partname$
endcase
case 2
   type$=".3ds":partname$=getfileforload(dirjunk$(2),type$):load object partname$,partnumber:partnames$(partnumber)=partname$
endcase
case 3
   make object sphere partnumber,25:partnames$(partnumber)="Sphere"
endcase
case 4
   make object box partnumber,25,25,25:partnames$(partnumber)="Box"
endcase
case 5
   make object cylinder partnumber,25:partnames$(partnumber)="Cylinder"
endcase
case 6
   make object cone partnumber,25:partnames$(partnumber)="Cone"
endcase
case 7
   make object plain partnumber,25,25:partnames$(partnumber)="Plane"
endcase
case 8
   make object triangle partnumber,0,0,0,25,25,0,25,0,25:partnames$(partnumber)="Triangle"
endcase
case 9
   make object sphere partnumber,5:partnames$(partnumber)="Light"
   makelights()
endcase
endselect
parttype(partnumber)=1
findallparts():colorparts()
todo$(1)="":
if totalparts(1)=1 then currentpart(1)=1:findallparts():colorparts()
endfunction

function findallparts()
for c=1 to 5000
   allparts(c)=0
next c
partnum=1
totalparts(1)=0
for p=1 to 5000
   if object exist(p)=1
      allparts(partnum)=p
      totalparts(1)=totalparts(1)+1
      partnum=partnum+1
      currentpart(1)=allparts(p)
   endif
next p
endfunction

function findavailablepartnumber()
napn=0
for o=1 to maxparts(1)
   if object exist(o)=0 then napn=o:goto exit45678
next o
exit45678:
endfunction napn

function removepart(partnumber)
if partnumber<1 or partnumber>5000 then exitfunction
findallparts()
if object exist(partnumber)=1 then delete object partnumber
for l=1 to 7
 if lights(l)=partnumber then delete light l
next l
if totalparts(1)>0
   for tp=1 to 5000
      if object exist(tp)=1 then currentpart(1)=allparts(tp)
   next tp
endif
findallparts():colorparts()
unsleep(250)
endfunction

function nextpart()
if totalparts(1)>0
   if currentpart(1)<totalparts(1) then currentpart(1)=currentpart(1)+1
   for l=1 to 7
    if currentpart(1)=lights(l) then currentlight(1)=l
   next l
endif
colorparts()
endfunction

function prevpart()
if totalparts(1)>0
   if currentpart(1)>1 then currentpart(1)=currentpart(1)-1
     for l=1 to 7
        if currentpart(1)=lights(l) then currentlight(1)=l
     next l
endif
colorparts()
endfunction

function colorparts()
if totalparts(1)>1
select viewmode(1)
case 1
   for p=1 to totalparts(1)
      if object exist(allparts(p))
         set object allparts(p),1,1,1
         ghost object on allparts(p)
      endif
   next p
   if object exist(currentpart(1))=1
      ghost object off (allparts(currentpart(1)))
   endif
endcase
case 2
   for p=1 to totalparts(1)
      if object exist(allparts(p))=1
         set object allparts(p),1,1,1
         ghost object off allparts(p)
      endif
   next p
   if currentpart(1)>0
      if object exist(allparts(currentpart(1)))=1 then ghost object on (allparts(currentpart(1)))
   endif
endcase
case 3
   for p=1 to totalparts(1)
      if object exist(allparts(p))=1 then set object allparts(p),1,1,1
   next p
   if currentpart(1)>0
      if object exist(allparts(currentpart(1)))=1 then set object allparts(currentpart(1)),0,1,1
   endif
endcase
case 4
   for p=1 to totalparts(1)
      if object exist(allparts(p))=1 then set object allparts(p),0,1,1
   next p
   if currentpart(1)>0
      if object exist(allparts(currentpart(1)))=1 then set object allparts(currentpart(1)),1,1,1
   endif
endcase
endselect
endif
endfunction

function dothis(todo$)
select todo$
case "addx"
addpart(1)
endcase
case "add3ds"
addpart(2)
endcase
case "addsphere"
addpart(3)
endcase
case "addbox"
addpart(4)
endcase
case "addcylinder"
addpart(5)
endcase
case "addcone"
addpart(6)
endcase
case "addplane"
addpart(7)
endcase
case "addtriangle"
addpart(8)
endcase
case "addlight"
addpart(9)
endcase
case "applycurrenttexture"
applytexture()
endcase
case "save"
savemap()
endcase
case "open"
type$=".tld"
filename$=getfileforload(dirjunk$(4),type$)
loadmap(filename$)
endcase
case "new"
resetall()
endcase
case "exit"
quit()
endcase
endselect
endfunction

function movepartx()
while mouseclick()=1
onscreentext()
if object exist(currentpart(1))=1 then position object currentpart(1), object position x(currentpart(1))+mousemovex(),object position y(currentpart(1)),object position z(currentpart(1))
if partnames$(currentpart(1))="Light" then repositionlight()
endwhile
endfunction

function moveparty()
while mouseclick()=1
onscreentext()
if object exist(currentpart(1))=1 then position object currentpart(1), object position x(currentpart(1)),object position y(currentpart(1))+mousemovex(),object position z(currentpart(1))
if partnames$(currentpart(1))="Light" then repositionlight()
endwhile
endfunction

function movepartz()
while mouseclick()=1
onscreentext()
if object exist(currentpart(1))=1 then position object currentpart(1), object position x(currentpart(1)),object position y(currentpart(1)),object position z(currentpart(1))+mousemovex()
if partnames$(currentpart(1))="Light" then repositionlight()
endwhile
endfunction

function rotatepartx()
while mouseclick()=2
onscreentext()
if object exist(currentpart(1))=1 then rotate object currentpart(1), wrapvalue(object angle x(currentpart(1))+mousemovex()),object angle y(currentpart(1)),object angle z(currentpart(1))
endwhile
endfunction

function rotateparty()
while mouseclick()=2
onscreentext()
if object exist(currentpart(1))=1 then rotate object currentpart(1), object angle x(currentpart(1)),wrapvalue(object angle y(currentpart(1))+mousemovex()),object angle z(currentpart(1))
endwhile
endfunction

function rotatepartz()
while mouseclick()=2
onscreentext()
if object exist(currentpart(1))=1 then rotate object currentpart(1), object angle x(currentpart(1)),object angle y(currentpart(1)),wrapvalue(object angle z(currentpart(1))+mousemovex()):onscreentext()
endwhile
endfunction

function scalepartx()
if object exist(currentpart(1))=1
   s=partscalex(allparts(currentpart(1)))
   onscreentext()
   if s>1 and mousemove_y(1)<0
      scale object currentpart(1),s,partscaley(allparts(currentpart(1))),partscalez(allparts(currentpart(1))):s=s-2
      if s<1 then s=1
      partscalex(allparts(currentpart(1)))=s
   endif
   if s<10000 and mousemove_y(1)>0
      scale object currentpart(1),s,partscaley(allparts(currentpart(1))),partscalez(allparts(currentpart(1))):s=s+2
      if s>10000 then s=10000
      partscalex(allparts(currentpart(1)))=s
   endif
endif
endfunction

function scaleparty()
if object exist(currentpart(1))=1
   s=partscaley(allparts(currentpart(1)))
   onscreentext()
   if s>1 and mousemove_y(1)<0
      scale object currentpart(1),partscalex(allparts(currentpart(1))),s,partscalez(allparts(currentpart(1))):s=s-2
      if s<1 then s=1
      partscaley(allparts(currentpart(1)))=s
   endif
   if s<10000 and mousemove_y(1)>0
      scale object currentpart(1),partscalex(allparts(currentpart(1))),s,partscalez(allparts(currentpart(1))):s=s+2
      if s>10000 then s=10000
      partscaley(allparts(currentpart(1)))=s
   endif
endif
endfunction

function scalepartz()
if object exist(currentpart(1))=1
   s=partscalez(allparts(currentpart(1)))
   onscreentext()
   if s>1 and mousemove_y(1)<0
      scale object currentpart(1),partscalex(allparts(currentpart(1))),partscaley(allparts(currentpart(1))),s:s=s-2
      if s<1 then s=1
      partscalez(allparts(currentpart(1)))=s
   endif
   if s<10000 and mousemove_y(1)>0
      scale object currentpart(1),partscalex(allparts(currentpart(1))),partscaley(allparts(currentpart(1))),s:s=s+2
      if s>10000 then s=10000
      partscalez(allparts(currentpart(1)))=s
   endif
endif
endfunction

function findalltextures()
d=1
searchdir$=dirjunk$(3)
set dir searchdir$
for clear=0 to 1024
   foundtexturesforload$(clear)=""
next clear
find first
repeat
if get file type()=0
   texture$=get file name$():maptag$=right$(texture$,4)
endif
if maptag$=".bmp" or maptag$=".BMP"
   foundtexturesforload$(d)=texture$:d=d+1
endif
find next
until get file type()=-1
maxtextures(1)=d
if maxtextures(1)>1 then currenttexture$(1)=foundtexturesforload$(1):currenttexture(1)=1
endfunction

function changecurrtexture()
searchdir$=dirjunk$(3)
set dir searchdir$
redo1234:
if upkey()=1 and currenttexture(1)>1
   currenttexture(1)=currenttexture(1)-1
endif
if downkey()=1 and currenttexture(1)<maxtextures(1)-1
   currenttexture(1)=currenttexture(1)+1
endif
texturestring$=foundtexturesforload$(currenttexture(1)):currenttexture$(1)=foundtexturesforload$(currenttexture(1))
if file exist(currenttexture$(1)) then load image currenttexture$(1),1:paste image 1,1,1:text 1,1,"Current texture: "+texturestring$
onscreentext()
if scancode()=20 then goto redo1234
endfunction

function applytexture()
 if totalparts(1)>0 and image exist(1) then texture object allparts(currentpart(1)),1:todo$(1)="":parttexture$(allparts(currentpart(1)))=currenttexture$(1)
endfunction

function scrolltexture()
u#=parttexturescrollx(allparts(currentpart(1))):v#=parttexturescrolly(allparts(currentpart(1)))
   onscreentext()
   if mousemove_y(1)<0 and u#>1 then u#=u#-.0001
   if mousemove_y(1)>0 and u#<2 then u#=u#+.0001
   if mousemove_x(1)<0 and v#>1 then v#=v#-.0001
   if mousemove_x(1)>0 and v#<2 then v#=v#+.0001
   parttexturescrollx(allparts(currentpart(1)))=u#
   parttexturescrolly(allparts(currentpart(1)))=v#
   scroll object texture allparts(currentpart(1)), u#,v#:onscreentext()
endfunction

function scaletexture()
u#=parttexturescalex(allparts(currentpart(1))):v#=parttexturescaley(allparts(currentpart(1)))
   onscreentext()
   if mousemove_y(1)<0 and u#>1 then u#=u#-.001
   if mousemove_y(1)>0 and u#<50 then u#=u#+.001
   if mousemove_x(1)<0 and v#>1 then v#=v#-.001
   if mousemove_x(1)>0 and v#<50 then v#=v#+.001
   parttexturescalex(allparts(currentpart(1)))=u#
   parttexturescaley(allparts(currentpart(1)))=v#
   scale object texture allparts(currentpart(1)), u#,v#:onscreentext()
endfunction

function unsleep(ms)
b=timer():e=b+ms
while timer()<e
onscreentext()
endwhile
endfunction

rem -------------------------------------------------------------------------
function onscreentext()
ink rgb(255,255,255),rgb(0,0,0)
if totalparts(1)>0
   partinfo1$="":textureinfo1$="":partinfo2$="":textureinfo2$="":partinfo3$="":textureinfo3$="":partinfo4$="":textureinfo4$="":partinfo5$="":textureinfo5$="":limbinfo1$=""
   partinfo1$="Part "+str$(currentpart(1))+" of "+str$(totalparts(1))+" selected : "+partnames$(currentpart(1))
   partinfo2$=" Offset:"+str$(object position x(allparts(currentpart(1))))+","+str$(object position y(allparts(currentpart(1))))+","+str$(object position z(allparts(currentpart(1))))
   partinfo3$=" Rotation:"+str$(object angle x(allparts(currentpart(1))))+"°, "+str$(object angle y(allparts(currentpart(1))))+"°, "+str$(object angle z(allparts(currentpart(1))))+"°"
   partinfo4$=" Scale: "+str$(partscalex(allparts(currentpart(1))))+"%, "+str$(partscaley(allparts(currentpart(1))))+"%, "+str$(partscalez(allparts(currentpart(1))))+"%"
else
   partinfo1$="No parts in scene."
   partinfo2$="Add parts using the"
   partinfo3$="menu above."
endif
   text 1,508, partinfo1$
   text 1,530, partinfo2$
   text 1,552, partinfo3$
   text 1,574, partinfo4$
if maxtextures(1)>0
   textureinfo1$="Texture "+str$(currenttexture(1))+" of "+str$(maxtextures(1)-1)+" in clipboard."
   textureinfo2$=" Scroll:"+str$(parttexturescrollx(allparts(currentpart(1))))+","+str$(parttexturescrolly(allparts(currentpart(1))))
   textureinfo3$=" Scale:"+str$(parttexturescalex(allparts(currentpart(1))))+","+str$(parttexturescaley(allparts(currentpart(1))))
else
   textureinfo1$="No textures found in \Textures folder."
   textureinfo2$="Add .bmp textures to this folder."
endif
   text 280,508, textureinfo1$
   text 280,530, textureinfo2$
   text 280,552, textureinfo3$
if currentlight(1)<>0
   lightinfo1$="Light "+str$(currentlight(1))+" of 7 selected"
   lightinfo2$=" Offset:"+str$(lightsx(currentlight(1)))+","+str$(lightsy(currentlight(1)))+","+str$(lightsx(currentlight(1)))
   lightinfo3$=" Color:R"+str$(lightscolor(currentlight(1),1))+"G"+str$(lightscolor(currentlight(1),2))+"B"+str$(lightscolor(currentlight(1),3))
else
   lightinfo1$=""
   lightinfo2$=""
   lightinfo3$=""
endif
   text 560,508, lightinfo1$
   text 560,530, lightinfo2$
   text 560,552, lightinfo3$
if mouseclick()=1
   if scancode()=44 then text 1,486,"Moving about Z"
   if scancode()=45 then text 1,486,"Moving about X"
   if scancode()=21 then text 1,486,"Moving about Y"
endif
if mouseclick()=2
   if scancode()=44 then text 1,486,"Rotating about Z"
   if scancode()=45 then text 1,486,"Rotating about X"
   if scancode()=21 then text 1,486,"Rotating about Y"
endif
if mouseclick()=3
   if scancode()=44 then text 1,486,"Scaling about Z"
   if scancode()=45 then text 1,486,"Scaling about X"
   if scancode()=21 then text 1,486,"Scaling about Y"
endif
if scancode()=59
   text 1,464,"FPS:"+str$(screen fps())
endif
sync
endfunction

function savemap()
if totalparts(1)<1 then exitfunction
set dir dirjunk$(4)
filename$="TLD"+str$(rnd(9999))+".tld"
if file exist(filename$)=1 then filename$=filename$+str$(rnd(99999))
open to write 1,filename$
fileattribs$=filename$+" last modified on "+get date$()
write string 1,fileattribs$
write string 1,str$(totalparts(1))
for part=1 to totalparts(1)
if object exist(allparts(part))=1
   partname$=partnames$(allparts(part)):if partname$="" then partname$="error"
   pn$=str$(allparts(allparts(part)))
   oax$=str$(object angle x(allparts(part)))
   oay$=str$(object angle y(allparts(part)))
   oaz$=str$(object angle z(allparts(part)))
   opx$=str$(object position x(allparts(part)))
   opy$=str$(object position y(allparts(part)))
   opz$=str$(object position z(allparts(part)))
   osx$=str$(partscalex(allparts(part)))
   osy$=str$(partscaley(allparts(part)))
   osz$=str$(partscalez(allparts(part)))
   ot$=parttexture$(part):if ot$="" then ot$="none"
   otsru$=str$(parttexturescrollx(allparts(part)))
   otsrv$=str$(parttexturescrolly(allparts(part)))
   otslu$=str$(parttexturescalex(allparts(part)))
   otslv$=str$(parttexturescaley(allparts(part)))
   partflags$=str$(parttype(allparts(allparts(part))))
   write string 1,"#################################################"
   write string 1,partname$
   write string 1,pn$
   write string 1,oax$
   write string 1,oay$
   write string 1,oaz$
   write string 1,opx$
   write string 1,opy$
   write string 1,opz$
   write string 1,osx$
   write string 1,osy$
   write string 1,osz$
   write string 1,ot$
   write string 1,otsru$
   write string 1,otsrv$
   write string 1,otslu$
   write string 1,otslv$
   write string 1,partflags$
endif
next part
close file 1
todo$(1)=""
set dir dirjunk$(1)
endfunction

function loadmap(filename$)
resetall()
partnum=1
set dir dirjunk$(4)
open to read 1,filename$
   read string 1,fileattribs$
   read string 1,tp$
   tp=val(tp$)
   for parts=1 to tp
      read string 1,null$
      read string 1,partname$:parttype$=partname$
      read string 1,pn$:pn=val(pn$)
      read string 1,oax$:oax=val(oax$)
      read string 1,oay$:oay=val(oay$)
      read string 1,oaz$:oaz=val(oaz$)
      read string 1,opx$:opx=val(opx$)
      read string 1,opy$:opy=val(opy$)
      read string 1,opz$:opz=val(opz$)
      read string 1,osx$:osx=val(osx$)
      read string 1,osy$:osy=val(osy$)
      read string 1,osz$:osz=val(osz$)
      read string 1,ot$
      read string 1,otsru$:otsru=val(otsru$)
      read string 1,otsrv$:otsrv=val(otsrv$)
      read string 1,otslu$:otslu=val(otslu$)
      read string 1,otslv$:otslv=val(otslv$)
      read string 1,partflags$
      if right$(partname$,2)=".x" then parttype$="X":set dir dirjunk$(2)
      if right$(partname$,4)=".3ds" then parttype$="3DS":set dir dirjunk$(2)
      select parttype$
      case "Sphere"
         make object sphere pn,25
      endcase
      case "Box"
         make object box pn,25,25,25
      endcase
      case "Cylinder"
         make object cylinder pn,25
      endcase
      case "Cone"
         make object cone pn,25
      endcase
      case "Plane"
         make object plain pn,25,25
      endcase
      case "X"
         load object partname$,pn
      endcase
      case "3DS"
         load object partname$,pn
      endcase
      case "Light"
         make object sphere pn,5
         makelights()
      endcase
      endselect
         partnames$(partnum)=parttype$
         allparts(partnum)=pn
         parttexturescalex(partnum)=otslu
         parttexturescaley(partnum)=otslv
         parttexturescrollx(partnum)=otsru
         parttexturescrolly(partnum)=otsrv
         scale object pn,osx,osy,osz
         rotate object pn,oax,oay,oaz
         position object pn,opx,opy,opz
         if ot$<>"none"
            set dir dirjunk$(3)
            if image exist(1) then delete image 1
            if file exist(ot$) then load image ot$,1:parttexture$(pn)=ot$
            texture object pn,1
            scale object texture pn,otslu,otslv
            scroll object texture pn,otsru,otsrv
         endif
      partnum=partnum+1
   next parts
close file 1
todo$(1)=""
findallparts()
endfunction

function makecollisionpart()
if totalparts(1)>0 and object exist(currentpart(1))=1
   parttype(currentpart(1))=2
endif
endfunction

function makestaticbox()
if totalparts(1)>0 and object exist(currentpart(1))=1
   parttype(currentpart(1))=3
endif
endfunction

function resetall()
for part=1 to 5000
if object exist(part)=1 then delete object part
next part
todo$(1)=""
settings("StudioSettings.ini")
endfunction

function filemenu()
submenu=0:subsubmenu=0
do
if mousey()>250 then exitfunction
onscreentext()
mx=mousex()
my=mousey()
ink rgb(0,0,255),rgb(0,0,0)
for textx=1 to 10
   text menualign(textx),1,menu$(textx,1)
next textx
   if mx>0 and mx<50 then submenu=1
   if mx>49 and mx<123 then submenu=2
   if mx>122 and mx<196 then submenu=3
   if mx>195 and mx<296 then submenu=4
   if mx>295 and mx<420 then submenu=5
   if mx>419 and mx<800 then submenu=6
   if my>(-1) and my<22 then subsubmenu=10
   if my>21 and my<44 then subsubmenu=2
   if my>43 and my<66 then subsubmenu=3
   if my>65 and my<88 then subsubmenu=4
   if my>87 and my<110 then subsubmenu=5
   if my>119 and my<132 then subsubmenu=6
   if my>131 and my<154 then subsubmenu=7
   if my>153 and my<176 then subsubmenu=8
   if my>175 and my<198 then subsubmenu=9
   if my>197 and my<220 then subsubmenu=10
   ink rgb(255,255,255),rgb(0,0,0)
   for texty=2 to 10
      text menualign(submenu),(texty*22)-22,menu$(submenu,texty)
   next texty
   text menualign(submenu),(subsubmenu*22)-22,menu$(submenu,subsubmenu)
   if mouseclick()=1
      takeaction(submenu,subsubmenu)
      exitfunction
   endif
loop
endfunction

function takeaction(submenu,subsubmenu)
select submenu
case 1
if subsubmenu=2 then todo$(1)="new"
if subsubmenu=3 then todo$(1)="open"
if subsubmenu=4 then todo$(1)="save"
if subsubmenu=5 then todo$(1)="exit"
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 2
rem if subsubmenu=2 then copy
rem if subsubmenu=3 then paste
rem if subsubmenu=4 then clear
rem if subsubmenu=5 then move
rem if subsubmenu=6 then rotate
rem if subsubmenu=7 then scale
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 3
if subsubmenu=2 then todo$(1)="addx"
if subsubmenu=3 then todo$(1)="add3ds"
if subsubmenu=4 then todo$(1)="addsphere"
if subsubmenu=5 then todo$(1)="addbox"
if subsubmenu=6 then todo$(1)="addcylinder"
if subsubmenu=7 then todo$(1)="addcone"
if subsubmenu=8 then todo$(1)="addplane"
if subsubmenu=9 then todo$(1)="addtriangle"
if subsubmenu=10 then todo$(1)="addlight"
endcase
case 4
if subsubmenu=2 then todo$(1)="applycurrenttexture"
rem if subsubmenu=3 then remove
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 5
rem if subsubmenu=2 then settings
rem if subsubmenu=3 then set keyframe
rem if subsubmenu=4 then remove keyframe
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 6
rem if subsubmenu=2 then
rem if subsubmenu=3 then
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 7
rem if subsubmenu=2 then
rem if subsubmenu=3 then
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 8
rem if subsubmenu=2 then
rem if subsubmenu=3 then
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 9
rem if subsubmenu=2 then
rem if subsubmenu=3 then
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
case 10
rem if subsubmenu=2 then
rem if subsubmenu=3 then
rem if subsubmenu=4 then
rem if subsubmenu=5 then
rem if subsubmenu=6 then
rem if subsubmenu=7 then
rem if subsubmenu=8 then
rem if subsubmenu=9 then
rem if subsubmenu=10 then
endcase
endselect
endfunction

function d2db(decimal)
if decimal<0
   sign$="-"
else
   sign$="+"
endif
decimal=abs(decimal)
returnbits$=""
31bits$=""
for b=30 to 0 step -1
   if decimal>(2^b)-1
      bit$="1"
      decimal=decimal-(2^b)
   else
      bit$="0"
   endif
31bits$=31bits$+bit$
if sign$="-" then returnbits$="1"+31bits$ else returnbits$="0"+31bits$
next b
endfunction returnbits$

rem This function accepts up to a 32bit binary string (DWORD) and returns a
rem decimal equivalent. MSB determines positive or negative number so output
rem rangeis (-2,147,483,647 to +2,147,483,647). If len(bits$)<32 then binary
rem data is automatically padded up to 32bits.
function db2d(bits$)
total=0
pad$=""
bitlen=len(bits$)
if bitlen>32 then bits$="0": bitlen=1
if bitlen<32
   oldbit$=bits$
   for pad=1 to (32-bitlen)
      pad$=pad$+"0"
   next pad
   bits$=pad$+oldbit$
   bitlen=len(bits$)
endif
if bitlen=32 then stopbit=2 else stopbit=1
for newbit=bitlen to stopbit step -1
   bit$=mid$(bits$,newbit)
   if bit$="1" then total=total + (2^(bitlen-newbit))
next newbit
if bitlen=32 and mid$(bits$,1)="1" then total=total-(2*total)
endfunction total

rem This function accepts a decimal (0-255) and converts it to an 8bit binary
rem string.
function d2b(decimal)
8bits$=""
for b=7 to 0 step -1
   if decimal>(2^b)-1
      bit$="1"
      decimal=decimal-(2^b)
   else
      bit$="0"
   endif
8bits$=8bits$+bit$
next b
endfunction 8bits$

rem This function accepts an 8bit binary string and converts it to a decimal.
rem (0-255)
function b2d(8bits$)
decimal=0
for b=0 to 7
   bit$=mid$(8bits$,8-b)
   if bit$="1"
      decimal=decimal+(2^b)
   else
      bit$="0"
   endif
next b
endfunction decimal

rem This function accepts a decimal (0-65535) and converts it to a 16bit binary
rem string.
function d2w(decimal)
16bits$=""
for b=15 to 0 step -1
   if decimal>(2^b)-1
      bit$="1"
      decimal=decimal-(2^b)
   else
      bit$="0"
   endif
16bits$=16bits$+bit$
next b
endfunction 16bits$

rem This function accepts a 16bit binary string and converts it to a decimal.
rem (0-65535)
function w2d(16bits$)
decimal=0
for b=0 to 15
   bit$=mid$(16bits$,16-b)
   if bit$="1"
      decimal=decimal+(2^b)
   else
      bit$="0"
   endif
next b
endfunction decimal

function settings(f$)
if file exist(f$)=1
   open to read 20,"StudioSettings.ini"
   read string 20, dir$
   read string 20, partsdir$
   read string 20, texturesdir$
   read string 20, displayx$
   read string 20, displayy$
   read string 20, displayz$
   read string 20, font$
   read string 20, fontsize$
   close file 20
endif
   menu$(1,1)="File":menu$(1,2)="New":menu$(1,3)="Open":menu$(1,4)="Save":menu$(1,5)="Exit"
   menu$(2,1)="Edit":menu$(2,2)="Copy":menu$(2,3)="Paste":menu$(2,4)="Clear"
   menu$(3,1)="Part":menu$(3,2)="Add X part":menu$(3,3)="Add 3ds part":menu$(3,4)="Add Sphere":menu$(3,5)="Add Box":menu$(3,6)="Add Cylinder":menu$(3,7)="Add Cone":menu$(3,8)="Add Plane":menu$(3,9)="Add Triangle":menu$(3,10)="Add Light"
   menu$(4,1)="Texture":menu$(4,2)="Apply":menu$(4,3)="Remove"
   menu$(5,1)="Animation":menu$(5,2)="Settings":menu$(5,3)="Set keyframe":menu$(5,4)="Remove all keyframes":menu$(5,5)="Save animation":menu$(5,6)="Append animation"
   menu$(6,1)="Help":menu$(6,2)="Contents":menu$(6,3)="Register":menu$(6,4)="About"
   menualign(1)=1: menualign(2)=70: menualign(3)=140: menualign(4)=210: menualign(5)=310: menualign(6)=440:
   for ss=1 to 5000
      partscalex(ss)=100
      partscaley(ss)=100
      partscalez(ss)=100
      parttexturescalex(ss)=1
      parttexturescaley(ss)=1
      parttexturescrollx(ss)=1
      parttexturescrolly(ss)=1
   next ss
viewmode(1)=1
randomize timer()
autocam off
totalparts(1)=0
maxparts(1)=5000
position camera 0,0,-100
x=val(displayx$)
y=val(displayy$)
z=val(displayz$)
set text font font$
set text size val(fontsize$)
sync on
sync rate 0
backdrop on
randomize timer()
ink rgb(255,255,0),rgb(0,0,0)
color backdrop rgb(0,0,0)
findalltextures()
changecurrtexture()
endfunction

function getfileforload(dir$,type$)
tl=len(type$)
set dir dir$
d=1
for clear=0 to 1024
foundfilesforload$(clear)=""
next clear
find first
repeat
if get file type()=0
   temp$=get file name$()
   maptag$=right$(temp$,tl)
endif
if maptag$=type$
   foundfilesforload$(d)=temp$
   d=d+1
endif
find next
until get file type()=-1
max=d
ink rgb(255,255,0),rgb(0,0,0)
d=1
repeat
if upkey()=1 and d>1
   d=d-1:sleep 200
   cls
rem while upkey()=1:endwhile
endif
if downkey()=1 and d<max-1
   d=d+1:sleep 200
   cls
rem while downkey()=1:endwhile
endif
loadstring$="Load "+chr$(40)+type$+chr$(41)+" file : "+foundfilesforload$(d)
text 1,23,loadstring$
sync
until returnkey()=1
selectedfile$=foundfilesforload$(d)
endfunction selectedfile$

function quit()
for p=1 to maxparts(1)
 if object exist(p)=1 then delete object p
next p
quitt(1)=1
endfunction

rem function copy(currentpart(1))
rem copy$(nextcopy()))
rem endfunction

function msgbox()

endfunction

function makelights()
nav=0
for l=7 to 1 step -1
if light exist(l)=0 then lightsavailable(l)=1:nav=l
next l
if nav<>99
 if nav<>0 then make light nav
 findallparts():colorparts()
 lights(nav)=currentpart(1)
 currentlight(1)=nav
 lightscolor(currentlight(1),1)=rnd(255)
 lightscolor(currentlight(1),2)=rnd(255)
 lightscolor(currentlight(1),3)=rnd(255)
 color light nav,lightscolor(currentlight(1),1),lightscolor(currentlight(1),2),lightscolor(currentlight(1),3)
endif
endfunction

function shadowon()
 set shadow shading on currentpart(1)
endfunction

function repositionlight()
lightsx(currentlight(1))=object position x(currentpart(1))
lightsy(currentlight(1))=object position y(currentpart(1))
lightsz(currentlight(1))=object position z(currentpart(1))
position light currentlight(1), lightsx(currentlight(1)),lightsy(currentlight(1)),lightsz(currentlight(1))
endfunction

remstart
function packfiles()
open to write 1,"archive.pak"
AddToFile("img1.jpg")
AddToFile("img2.jpg")
AddToFile("img3.jpg")
AddToFile("img4.jpg")
AddToFile("img5.jpg")
close file 1
open to read 1,"archive.pak"
GetFile("image1.jpg")
GetFile("image2.jpg")
close file 1
endfunction

function AddToFile(Name$)
  open to read 2,Name$
  make memblock from file 1,2
  write memblock 1,1
  delete memblock 1
  close file 2
endfunction

function GetFile(Name$)
  read memblock 1,1
  open to write 2,Name$
  make file from memblock 2,1
  delete memblock 1
  close file 2
endfunction
remend

function startup()
homedir$=dirjunk$(1)
set dir homedir$
if file exist("TLDLevelEdit.ini")=0 then buildini()
endfunction

function buildini()
text 1,1,"TLDLevelEdit.ini is not present or is corrupt in the home directory. Rebuilding now":sync
open to write 1,"TLDLevelEdit.ini"
write string 1,";The Lone Danger - Level Editor"
write string 1,";Copyright 2004 Jason Smith"
write string 1,";This program is freeware, so enjoy!"
write string 1,""
cgc$=";Display info for : "+current graphics card$()
write string 1,cgc$
perform checklist for display modes
nummodes=checklist quantity()
text 15,1,"Checking your graphics card...":sync
for mode=1 to nummodes
mode$=checklist string$(mode)
width=checklist value a(mode)
height=checklist value b(mode)
depth=checklist value c(mode)
avm$=";mode "+str$(mode)+" : "+mode$
write string 1,avm$
next mode

rem for chopstring=1 to len(mode$)
rem if mid$(mode$)="x" then
rem set display mode
close file 1
endfunction