Rem Project: terrain editor
Rem Created: 26/05/2006 21:18:54
 
Rem ***** Main Source File *****
 
set display mode 1024,768,32
color backdrop rgb(180,180,255)
make object cube 1,1
hide object 1
autocam off
sync on
 
fog on
fog color rgb(100,100,250)
fog distance 450
 
numberofclouds=400
cloudseed=freeobject()
create_clouds(cloudseed,numberofclouds)
 
menuspritepriority=200
global menucapacity
menucapacity=15
sw#=screen width()
sh#=screen height()
 
global dim handlename$(1000) `menu()
global firstmenuitem$ `menu()
global lastmenuitem$ `menu()
global systementityseed `gethandlenumber(),free_system_entity()
global menuactive `menu_select:, hide_menu_items(), create_entity: - 1 if any menu is dropped down
global menubar
 
global menuspritepriority
global dim word$(menucapacity,menucapacity,menucapacity) `menu() used for storing menu items and hierarchy
global width# `menu() sets size of menu items - also used in menu_select: for pick values.
global height#
 
 
gosub make_menu_bar
 menudata$="File(New(100 x 100,200 x 200,300 x 300),Open,Save,Exit),View(Edit mode,Preview),Tools(Build,Excavate,Smooth,Paint),Brushes(Brush size(Small,Medium,Large),Sphere,Cube,Cone),Textures(Grass,Rock,Snow),Lightmapping(Position light,Cast shadows),Help(Tutorial,About)"
  makemenu(menudata$)
 
do
if mouseclick()=1 then gosub menu_select
control camera using arrowkeys 0,1,1
move_clouds(cloudseed,numberofclouds)
sync
loop
 
function create_clouds(cloudseed,numberofclouds)
 
create bitmap 1,50,50
ink rgb(255,255,200),0
for x=1 to 1000
   ang=rnd(360)
   rad=rnd(20)
   box 25+sin(ang)*rad,25+cos(ang)*rad,rnd(3)+25+sin(ang)*rad,rnd(3)+25+cos(ang)*rad
next x
blur bitmap 1,4
cloudimage = freeimage()
get image cloudimage, 0, 0, 50, 50
 
delete bitmap 1
 
 
for cloudnumber=cloudseed to cloudseed+numberofclouds
make object plain cloudnumber,rnd(50)+100,rnd(50)+100
position object cloudnumber,rnd(1000)-500,rnd(100)+10,rnd(1000)-500
xrotate object cloudnumber,90
texture object cloudnumber,cloudimage
ghost object on cloudnumber,0
disable object zwrite cloudnumber
set object light cloudnumber,0
next n
 
endfunction
 
function move_clouds(cloudseed,numberofclouds)
 
for cloudnumber=cloudseed to cloudseed+numberofclouds
move object down cloudnumber,-.05
if object position z(cloudnumber)<-500 then position object cloudnumber,rnd(1000)-500,rnd(100)+10,500
next cloudnumber
 
endfunction
 
 
function freeobject()
   repeat
      inc n
   until object exist(n) = 0
endfunction n
 
function freeimage()
   repeat
      inc n
   until image exist(n) = 0
endfunction n
 
function pick_system_sprite(lower,upper,spritewidth,spriteheight)
`used for system sprites where size is not stored
for spritenumber=lower to upper
if spritenumber>0
if sprite exist(spritenumber)
  if sprite visible(spritenumber)
    if mousex()>=sprite x(spritenumber) and mousex()<=sprite x(spritenumber)+spritewidth and mousey()>=sprite y(spritenumber) and mousey()<=sprite y(spritenumber)+spriteheight
      `if sprite priority(spritenumber)>highestpriority
         `highestpriority=sprite priority(spritenumber)
         picked=spritenumber
      `endif
    endif
  endif
endif
endif
next spritenumber
 
endfunction picked
 
function free_sprite()
 
repeat
inc n
until image exist(n)=0 and sprite exist(n)=0
 
endfunction n
 
 
make_menu_bar:
 
 `make menu
  menubar=free_sprite()
 
  create bitmap 1,28,28
    for n=0 to 28
    grey=255-(n*5)
    ink rgb(grey,grey,grey),0
    line 0,n,28,n
    next n
    get image menubar,0,0,28,28
  delete bitmap 1
 
  sprite menubar,0,0,menubar
  size sprite menubar,sw#,sh#*28/768.0 `image size is 28, and was designed to fit 768 height. So sh#*28/768 will keep same ratio with other resolutions
 
 
 return
 
 
 
 
menu_select:
 
if mouseclick()=1
  menuitem=pick_system_sprite(gethandlenumber(firstmenuitem$),gethandlenumber(lastmenuitem$),width#,height#) `width and height defined in menu()
endif
if menuitem=0 and menuactive=1 then  hide_menu_items() `hides any menus if mouse clicked off the menu, and only if any menus are open
if menuitem>0 `if some menu item is clicked
menuactive=1 `1 if any menu is dropped down
 
  for x=1 to menucapacity `cycle through each menu item
  for y=0 to menucapacity
  for z=0 to menucapacity
 
  if gethandlenumber(word$(x,y,z))=menuitem `if the one tested for is the one clicked on, then do the following series of checks
    menuhandle$=word$(x,y,z)
 
    `process menu clicks here:
      `eg: if menuhandle$="open" then .......
      if menuhandle$="100 x 100" then create_terrain(100)
      if menuhandle$="200 x 200" then create_terrain(200)
      if menuhandle$="300 x 300" then create_terrain(300)
 
 
    if y=0
      hide_menu_items()
      for n=1 to menucapacity
        if sprite exist(gethandlenumber(word$(x,n,0))) then show sprite gethandlenumber(word$(x,n,0)):menuactive=1  `if top level selected then show second level
      next n
    endif
    if y>0 and z=0
      hide_menu_items()
      thirdlevelpresent=0
      for p=1 to menucapacity
        if sprite exist(gethandlenumber(word$(x,y,z+p)))
          show sprite gethandlenumber(word$(x,y,z+p)):menuactive=1 `show third level if selected.
        endif
        if word$(x,y,z+p)<>"" then thirdlevelpresent=1
      next p
      if thirdlevelpresent=1
        for n=1 to menucapacity
          if sprite exist(gethandlenumber(word$(x,n,0))) then show sprite gethandlenumber(word$(x,n,0)):menuactive=1 `if second level selected, then show second level .....
        next n
      endif
    endif
    if z>0 then hide_menu_items()
  endif
 
  next z
  next y
  next x
endif
 
return
 
function gethandlenumber(name$)
`globals used: systementityseed, menucapacity, handlename$(...)
number=systementityseed
repeat
  inc number
  if number>systementityseed+menucapacity*10 then exit `note: - if a match isn't found, the function will return the number 101
until handlename$(number)=name$
 
endfunction number
 
function hide_menu_items
 
`hide all menu sprites
for n=gethandlenumber(firstmenuitem$) to gethandlenumber(lastmenuitem$)
  if sprite exist(n) then hide sprite n
next n
 
`show top level (x=1) sprites
for x=1 to menucapacity
  if sprite exist(gethandlenumber(word$(x,0,0))) then show sprite gethandlenumber(word$(x,0,0))
next n
 
menuactive=0
 
endfunction
 
function makemenu(data$)
`globals used: firstmenuitem$, lastmenuitem$, handlename$(), word$(), width#, height#
 
 
length=len(data$)
 
x=1
for test=1 to length
 
    character$=right$(left$(data$,test),1)
    nonletter=0
    if character$<>"("
    if character$<>","
    if character$<>")"
    nonletter=1
    endif
    endif
    endif
 
    if nonletter=1
      word$=word$+character$
    else
      if character$="," and oldcharacter$=")"
        `do nothing
      else
        word$(x,y,z)=word$:word$=""
      endif
      if character$="("
        inc bracket
        if bracket>oldbracket and bracket=1 then inc y
        if bracket>oldbracket and bracket=2 then inc z
      endif
      if character$=")"
        dec bracket
        if bracket=0 then y=0:z=0
        if bracket=1 then z=0
      endif
      if character$=","
        if bracket=0 then inc x
        if bracket=1 then inc y
        if bracket=2 then inc z
      endif
    endif
    oldbracket=bracket
    oldcharacter$=character$
 
  next test
 
width#=80
height#=28
 
 
for x=0 to menucapacity
for y=0 to menucapacity
for z=0 to menucapacity
 
text$=word$(x,y,z)
`if len(text$)>0
if text$<>""
 
  `length=len(word$(x,y,z))
  length=len(text$)
  `store name of first menu item for pick range later on
 
  lastmenuitem$=text$ `store name of last menu item for pick range later on
  if firsttimethrough=0
    firstmenuitem$=text$
    firsttimethrough=1
  endif
  `create the graphic for the menu item
  create bitmap 1,screen width(),screen height()
  ink rgb(255,255,255),0
  box 0,0,width#,height#
  ink rgb(100,100,100),0
  box 1,1,width#,height#
  ink rgb(224,223,227),0
  box 1,1,width#-1,height#-1
  temp=free_sprite()
  sprite temp,500,500,menubar
  size sprite temp,width#-2,height#-2
  paste sprite temp,1,1
  ink rgb(100,100,100),0
  set text font "arial"
  set text size 14
  text width#/2.0-text width(text$)/2,height#/2.0-text height(text$)/2.0,text$
  `create the sprite
  handlenumber=free_sprite()
  `store the name of the sprite as a string - use gethandlenumber("name") to return the sprite number
  handlename$(handlenumber)=word$(x,y,z)
  get image handlenumber,0,0,width#,height#,1
  delete sprite temp
  delete bitmap 1
 
  if z<2 then sprite handlenumber,(x*width#)-width#+z*width#,y*height#,handlenumber
  if z>=2 then sprite handlenumber,(x*width#)-width#+1*width#,y*height#+(z-1)*height#,handlenumber
  if y>0 then hide sprite handlenumber
  set sprite priority handlenumber,menuspritepriority  `causes massive slow down when number is too high.  Needed to ensure menu items appear on top of other sprites.  Suggest updating as number of sprites increases.
 
endif
 
next z
next y
next x
 
endfunction
 
function create_terrain(size)
  if matrix exist(1) then delete matrix 1
  make matrix 1,100,100,size,size
  position camera 50,10,-20
 
endfunction