Sorry your browser is not supported!

remstart
`>>>>>>>>>>>>>>>>>>>>>>>> Controls <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
viewing: Crtl + wasd keys and mouse movement
Edit: Move the cursor over the world and click to edit the height
Change current height: Drag bar up/down on the right (255 = max height)
Change current radius when in Round Hill mode: drag bar up/down on the right
Change current tool: up and down keys

Shortkeys:
W: Turns wireframe on/off (when in editing mode)
G: Turns ghost on/off (when in editing mode)
T: Turn tile when in 4-point mode.
remend

sync on : sync rate 100

`Set font
set text font "Comic Sans MS"
set text size 16

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0
#constant maxTools = 3
#constant maxImages = 100
#constant sqTwo = 1.414

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer
global WireFrame as integer
global Ghosted as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
   tx as integer
   ty as integer
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
   img as integer
   imgx as integer
   imgy as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile
dim Tools(maxTools) as string

`Init tools
restore Tools
for i = 1 to maxTools
   read tool$
   Tools(i) = tool$
next i

`<<<<<<<<<<<<<<<<<<< Temporary >>>>>>>>>>>>>>>>>>>>>>>>
World(1).sx# = 200.0
World(1).sy# = 50.0
World(1).sz# = 200.0
World(1).tx = 50
World(1).tz = 50

CreateWorldMesh(1)

make object 1, 1, 0
set object collision to polygons 1
`<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

`Create mouse pointer
make object cube maxWorlds + 1, 1
color object maxWorlds + 1, rgb(0, 0, 255)
set object emissive maxWorlds + 1, rgb(0,0,255)
for c = 1 to 4
   make object cube maxWorlds + 1 + c, 1
   color object maxWorlds + 1 + c, rgb(0, 255, 0)
   ghost object on maxWorlds + 1 + c
   set object emissive maxWorlds + 1 + c, rgb(0, 255, 0)
   hide object maxWorlds + 1 + c
next c

cls
ink rgb(0, 255, 0), 0
circle 100, 100, 100
get image maxImages + 4, 0, 0, 200, 200, 1

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1 : show object maxWorlds + 2
CHeight# = 0.0
Ang# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse
      if WorldCursor > 0 then gosub EditWorld

      `show cursor
      if object visible(maxWorlds + 1) = 0 then show object maxWorlds + 1
   else

      if object visible(maxWorlds + 1) = 1 then hide object maxWorlds + 1

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 and mousey() < screen height() - 20 then MouseLocked = 0

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx# = get pick vector x()
   my# = get pick vector y()
   mz# = get pick vector z()
   set vector3 1, mx#, my#, mz#
   FullDistance# = length vector3(1)

   `Get world and intersection point
   WorldCursor = 0
   olddist# = 1500
   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx#, camy# + my#, camz# + mz#)

         if dist# > 0.0 and dist# < olddist#
            mx# = (mx# / FullDistance# * dist#)
            my# = (my# / FullDistance# * dist#)
            mz# = (mz# / FullDistance# * dist#)
            WorldCursor = w
            olddist# = dist#
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer(s) position
   if WorldCursor > 0
      tx# = World(WorldCursor).tx * (mx#+World(WorldCursor).sx#/2) / World(WorldCursor).sx#
      tz# = World(WorldCursor).tz * (mz#+World(WorldCursor).sz#/2) / World(WorldCursor).sz#
      select CTool
         case 1
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
         endcase
         case 2
            tx = int(tx#) : tz = int(tz#)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
            PositionCursor(maxWorlds + 3, WorldCursor, tx + 1, tz)
            PositionCursor(maxWorlds + 4, WorldCursor, tx, tz + 1)
            PositionCursor(maxWorlds + 5, WorldCursor, tx + 1, tz + 1)
         endcase
         case 3
            Ang# = wrapvalue(Ang# + 1.0)
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            for c = 1 to 4
               x# = mx# + cos(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sx# / World(WorldCursor).tx)
               z# = mz# + sin(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sz# / World(WorldCursor).tz)
               position object maxWorlds + 1 + c, x#, intersect object(WorldCursor, x#, 0.0, z#, x#, World(WorldCursor).sy#, z#), z#
            next c
         endcase
      endselect
   endif

return

EditWorld:

   `Change Edit Mode
   if upkey() = 1 and KeyHold = 0
      KeyHold = 1
      inc CTool
   endif
   if downkey() = 1 and KeyHold = 0
      KeyHold = 1
      dec CTool
   endif

   `Check
   if KeyHold > 0

      `Boundry
      if CTool < 1 then CTool = maxTools
      if CTool > maxTools then CTool = 1

      `Hide - unhide cursor
      select CTool
         case 1
            show object maxWorlds + 2
            hide object maxWorlds + 3
            hide object maxWorlds + 4
            hide object maxWorlds + 5
         endcase
         case 2
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
         case 3
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
      endselect
   endif

   `Get tool
   select CTool
      case 1
         if mouseclick() = 1 then Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#
      endcase
      case 2

         if mouseclick() = 1
            if tx >= 0 and tz >= 0
               `First point
               if tx <= World(WorldCursor).tx and tz <= World(WorldCursor).tz
                  Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#

                  `Second point
                  if tx <= World(WorldCursor).tx - 1
                     Heightmap(WorldCursor, tx + 2, tz + 1) = CHeight#
                     `Third point
                     if tz <= World(WorldCursor).tz - 1
                        Heightmap(WorldCursor, tx + 2, tz + 2) = CHeight#
                     endif
                  endif

                  `Last point
                  if tz <= World(WorldCursor).tz -1
                     Heightmap(WorldCursor, tx + 1, tz + 2) = CHeight#
                  endif
               endif
            endif
         endif

      endcase
      case 3

         rad = int(CHeight# * 0.2)

         if mouseclick() = 1 then in = 1
         if mouseclick() = 2 then in = -1

         `Calculate all positions
         if mouseclick() > 0
            for x = int(tx - rad) to int(tx + rad) + 1
               for y = int(tz - rad) to int(tz + rad) + 1

                  `Calc distance
                  set vector3 1, tx - x, 0, tz - y
                  Dist# = length vector3(1)

                  `If that distance <= rad then that point is edited
                  if Dist# <= rad

                     `Check if the point is in the world
                     if x >= 0 and x <= World(WorldCursor).tx + 1
                        if y >= 0 and y <= World(WorldCursor).tz + 1

                           `Increase height
                           Height = Heightmap(WorldCursor, x, y) + (rad - Dist#) * in

                           `Boundries
                           if Height < 0 then Height = 0
                           if Height > maxHeight then Height = maxHeight

                           `Update
                           Heightmap(WorldCursor, x, y) = Height

                        endif
                     endif

                  endif
               next y
            next x
         endif
      endcase
   endselect

   if mouseclick() > 0
      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Right click
   if keystate(20) = 1 and CTool = 2 and KeyHold = 0
      KeyHold = 1

      `Boundries
      if tx >= 0 and tz >= 0
         if tx <= World(WorldCursor).tx - 1 and tz <= World(WorldCursor).tz - 1
            if Tile(WorldCursor, tx + 1, tz + 1).turned = 0
               Tile(WorldCursor, tx + 1, tz + 1).turned = 1
            else
               Tile(WorldCursor, tx + 1, tz + 1).turned = 0
            endif
         endif
      endif

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Wireframe on off
   if keystate(17) > 0 and KeyHold = 0
      KeyHold = 1
      Wireframe = abs(Wireframe - 1)
      if Wireframe = 1 then set object wireframe WorldCursor, 1 else set object wireframe WorldCursor, 0
   endif
   if keystate(34) > 0 and KeyHold = 0
      KeyHold = 1
      Ghosted = abs(Ghosted - 1)
      if Ghosted = 1 then ghost object on WorldCursor else ghost object off WorldCursor
   endif

   `Unlock keyhold
   if upkey() + downkey() + mouseclick() + keystate(17) + keystate(34) + keystate(20) = 0 then KeyHold = 0

return

HUDControl:

   `Display cursor information
   ink rgb(255, 255, 255), 0
   set cursor 0, 0
   print "Tile: ", tx, " : ", tz
   print "Pointed world: ", WorldCursor
   print "Current tool: " + Tools(CTool)

   `Additional message
   ink rgb(0,255,0),0
   if msg$ <> ""
      inc Time
      print msg$
   else
      Time = 0
   endif
   if Time > 250 then msg$ = ""

   `Height indicator
   ink rgb(255, 0, 0), 0
   line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   if CTool = 3
      center text screen width() - 10, 10, str$(int(CHeight# * 0.2))
   else
      center text screen width() - 10, 10, str$(CHeight#)
   endif

   `Right menu
   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

   `Bottom menu
   if mousey() > screen height() - 20
      MouseLocked = 1
   endif

   `Tools
   if button(60, screen height() - 10, "Tools") > 0 then gosub Tools
   if button(170, screen height() - 10, "Export") > 0 then gosub Export
   if button(280, screen height() - 10, "Exit") > 0 then end

return

Tools:

   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Initialize
   FillWorld = 1
   FillHeight = 0
   FHeight = 0
   THeight = 0
   MouseTimer = 0
   Tool = 1
   GoOut = 0

   do

      `Background
      paste image maxImages + 1, 0, 0

      `Background
      ink rgb(255, 255, 255), 0
      box 50, 50, 450, 350

      `Select tool
      if textbutton(85, 80, "<") > 0 and hold = 0
         hold = 1
         dec Tool
         if Tool < 1 then Tool = 1
      endif
      if textbutton(250, 80, ">") > 0 and hold = 0
         hold = 1
         inc Tool
         if Tool > 3 then Tool = 3
      endif

      `Display tool
      ink rgb(0, 0, 255), 0
      select Tool
         case 1
            text 100, 75, "Fill"
            gosub Fill
         endcase
         case 2
            text 100, 75, "Randomize"
            gosub WorldRand
         endcase
         case 3
            text 100, 75, "Smooth"
            gosub WorldSmooth
         endcase
      endselect

      `Display quit button
      if button(200, 340, "Return") > 0 then GoOut = 1

      `Unlock mouse
      if mouseclick() = 0 then hold = 0

      `Quit tools
      if GoOut > 0
         repeat : until mouseclick() = 0
         return
      endif

      sync
   loop

return

`>>>>> Tools <<<<<<<
Fill:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Height selecting
   ink 0, 0
   text 100, 115, "Height:"
   D = textbutton(250, 120, "<")
   U = textbutton(300, 120, ">")
   if U > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FillHeight
   endif
   if D > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FillHeight
   endif
   if D + U = 0 then MouseTimer = 0
   if FillHeight < 0 then FillHeight = 0
   if FillHeight > maxHeight then FillHeight = maxHeight
   ink 0, 0
   center text 275, 115, str$(FillHeight)

   `Apply button
   if button(200, 150, "Edit") > 0
      repeat
      until mouseclick() = 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FillHeight
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
      endif
      GoOut = 1
   endif
return

WorldRand:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display From and To Height
   ink 0, 0
   text 100, 115, "Min Height:"
   text 100, 135, "Max Height:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FHeight
   endif
   if D1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FHeight
   endif
   if U2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc THeight
   endif
   if D2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec THeight
   endif

   `Boundries
   if FHeight < 0 then FHeight = 0
   if FHeight > maxHeight then FHeight = maxHeight
   if THeight < 0 then THeight = 0
   if THeight > maxHeight then THeight = maxHeight

   ink 0, 0
   center text 275, 115, str$(FHeight)
   center text 275, 135, str$(THeight)

   if D1 + U1 + D2 + U2 = 0 then MouseTimer = 0

   `Apply
   if button(200, 160, "Edit") > 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FHeight + rnd(THeight - FHeight)
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

WorldSmooth:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Smooth button
   if button(200, 128, "Edit") > 0
      if object exist(FillWorld) > 0
         SmoothHeightmap(FillWorld)
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXPORT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Export:

   `Init
   FileExp = 0
   FileName$ = ""
   TypAct = 0

   `Get background
   ink rgb(255, 255, 255), 0
   box 5, 5, 350, 250
   ink rgb(100, 100, 255), 0
   box 10, 10, 340, 30
   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Input
   ink 0, 0
   do

      `Refresh background
      paste image maxImages + 1, 0, 0

      `Input
      if TypAct = 1
         char$ = entry$()
         select asc(char$)
            case 13
               TypAct = 0
            endcase
            case 8
               FileName$ = left$(FileName$, len(FileName$) - 1)
            endcase
            case default
               FileName$ = FileName$ + char$
            endcase
         endselect
         clear entry buffer
      else

         `Type if clicked on filename area.
         if mousex() > 10 and mousex() < 340
            if mousey() > 10 and mousey() < 30
               if mouseclick() = 1 then TypAct = 1
            endif
         endif
      endif

      `Display input
      if TypAct = 1 then add$ = "_" else add$ = ""
      text 12, 12, "Filename:" + FileName$ + add$

      `Export buttons
      if button(70, 50, "DBO object") > 0 then Msg$ = SaveDBO(FileName$) : exit
      if button(180, 50, "Heightmap") > 0 then Msg$ = SaveHeightmap(FileName$) : exit
      if button(290, 50, "Return") > 0
         exit
      endif

      sync
   loop

return

`**************************
`Functions
`**************************

function SmoothHeightmap(w)

   `Extract data
   tx = World(w).tx + 1
   tz = World(w).tz + 1

   `temporary copy of heightmap
   dim TEMP(tx, tz)
   for y = 1 to tz : for x = 1 to tx : TEMP(x, y) = Heightmap(w, x, y) : next x : next y

   `Smooth heights
   for y = 2 to tz - 1
      for x = 2 to tx - 1

         fHeight# = TEMP(x, y) * 0.5

         `Top down left and right
         fHeight# = fHeight# + (TEMP(x - 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x + 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y - 1) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y + 1) * 0.08)

         `top-left/right and bottom-left/right
         fHeight# = fHeight# + (TEMP(x - 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x - 1, y + 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y + 1) * 0.045)

         `store final height in the destination heightmap
         Heightmap(w, x, y) = fHeight#
      next x
   next y

   `Sides
   for y = 2 to tz - 1

      `Left row
      fHeight# = TEMP(1, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(1, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(1, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(2, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(2, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(2, y + 1) * 0.045)

      Heightmap(w, 1, y) = fHeight#

      `Right row
      fHeight# = TEMP(tx, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(tx, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx - 1, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(tx - 1, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(tx - 1, y + 1) * 0.045)

      Heightmap(w, tx, y) = fHeight#
   next y

   for x = 2 to tx - 1

      `Left row
      fHeight# = TEMP(x, 1) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x + 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x - 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)

      Heightmap(w, x, 1) = fHeight#

      `Right row
      fHeight# = TEMP(x, tz) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz - 1) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x - 1, tz - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(x + 1, tz - 1) * 0.045)

      Heightmap(w, x, tz) = fHeight#
   next x

   `Corners
   fHeight# = TEMP(1, 1) * 0.795
   fHeight# = fHeight# + (TEMP(1, 2) * 0.08) + (TEMP(2,1) * 0.08) + (TEMP(2, 2) * 0.045)
   Heightmap(w, 1, 1) = fHeight#

   fHeight# = TEMP(1, tz) * 0.795
   fHeight# = fHeight# + (TEMP(1, tz - 1) * 0.08) + (TEMP(2, tz) * 0.08) + (TEMP(2, tz - 1) * 0.045)
   Heightmap(w, 1, tz) = fHeight#

   fHeight# = TEMP(tx, 1) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, 1) * 0.08) + (TEMP(tx, 2) * 0.08) + (TEMP(tx - 1, 2) * 0.045)
   Heightmap(w, tx, 1) = fHeight#

   fHeight# = TEMP(tx, tz) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, tz) * 0.08) + (TEMP(tx, tz - 1) * 0.08) + (TEMP(tx - 1, tz - 1) * 0.045)
   Heightmap(w, tx, tz) = fHeight#

   `Undim temporary array
   undim TEMP(0)

endfunction

function SaveHeightmap(file$)

   if file$ <> ""
      if file exist(file$ + ".bmp") = 0
         `Return message
         msg$ = "Save complete"

         width = World(1).tx + 1
         height= World(1).tz + 1

         `Create image memblock
         make memblock maxWorlds + 1, 12 + (width * height * 4)
         write memblock dword maxWorlds + 1, 0, width
         write memblock dword maxWorlds + 1, 4, height
         write memblock dword maxWorlds + 1, 8, 32

         `Write pixels
         for y = 1 to height
            for x = 1 to width

               `Calc position
               pos = 12 + (((y-1)*width + x - 1)*4)

               `Write color using heightmap
               h = Heightmap(1, x, y)
               write memblock dword maxWorlds + 1, pos, rgb(h, h, h)

            next x
         next y

         `Export image
         make image from memblock maxImages + 2, maxWorlds + 1
         delete memblock maxWorlds + 1
         save image file$ + ".bmp", maxImages + 2
      else
         msg$ = "File already exist"
      endif
   else
      msg$ = "File name is invalid"
   endif

endfunction msg$

function SaveDBO(file$)
   if file$ <> ""
      if file exist(file$ + ".dbo") = 0
         save object file$ + ".dbo", 1
         msg$ = "Save complete"
      else
         msg$ = "File already exists."
      endif
   else
      msg$ = "File name is invalid"
   endif
endfunction msg$

function textbutton(x, y, txt$)
   pressed = 0
   tx = text width(txt$) / 2
   ty = text height(txt$) / 2
   if mousex() > x - tx and mousex() < x + tx
      if mousey() > y - ty and mousey() < y + ty
         pressed = 1
      endif
   endif
   if pressed = 1 then ink rgb(0, 0, 255), 0 else ink 0, 0
   center text x, y - ty, txt$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

function button(x, y, txt$)

   Pressed = 0

   `box
   ink 0, 0
   box x - 50, y - 8, x + 50, y + 8
   if mousex() > x - 50 and mousex() < x + 50 and mousey() > y - 8 and mousey() < y + 8
      ink rgb(100, 100, 255), 0
      Pressed = 1
   else
      ink rgb(255, 255, 255), 0
   endif
   box x - 49, y - 7, x + 49, y + 7

   `Text
   ink 0, 0
   center text x, y - text height(txt$)/2, txt$

   if mouseclick() = 0 then Pressed = 0

endfunction Pressed

function PositionCursor(cur, w, tx, tz)

   `Calculate position
   Ctx# = (tx * World(w).sx# / World(w).tx) - (World(w).sx#/2)
   Ctz# = (tz * World(w).sz# / World(w).tz) - (World(w).sz#/2)
   if tx >= 0 and tx <= World(w).tx
      if tz >= 0 and tz <= World(w).tz
         Cty# = World(w).sy# / maxHeight * Heightmap(w, tx + 1, tz + 1)
      endif
   endif

   `Update position
   position object cur, Ctx#, Cty#, Ctz#

endfunction

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         `Turned tiles
         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |\    |
         | \   |
         |   \ |
         |    \|
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

`>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<
Tools:
data "Point path"
data "4 point path"
data "Round Hill"

end

Rem Project: 007Terrain
Rem Created: 23/05/2006 01:02:57

Rem ***** Main Source File *****

rem **************************************************

    Gosub INIT_VariablesAndDatastructures

    InitDisplay()

    CreateMain()

    CreateButtons()

    CreateBrushTexture()

    DefaultTerrain()

rem **************************************************
rem **************************************************
rem **************************************************

    set current bitmap 0

    do

        rem **************************************************
        rem Refresh main GUI to enable menu change
        rem **************************************************

        paste image 1,0,0,1

        rem **************************************************
        rem Check for new action
        rem **************************************************

        MseBtn = mouseclick()

        if mousex() >= 24 and mousex() <=1000 and mousey() >= 24 and mousey() <=640

            rem Actions when mouse in viewport
            select OD(0).MainAction

                case 1

                     MoveCamera( MseBtn )

                endcase

                case 2

                    if controlkey() then MoveCamera( MseBtn )

                    if MseBtn

                        if not controlkey() then  RaiseLower( MseBtn )

                    endif

                    MoldBrushToTerrain()
                    PositionBrush()

                endcase

            endselect

        else

            rem Check for a menu button press
            if MseBtn

                Button = CheckMainButtons()

                if Button <> -1

                    Buttons(Button).State = 1
                    ClearButtonGroup( "MAIN", Button )

                    OD(0).Menu = Buttons(Button).Action
                    OD(0).Group = Buttons(Button).Title

                else

                    if OD(0).Menu <> -1

                        Button = CheckSubButtons( OD(0).Group )

                        if Button <> - 1

                            rem **************************************************
                            rem Instigate a repeat delay
                            rem **************************************************

                            if OD(0).LastButton = Button

                                Buttons(Button).State = 1
                                OD(0).Action = Buttons(Button).Action

                                if OD(0).RepeatCount = -1

                                    OD(0).RepeatCount = 1

                                else

                                    inc OD(0).RepeatCount

                                    if OD(0).RepeatCount >= OD(0).RepeatDelay

                                        OD(0).RepeatCount = 0
                                        OD(0).RepeatDelay = 5

                                    endif

                                endif

                            else

                                if OD(0).RepeatCount = -1

                                    Buttons(Button).State = 1
                                    OD(0).Action = Buttons(Button).Action
                                    OD(0).LastButton = Button

                                endif

                            endif

                        endif

                    endif

                endif

            else

                OD(0).Action = -1
                OD(0).RepeatCount = -1
                OD(0).LastButton = -1
                OD(0).RepeatDelay = 50

            endif

        endif

        rem **************************************************
        rem Display menu's and buttons in current state
        rem **************************************************

        ShowButtons( "MAIN" )

        if OD(0).Menu <> -1

            DisplaySubMenu()

        endif

        rem **************************************************
        rem Show brush co-ordinates and range
        rem **************************************************

        TSize# = ( TD(0).Segments * TD(0).SegSize ) / 2
        BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / TD(0).SegSize )
        BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / TD(0).SegSize )

        BrushX$ = str$( BrushX ): if BD(0).Width > 1 then BrushX$ = BrushX$ + " - " + str$( BrushX + BD(0).Width - 1 )
        BrushZ$ = str$( BrushZ ): if BD(0).Length > 1 then BrushZ$ = BrushZ$ + " - " + str$( BrushZ + BD(0).Length - 1 )

        set text size 16
        center text 64,700,"Brush X": center text 64,720,BrushX$
        center text 128,700,"Brush Z": center text 128,720,BrushZ$

        rem **************************************************
        rem Perform current action if any
        rem **************************************************

        if OD(0).Action <> -1

            PerformCurrentAction()

        endif

        rem **************************************************
        rem **************************************************

        sync

    loop

rem **************************************************
rem **************************************************
rem **************************************************

function RaiseLower( UpDown )

    TSize# = ( TD(0).Segments * TD(0).SegSize ) / 2

    Adjust# = BD(0).Magnitude / 10.0
    if UpDown = 2 then Adjust# = Adjust# * -1

    lock vertexdata for limb 1,0,1

    BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / TD(0).SegSize )
    BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / TD(0).SegSize )

    TWidth_Offset = ( TD(0).Segments * 6 )

    for z = 0 to BD(0).Length-1

        for x = 0 to BD(0).Width-1

            vert_x = BrushX + x
            vert_z = BrushZ + z

            if vert_x >= 0 and vert_x <= TD(0).Segments and vert_z >=0 and vert_z <= TD(0).Segments

                Heights#( vert_x, vert_z ) = Heights#( vert_x, vert_z ) + adjust#

                rem 1st vertex
                prime_index = ( vert_x * 6 ) + ( vert_z * TWidth_Offset )
                if vert_x < TD(0).Segments and vert_z < TD(0).Segments
                    ChangeVertexHeight( prime_index, Heights#( vert_x, vert_z ) )
                endif

                if vert_x > 0 and vert_z < TD(0).Segments

                    rem 2nd vertex
                    vert_index = prime_index - 1
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Heights#( vert_x, vert_z ) )

                    rem 3rd vertex
                    vert_index = prime_index - 4
                    if vert_index >=0 then ChangeVertexHeight( vert_index, Heights#( vert_x, vert_z ) )

                endif

                if vert_z > 0

                    if vert_x > 0
                        rem 4th vertex
                        vert_index = prime_index - ( TWidth_Offset + 2 )
                        if vert_index >=0 then ChangeVertexHeight( vert_index, Heights#( vert_x, vert_z ) )
                    endif

                    if vert_x < TD(0).Segments
                        rem 5th vertex
                        vert_index = prime_index - ( TWidth_Offset - 1 )
                        if vert_index >=0 then ChangeVertexHeight( vert_index, Heights#( vert_x, vert_z ) )

                        rem 6th vertex
                        vert_index = prime_index - ( TWidth_Offset - 3 )
                        if vert_index >=0 then ChangeVertexHeight( vert_index, Heights#( vert_x, vert_z ) )
                    endif

                endif

            endif

        next x

    next z

    unlock vertexdata

endfunction

function ChangeVertexHeight( vert_index, NewHeight# )

    vx# = get vertexdata position x( vert_index )
    vy# = get vertexdata position y( vert_index )
    vz# = get vertexdata position z( vert_index )

    set vertexdata position vert_index, vx#, NewHeight#, vz#

endfunction

function CircleFill( cx,cy,rad )

    radsq = rad^2

    for x = 0 to rad

        y = sqrt( radsq - ( x^2 ) )

        line cx+x, cy+y, cx+x, cy-1-y
        line cx-1-x, cy+y, cx-1-x, cy-1-y

    next x

endfunction

function IsEven( CheckNum# )

    if CheckNum# / 2 = Int(CheckNum# / 2)
        Result = 1
    else
        Result = 0
    endif

endfunction Result

function PositionBrush()

    CamXpos# = camera position x()
    CamYpos# = camera position y()
    CamZpos# = camera position z()
    CamXang# = camera angle x()

    roughd# = CamYpos#

    pick screen mousex(), mousey(), roughd#

    bx# = get pick vector x()
    by# = get pick vector y()
    bz# = get pick vector z()

    Factor# = -( CamYpos# / by# )

    bx#=bx#*Factor#
    by#=by#*Factor#
    bz#=bz#*Factor#

    off# = TD(0).SegSize / -2

    boffx# = (BD(0).Width - 1) * off#
    boffz# = (BD(0).Length - 1) * off#

    BD(0).Xpos = RoundOff( (CamXpos# + bx# + boffx# ) / TD(0).SegSize ) * TD(0).SegSize + off#
    BD(0).Zpos = RoundOff( (CamZpos# + bz# + boffz# ) / TD(0).SegSize ) * TD(0).SegSize + off#
    BD(0).YPos = 0: rem CamYpos# + by#

    position object 2, BD(0).Xpos, BD(0).YPos, BD(0).Zpos

endfunction

function RoundOff( Value# )

    IntPart = floor(Value#)
    Decimal# = Value# - IntPart
    if Decimal# >= 0.5
        Result = ceil(Value#)
    else
        Result = floor(Value#)
    endif

endfunction Result

function MoveCamera( MoveType )

    Xpos# = camera position x()
    Ypos# = camera position y()
    Zpos# = camera position z()

    Xang# = camera angle x()
    Yang# = camera angle y()
    Zang# = camera angle z()

    XSpeed# = mousemovex()
    YSpeed# = mousemovez() / - 10.0
    ZSpeed# = mousemovey()

    rem Also need zoom keys incase no mouse wheel
    if YSpeed# = 0

        YSpeed# = ( keystate(31) - keystate(17) )
        YSpeed#=YSpeed# / 5.0

    endif

    SpeedScale# = ( Ypos# / 100 )
    if SpeedScale# > 1.0 then SpeedScale# = 1.0
    if SpeedScale# < 0.05 then SpeedScale# = 0.05

    select MoveType

        case 1

            XSpeed# = XSpeed# * SpeedScale#
            ZSpeed# = ZSpeed# * SpeedScale#

            Xpos# = newxvalue( Xpos#, Yang#, ZSpeed# )
            Zpos# = newzvalue( Zpos#, Yang#, ZSpeed# )

            Xpos# = newxvalue( Xpos#, wrapvalue( Yang# + 90 ), -XSpeed# )
            Zpos# = newzvalue( Zpos#, wrapvalue( Yang# + 90 ), -XSpeed# )

        endcase

        case 2

            inc YAng#, XSpeed#
            inc Xang#, ZSpeed#

            rem if wrapvalue(XAng#) >85 then XAng# = 85
            rem if wrapvalue(XAng#) <10 then XAng# = 10

        endcase

    endselect

    if YSpeed# <0 then YSpeed# = YSpeed# * SpeedScale#
    Ypos# = Ypos# + YSpeed#

    position camera Xpos#, Ypos#, Zpos#
    rotate camera XAng#, YAng#, ZAng#

endfunction

function DefaultTerrain()

    TD(0).Name = "Default"
    TD(0).Segments = 50
    TD(0).SegSize = 10
    TD(0).Saved = 0

    CreateTerrain()

    BD(0).Width = 1
    BD(0).Length = 1
    BD(0).Magnitude = 1

    OD(0).Menu = 4
    OD(0).MainAction = 1

endfunction

function MoldBrushToTerrain()

    BWidth_Offset = ( BD(0).Width * 12 )
    TSize# = ( TD(0).Segments * TD(0).SegSize ) / 2
    BSegSize# = TD(0).SegSize / 2

    BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / TD(0).SegSize )
    BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / TD(0).SegSize )

    BSegX# = BD(0).Width * 2
    BSegZ# = BD(0).Length * 2

    BSizeX# = BD(0).Width * TD(0).SegSize
    BSizeZ# = BD(0).Length * TD(0).SegSize

    lock vertexdata for limb 2,0,1

    for z = 0 to BSegZ#-1

        for x = 0 to BSegX#-1

            Brush_Vx# = BD(0).Xpos + ( x * BSegSize# )
            Brush_Vz# = BD(0).Zpos + ( z * BSegSize# )

            rem ****************************************************
            rem Calculate heights
            rem ****************************************************

            if Brush_Vx# >= -TSize# and Brush_Vx# <= TSize# and Brush_Vz# >= -TSize# and Brush_Vz# <= TSize#

                Hx = BrushX + floor( x/2 )
                Hz = BrushZ + floor( z/2 )

                if Hx < TD(0).Segments
                    rgtht# = Heights#( Hx+1, Hz )
                else
                    rgtht# = 0
                endif

                if Hz < TD(0).Segments
                    topht# = Heights#( Hx, Hz+1 )
                else
                    topht# = 0
                endif

                if Hz > 0
                    btmht# = Heights#( Hx, Hz-1 )
                else
                    btmht# = 0
                endif

                if Hx < TD(0).Segments and Hz > 0
                    btmrgtht# = Heights#( Hx+1, Hz-1 )
                else
                    btmrgtht# = 0
                endif

                if Hx > 0
                    lftht# = Heights#( Hx-1, Hz )
                else
                    lftht# = 0
                endif

                if Hx > 0 and Hz < TD(0).Segments
                    toplftht# = Heights#( Hx-1, Hz+1 )
                else
                    toplftht# = 0
                endif

                if IsEven(x+1)=1 and IsEven(z+1)=1

                    Height1# = Heights#( Hx, Hz )
                    Height2# = ( Heights#( Hx, Hz ) + topht# ) / 2
                    Height3# = ( Heights#( Hx, Hz ) + rgtht# ) / 2
                    Height4# = ( topht# + rgtht# ) / 2

                endif

                if IsEven(x+1)=1 and IsEven(z+1)=0

                    Height1# = ( Heights#( Hx, Hz ) + btmht# ) / 2
                    Height2# = Heights#( Hx, Hz )
                    Height3# = ( Heights#( Hx, Hz ) + btmrgtht# ) / 2
                    Height4# = ( Heights#( Hx, Hz ) + rgtht# ) / 2

                endif

                if IsEven(x+1)=0 and IsEven(z+1)=1

                    Height1# = ( lftht# + Heights#( Hx, Hz ) ) / 2
                    Height2# = ( toplftht# + Heights#( Hx, Hz ) ) / 2
                    Height3# = Heights#( Hx, Hz )
                    Height4# = ( Heights#( Hx, Hz ) + topht# ) / 2

                endif

                if IsEven(x+1)=0 and IsEven(z+1)=0

                    Height1# = ( lftht# + btmht# ) / 2
                    Height2# = ( lftht# + Heights#( Hx, Hz ) ) / 2
                    Height3# = ( Heights#( Hx, Hz ) + btmht# ) / 2
                    Height4# = Heights#( Hx, Hz )

                endif

            else

                Height1# = 0
                Height2# = 0
                Height3# = 0
                Height4# = 0

            endif

            rem ****************************************************
            rem Set heights
            rem ****************************************************

            rem 1st vertex
            prime_index = ( x * 6 ) + ( z * BWidth_Offset )
            ChangeVertexHeight( prime_index, Height1#+0.1 )

            rem 2nd vertex
            vert_index = prime_index + 1
            ChangeVertexHeight( vert_index, Height2#+0.1 )

            rem 3rd vertex
            vert_index = prime_index + 2
            ChangeVertexHeight( vert_index, Height3#+0.1 )

            rem 4th vertex
            vert_index = prime_index + 3
            ChangeVertexHeight( vert_index, Height2#+0.1 )

            rem 5th vertex
            vert_index = prime_index + 4
            ChangeVertexHeight( vert_index, Height4#+0.1 )

            rem 6th vertex
            vert_index = prime_index + 5
            ChangeVertexHeight( vert_index, Height3#+0.1 )

        next x

    next z

    unlock vertexdata

endfunction

function CreateBrushMesh( Shape )

    BSegSize# = TD(0).SegSize / 2

    BSegX# = BD(0).Width * 2
    BSegZ# = BD(0).Length * 2

    Memblock=1
    VertexCount = BSegX# * BSegZ# * 6

    make memblock Memblock, ( VertexCount * 36 ) + 12

    write memblock dword Memblock, 0, 338

    write memblock dword Memblock, 4, 36

    write memblock dword Memblock, 8, VertexCount

    PTR=12

    for z = 0 to BSegZ# - 1

        for x = 0 to BSegX# - 1

            lft# = x*BSegSize#
            rgt# = (x+1)*BSegSize#
            btm# = z*BSegSize#
            top# = (z+1)*BSegSize#

            lftU# = x / BSegX#
            rgtU# = (x+1) / BSegX#
            btmV# = z / BSegZ#
            topV# = (z+1) / BSegZ#

            col =  rgb(255,255,255)
            rem First triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col, lftU#, btmV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

            rem Second Triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

        next x

    next z

    make mesh from memblock 1, 1
    delete memblock 1

    if object exist(2)
        change mesh 2, 0, 1
    else
        make object 2, 1, 0
    endif

    delete mesh 1

    set object texture 2,0,8
    texture object 2,Shape

    ghost object on 2
    fade object 2, 50

endfunction

function CreateBrushTexture()

    create bitmap 2,256,256
    ink rgb(200,200,255),rgb(200,200,255)

    box 0,0,256,256

    get image 2,0,0,256,256,1

    cls 0

    CircleFill( 128,128,127 )

    get image 3,0,0,256,256,1

endfunction

function CreateTerrain()

    dim Heights#( TD(0).Segments, TD(0).Segments )

    TSize = TD(0).Segments * TD(0).SegSize
    offset# = TSize / -2

    if object exist(1) then delete object 1

    CreateMeshFromHeights( 0, 0, TD(0).Segments, TD(0).Segments, TD(0).SegSize )
    make object 1, 1, 0
    delete mesh 1

    set object wireframe 1,1
    set object cull 1,1

    position object 1, offset#,0,offset#

    position camera 0,100,0
    xrotate camera 10

endfunction

function WriteVertexToMemblock( Memblock, PTR, X#, Y#, Z#, NX#, NY#, NZ#, COL, U#, V# )

    Rem Vertex Xpos
    write memblock float Memblock, PTR, X#
    inc PTR,4

    Rem Vertex Ypos
    write memblock float Memblock, PTR, Y#
    inc PTR,4

    Rem Vertex Zpos
    write memblock float Memblock, PTR, Z#
    inc PTR,4

    rem Vertex Normal X
    write memblock float Memblock, PTR, NX#
    inc PTR,4

    rem Vertex Normal Y
    write memblock float Memblock, PTR, NY#
    inc PTR,4

    rem Vertex Normal Z
    write memblock float Memblock, PTR, NZ#
    inc PTR,4

    rem Vertex Colour
    write memblock dword Memblock, PTR, COL
    inc PTR,4

    rem Vertex Texture U Co-ord
    write memblock float Memblock, PTR, U#
    inc PTR,4

    rem Vertex Texture V Co-ord
    write memblock float Memblock, PTR, V#
    inc PTR,4

endfunction PTR

function CreateMeshFromHeights( StartX, StartZ, SegX, SegZ, SegSize )

    Memblock=1
    VertexCount = ( SegX * SegZ )*6

    make memblock Memblock, (VertexCount * 36) + 12

    write memblock dword Memblock, 0, 338

    write memblock dword Memblock, 4, 36

    write memblock dword Memblock, 8, VertexCount

    PTR=12

    for z = 0 to SegZ-1

        for x = 0 to SegX-1

            lft# = x*SegSize
            rgt# = (x+1)*SegSize
            btm# = z*SegSize
            top# = (z+1)*SegSize

            lftU# = x / SegX
            rgtU# = (x+1) / SegX
            btmV# = z / SegZ
            topV# = (z+1) / SegZ

            col =  rgb(rnd(100)+50,rnd(100)+150,0)
            rem First triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col , lftU#, btmV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

            rem Second Triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

        next x

    next z

    make mesh from memblock 1, 1
    delete memblock 1

endfunction

function CreateButtons()

    sync
    restore ButtonData

    for l = 0 to ButtonCount(0)

        read Buttons( l ).Group
        read Buttons( l ).SubGroup
        read Buttons( l ).Title
        read Buttons( l ).Action
        read Buttons( l ).Xpos
        read Buttons( l ).Ypos
        read Buttons( l ).Width
        read Buttons( l ).Height

        Buttons( l ).State = -1

        if bitmap exist(2) = 1
            delete bitmap 2
        endif

        create bitmap 2, Buttons( l ).Width, Buttons( l ).Height

        Buttons( l ).UpImage = CreateButton( l, (l*2)+4, 0, rgb( 100,50,50), rgb(255,255,0) )
        Buttons( l ).DnImage = CreateButton( l, (l*2)+5, 1, rgb( 100,50,50), rgb(255,255,0) )

        delete bitmap 2

    next l

endfunction

function CreateButton( BI, ImageNum, State, BackColour, TextColour )

    cls BackColour

    set text font "Arial"
    set text to bold
    set text size 14

    x = ( Buttons( BI ).Width / 2 )
    y = ( Buttons( BI ).Height / 2 ) - 7

    Width = Buttons( BI ).Width
    Height = Buttons( BI ).Height

    ink 0,0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    if state = 0
        ink rgb(255,255,255),0
    else
        ink 0,0
    endif

    line 1,1,1,Height-1
    line 1,1,Width-1,1

    if state = 0
        ink 0,0
    else
        ink rgb(255,255,255),0
    endif

    line Width-3,Height-3,Width-3,1
    line Width-3,Height-3,1,Height-3

    ink rgb(1,1,1),0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    line 0,0,Width,0
    line 0,0,0,Height
    line 0,Height,Width,Height
    line Width,Height,Width,0

    ink TextColour,0
    center text x, y, Buttons( BI ).Title

    get image ImageNum, 0, 0, Width, Height

endfunction ImageNum

function CheckMainButtons()

    ButtonPressed = -1

    for l = 0 to 2

        xmin = Buttons( l ).Xpos
        ymin = Buttons( l ).Ypos
        xmax = xmin + Buttons( l ).Width
        ymax = ymin + Buttons( l ).Height

        if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

            ButtonPressed = l

        endif

    next l

endfunction ButtonPressed

function CheckSubButtons( Group$ )

    ButtonPressed = -1

    for l = 3 to ButtonCount(0)

        if Buttons(l).Group = Group$

            xmin = Buttons( l ).Xpos
            ymin = Buttons( l ).Ypos
            xmax = xmin + Buttons( l ).Width
            ymax = ymin + Buttons( l ).Height

            if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

                ButtonPressed = l

            endif

        endif

    next l

endfunction ButtonPressed

function ClearButtonGroup( Group$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).Group = Group$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ClearButtonSubGroup( SubGroup$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).SubGroup = SubGroup$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ShowButtons( Group$ )

    for l = 0 to ButtonCount(0)

        if Buttons( l ).Group = Group$

            if Buttons( l ).State = 1

                img = Buttons( l ).DnImage

            else

                img = Buttons( l ).UpImage

            endif

            paste image img, Buttons( l ).Xpos, Buttons( l ).Ypos

        endif

    next l

endfunction

function InitDisplay()

    set display mode 1024,768,32

    autocam off

    sync on
    sync rate 0

    set camera view 24,24,1000,640

    set ambient light 15

    fog on
    fog color 100,100,200
    fog distance 2000

    backdrop on
    color backdrop rgb(100,100,125)

endfunction

function CreateMain()

    create bitmap 1,1024,768

    cls rgb(100,100,100)

    ink rgb(1,1,1),0
    box 3,3,1021,765

    ink rgb(100,150,100),0
    box 4,4,1020,764

    rem Viewport
    ink rgb(1,1,1),0
    box 22,22,1002,642
    ink 0,0
    box 24,24,1000,640

    rem sub action panel
    ink rgb(1,1,1),0
    box 254,654,1002,746
    ink rgb(90,110,90),0
    box 256,656,1000,744

    get image 1,0,0,1024,768
    delete bitmap 1

endfunction

function DisplaySubMenu()

    ink rgb(10,40,10),0
    set text size 12

    select OD(0).Menu

        rem File Menu
        case 1

            if object exist(2) then delete object 2

            text 270,666, "Filename"
            text 340,666, ":  " + TD(0).Name
            text 270,692, "Segments"
            text 340,692, ":  " + str$( TD(0).Segments )
            text 270,718, "Seg Size"
            text 340,718, ":  " + str$( TD(0).SegSize )

            OD(0).MainAction = 1

        endcase

        rem Mold Menu
        case 2

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            if OD(0).MainAction <>2

                if Buttons(12).State = 1 then BD(0).MBShape = 2
                if Buttons(13).State = 1 then BD(0).MBShape = 3

                if BD(0).MBShape = 0

                    Buttons(12).State = 1
                    BD(0).MBShape = 2

                endif

                CreateBrushMesh( BD(0).MBShape )
                OD(0).MainAction = 2

            endif

        endcase

        rem Paint Menu
        case 3

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            OD(0).MainAction = 3

        endcase

        case 4

            text 270,660, "Welcome to the 007 Terrain Editor by McLaine."
            text 270,676, "In 'FILE' mode, move and turn by clicking and dragging in the viewport. 'W' & 'S' or mousewheel to zoom."
            text 270,692, "In 'MOLD' mode, Left Click in viewport to raise ground. Right Click to lower ground."
            text 270,708, "In 'MOLD' mode, hold control to allow camera movement as in 'FILE' mode."
            text 270,724, "There are some bugs, most notably 'NORM' and 'SMOOTH'. They work but are slow and unpredictable."

        endcase

    endselect

    ShowButtons( OD(0).Group )

endfunction

function PerformCurrentAction()

    select OD(0).Menu

        case 1

            FileAction()

        endcase

        case 2

            MoldAction()

        endcase

        case 3

            PaintAction()

        endcase

    endselect

endfunction

function FileAction()

    if OD(0).RepeatCount <= 0

       select OD(0).Action

           rem Load Terrain
           case 1

               set cursor 550,666
               input "Load file: ", fn$

           endcase

           rem Save Terrain
           case 2

               set cursor 550,666
               input "Save as: ", fn$

           endcase

           rem New Terrain
           case 3

               set cursor 550,666
               input "New filename: ", TD(0).Name
               set cursor 550,692
               input "Segments: ", TD(0).Segments
               set cursor 550,718
               input "Segment Size: ", TD(0).SegSize

               CreateTerrain()

           endcase

       endselect

    endif

    ClearButtonGroup( "FILE", -1 )
    OD(0).Action = -1

endfunction

function MoldAction()

    if OD(0).Action >=1 and OD(0).Action <=6

        if OD(0).RepeatCount <=0

            ChangeBrushSize()
            CreateBrushMesh( BD(0).MBShape )

        endif

        ClearButtonSubGroup( "MBSIZE", -1 )

    endif

    if OD(0).Action = 7 or OD(0).Action = 8

        if OD(0).RepeatCount <=0

            ChangeBrushShape()
            CreateBrushMesh( BD(0).MBShape )

        endif

        ClearButtonSubGroup( "MBSHAPE", OD(0).LastButton )

    endif

    if OD(0).Action >= 9 and OD(0).Action <=12

            ClearButtonSubGroup( "MBTYPE1", OD(0).LastButton )

    endif

    if OD(0).Action = 13

        if OD(0).RepeatCount <=0

            if TD(0).Solid = 0

                TD(0).Solid = 1
                set object wireframe 1, 0

            else

                TD(0).Solid = 0
                set object wireframe 1, 1

            endif

        else

            rem No Repeat
            OD(0).RepeatCount = 1

        endif

        if TD(0).Solid = 0 then ClearButtonSubGroup( "TTYPE", -1 )

    endif

    if OD(0).Action >= 13 and OD(0).Action <=15

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 14

                    lock vertexdata for limb 1,0
                    set object normals 1
                    unlock vertexdata

                endcase

                case 15

                    set object smoothing 1, 50

                endcase

            endselect

        else

            rem No Repeat
            OD(0).RepeatCount = 1

        endif

        ClearButtonSubGroup( "TEROP", -1 )

    endif

    OD(0).Action = -1

endfunction

function PaintAction()

endfunction

function ChangeBrushShape()

    select OD(0).Action

        case 7

            BD(0).MBShape = 2

        endcase

        case 8

            BD(0).MBShape = 3

        endcase

    endselect

endfunction

function ChangeBrushSize()

    select OD(0).Action

        rem Decrease Brush Width
        case 1

            if BD(0).Width > 1 then dec BD(0).Width

        endcase

        rem Increase Brush Width
        case 2

            if BD(0).Width < TD(0).Segments then inc BD(0).Width

        endcase

        rem Decrease Brush Length
        case 3

            if BD(0).Length > 1 then dec BD(0).Length

        endcase

        rem Increase Brush Length
        case 4

            if BD(0).Length < TD(0).Segments then inc BD(0).Length

        endcase

        rem Decrease Brush Magnitude
        case 5

            if BD(0).Magnitude > 1 then dec BD(0).Magnitude

        endcase

        rem Increase Brush Magnitude
        case 6

            if BD(0).Magnitude < 100 then inc BD(0).Magnitude

        endcase

    endselect

endfunction

rem **************************************************

INIT_VariablesAndDatastructures:

    type Camera

        XPos# as float
        YPos# as float
        ZPos# as float

        XAng# as float
        YAng# as float
        ZAng# as float

        Pitch# as float
        Yaw# as float
        Roll# as float

        Slide# as float
        Speed# as float

    endtype

    type Button

        Group as string
        SubGroup as string
        Title as string
        Action as integer
        Xpos as integer
        Ypos as integer
        Width as integer
        Height as integer
        State as integer
        UpImage as integer
        DnImage as integer

    endtype

    type Terrain

        Name as String
        Segments as integer
        SegSize as float
        Saved as integer
        Solid as integer

    endtype

    type Operation

        Menu as integer
        Group as string
        MainAction as integer
        Action as integer
        LastButton as integer
        RepeatCount as integer
        RepeatDelay as integer

    endtype

    type Brush

        Width as integer
        Length as integer
        Magnitude as integer
        MBShape as integer
        Xpos as float
        Ypos as float
        Zpos as float

    endtype

    dim PD(0) as Camera
    dim TD(0) as Terrain
    dim OD(0) as Operation
    dim BD(0) as Brush

    dim ButtonCount(0) as integer
        ButtonCount(0)= 18

    dim Buttons( ButtonCount(0) ) as Button

return

rem **************************************************

ButtonData:
data "MAIN", "MAIN", "FILE", 1, 28, 656, 64, 24
data "MAIN", "MAIN", "MOLD", 2, 102, 656, 64, 24
data "MAIN", "MAIN", "PAINT", 3, 176, 656, 64, 24
data "FILE", "FILE", "LOAD", 1, 450, 660, 64, 24
data "FILE", "FILE", "SAVE", 2, 450, 688, 64, 24
data "FILE", "FILE", "NEW", 3, 450, 716, 64, 24
data "MOLD", "MBSIZE", "-", 1, 400, 660, 24, 24
data "MOLD", "MBSIZE", "+", 2, 430, 660, 24, 24
data "MOLD", "MBSIZE", "-", 3, 400, 688, 24, 24
data "MOLD", "MBSIZE", "+", 4, 430, 688, 24, 24
data "MOLD", "MBSIZE", "-", 5, 400, 716, 24, 24
data "MOLD", "MBSIZE", "+", 6, 430, 716, 24, 24
data "MOLD", "MBSHAPE", "SQUARE", 7, 500, 660, 64, 24
data "MOLD", "MBSHAPE", "ROUND", 8, 500, 688, 64, 24
data "MOLD", "TTYPE", "SOLID", 13, 770, 660, 64, 24
data "MOLD", "TEROP", "NORM", 14, 770, 688, 64, 24
data "MOLD", "TEROP", "SMOOTH", 15, 770, 716, 64, 24
data "PAINT", "PBSIZE", "-", 1, 400, 660, 24, 24
data "PAINT", "PBSIZE", "+", 2, 430, 660, 24, 24
data "PAINT", "PBSIZE", "-", 3, 400, 688, 24, 24
data "PAINT", "PBSIZE", "+", 4, 430, 688, 24, 24

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

remstart
`>>>>>>>>>>>>>>>>>>>>>>>> Controls <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
viewing: Crtl + wasd keys and mouse movement
Edit: Move the cursor over the world and click to edit the height
Change current height: Drag bar up/down on the right (255 = max height)
Change current radius when in Round Hill mode: drag bar up/down on the right
Change current tool: up and down keys

Shortkeys:
W: Turns wireframe on/off (when in editing mode)
G: Turns ghost on/off (when in editing mode)
T: Turn tile when in 4-point mode.
remend

sync on : sync rate 100
autocam off

`Set font
set text font "Comic Sans MS"
set text size 16

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0
#constant maxTools = 3
#constant maxImages = 100

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer
global WireFrame as integer
global Ghosted as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
   img as integer
   imgx as integer
   imgy as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile
dim Tools(maxTools) as string

`Init tools
restore ToolsData
for i = 1 to maxTools
   read tool$
   Tools(i) = tool$
next i

`Create mouse pointer
make object cube maxWorlds + 1, 1
color object maxWorlds + 1, rgb(0, 0, 255)
set object emissive maxWorlds + 1, rgb(0,0,255)
for c = 1 to 4
   make object cube maxWorlds + 1 + c, 1
   color object maxWorlds + 1 + c, rgb(0, 255, 0)
   ghost object on maxWorlds + 1 + c
   set object emissive maxWorlds + 1 + c, rgb(0, 255, 0)
   hide object maxWorlds + 1 + c
next c

cls
ink rgb(0, 255, 0), 0
circle 100, 100, 100
get image maxImages + 4, 0, 0, 200, 200, 1

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1 : show object maxWorlds + 2
CHeight# = 0.0
Ang# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse
      if WorldCursor > 0 then gosub EditWorld

      `show cursor
      if object visible(maxWorlds + 1) = 0 then show object maxWorlds + 1
   else

      if object visible(maxWorlds + 1) = 1 then hide object maxWorlds + 1

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 and mousey() < screen height() - 20 then MouseLocked = 0

   for i = 1 to maxWorlds
      if object exist(i) > 0
         UpdateWorldObj(i)
      endif
   next i

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx1# = get pick vector x()
   my1# = get pick vector y()
   mz1# = get pick vector z()

   `Get world and intersection point
   WorldCursor = 0
   olddist# = 1500.0
   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx1#, camy# + my1#, camz# + mz1#)

         if dist# > 0.0 and dist# < olddist#
            mx# = (mx1# / 1500.0 * dist#)
            my# = (my1# / 1500.0 * dist#)
            mz# = (mz1# / 1500.0 * dist#)
            WorldCursor = w
            olddist# = dist#
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer(s) position
   if WorldCursor > 0
      tx# = World(WorldCursor).tx * ((mx# - World(WorldCursor).x#)+World(WorldCursor).sx#/2) / World(WorldCursor).sx#
      tz# = World(WorldCursor).tz * ((mz# - World(WorldCursor).z#)+World(WorldCursor).sz#/2) / World(WorldCursor).sz#
      select CTool
         case 1
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
         endcase
         case 2
            tx = int(tx#) : tz = int(tz#)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
            PositionCursor(maxWorlds + 3, WorldCursor, tx + 1, tz)
            PositionCursor(maxWorlds + 4, WorldCursor, tx, tz + 1)
            PositionCursor(maxWorlds + 5, WorldCursor, tx + 1, tz + 1)
         endcase
         case 3
            Ang# = wrapvalue(Ang# + 1.0)
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            for c = 1 to 4
               x# = mx# + cos(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sx# / World(WorldCursor).tx)
               z# = mz# + sin(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sz# / World(WorldCursor).tz)
               position object maxWorlds + 1 + c, x#, World(WorldCursor).y# + intersect object(WorldCursor, x#, World(WorldCursor).y#, z#, x#, World(WorldCursor).y# + World(WorldCursor).sy#, z#), z#
            next c
         endcase
      endselect
   endif

return

EditWorld:

   `Change Edit Mode
   if upkey() = 1 and KeyHold = 0
      KeyHold = 1
      inc CTool
   endif
   if downkey() = 1 and KeyHold = 0
      KeyHold = 1
      dec CTool
   endif

   `Check
   if KeyHold > 0

      `Boundry
      if CTool < 1 then CTool = maxTools
      if CTool > maxTools then CTool = 1

      `Hide - unhide cursor
      select CTool
         case 1
            show object maxWorlds + 2
            hide object maxWorlds + 3
            hide object maxWorlds + 4
            hide object maxWorlds + 5
         endcase
         case 2
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
         case 3
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
      endselect
   endif

   `Get tool
   select CTool
      case 1
         if mouseclick() = 1 then Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#
      endcase
      case 2

         if mouseclick() = 1
            if tx >= 0 and tz >= 0
               `First point
               if tx <= World(WorldCursor).tx and tz <= World(WorldCursor).tz
                  Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#

                  `Second point
                  if tx <= World(WorldCursor).tx - 1
                     Heightmap(WorldCursor, tx + 2, tz + 1) = CHeight#
                     `Third point
                     if tz <= World(WorldCursor).tz - 1
                        Heightmap(WorldCursor, tx + 2, tz + 2) = CHeight#
                     endif
                  endif

                  `Last point
                  if tz <= World(WorldCursor).tz -1
                     Heightmap(WorldCursor, tx + 1, tz + 2) = CHeight#
                  endif
               endif
            endif
         endif

      endcase
      case 3

         rad = int(CHeight# * 0.2)

         if mouseclick() = 1 then in = 1
         if mouseclick() = 2 then in = -1

         `Calculate all positions
         if mouseclick() > 0
            for x = int(tx - rad) to int(tx + rad) + 1
               for y = int(tz - rad) to int(tz + rad) + 1

                  `Calc distance
                  set vector3 1, tx - x, 0, tz - y
                  Dist# = length vector3(1)

                  `If that distance <= rad then that point is edited
                  if Dist# <= rad

                     `Check if the point is in the world
                     if x >= 0 and x <= World(WorldCursor).tx
                        if y >= 0 and y <= World(WorldCursor).tz

                           `Increase height
                           Height = Heightmap(WorldCursor, x + 1, y + 1) + (rad - Dist#) * in

                           `Boundries
                           if Height < 0 then Height = 0
                           if Height > maxHeight then Height = maxHeight

                           `Update
                           Heightmap(WorldCursor, x + 1, y + 1) = Height

                        endif
                     endif

                  endif
               next y
            next x
         endif
      endcase
   endselect

   if mouseclick() > 0
      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Right click
   if keystate(20) = 1 and CTool = 2 and KeyHold = 0
      KeyHold = 1

      `Boundries
      if tx >= 0 and tz >= 0
         if tx <= World(WorldCursor).tx - 1 and tz <= World(WorldCursor).tz - 1
            if Tile(WorldCursor, tx + 1, tz + 1).turned = 0
               Tile(WorldCursor, tx + 1, tz + 1).turned = 1
            else
               Tile(WorldCursor, tx + 1, tz + 1).turned = 0
            endif
         endif
      endif

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Wireframe on off
   if keystate(17) > 0 and KeyHold = 0
      KeyHold = 1
      Wireframe = abs(Wireframe - 1)
      if Wireframe = 1 then set object wireframe WorldCursor, 1 else set object wireframe WorldCursor, 0
   endif
   if keystate(34) > 0 and KeyHold = 0
      KeyHold = 1
      Ghosted = abs(Ghosted - 1)
      if Ghosted = 1 then ghost object on WorldCursor else ghost object off WorldCursor
   endif

   `Unlock keyhold
   if upkey() + downkey() + mouseclick() + keystate(17) + keystate(34) + keystate(20) = 0 then KeyHold = 0

return

HUDControl:

   `Display cursor information
   ink rgb(255, 255, 255), 0
   set cursor 0, 0
   print "Tile: ", tx, " : ", tz
   print "Pointed world: ", WorldCursor
   print "Current tool: " + Tools(CTool)

   `Additional message
   ink rgb(0,255,0),0
   if msg$ <> ""
      inc Time
      print msg$
   else
      Time = 0
   endif
   if Time > 250 then msg$ = ""

   `Height indicator
   ink rgb(255, 0, 0), 0
   line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   if CTool = 3
      center text screen width() - 10, 10, str$(int(CHeight# * 0.2))
   else
      center text screen width() - 10, 10, str$(CHeight#)
   endif

   `Right menu
   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

   `Bottom menu
   if mousey() > screen height() - 20
      MouseLocked = 1
   endif

   `Tools
   if button(60, screen height() - 10, "Tools") > 0 then gosub Tools
   if button(170, screen height() - 10, "Export") > 0 then gosub Export
   if button(280, screen height() - 10, "Exit") > 0 then end

return

Tools:

   `Get background image
      `Background
      ink rgb(255, 255, 255), 0
      box 50, 50, 450, 350
   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Initialize
   FillWorld = 1 : FillHeight = 0
   FHeight = 0 : THeight = 0
   MouseTimer = 0
   TilesX = 1 : TilesZ = 1
   Tool = 1 : GoOut = 0
   posx$ = str$(World(1).x#) : posy$ = str$(World(1).y#) : posz$ = str$(World(1).z#)
   sizex$ = str$(World(1).sx#) : sizey$ = str$(World(1).sy#) : sizez$ = str$(World(1).sz#)

   clear entry buffer

   do

      `Background
      paste image maxImages + 1, 0, 0

      `Select tool
      if textbutton(85, 80, "<") > 0 and hold = 0
         hold = 1
         dec Tool
         if Tool < 1 then Tool = 1
      endif
      if textbutton(250, 80, ">") > 0 and hold = 0
         hold = 1
         inc Tool
         if Tool > 5 then Tool = 5
      endif

      `Display tool

      ink rgb(0, 0, 255), 0
      select Tool
         case 1
            text 100, 75, "Create World"
            gosub CreateNewWorld
         endcase
         case 2
            text 100, 75, "Update World"
            gosub UpdateWorld
         endcase
         case 3
            text 100, 75, "Fill"
            gosub Fill
         endcase
         case 4
            text 100, 75, "Randomize"
            gosub WorldRand
         endcase
         case 5
            text 100, 75, "Smooth"
            gosub WorldSmooth
         endcase
      endselect

      `Display quit button
      if button(200, 340, "Return") > 0 then GoOut = 1

      `Unlock mouse
      if mouseclick() = 0 then hold = 0

      `Quit tools
      if GoOut > 0
         repeat : until mouseclick() = 0
         return
      endif

      sync
   loop

return

`>>>>> Tools <<<<<<<
Fill:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Height selecting
   ink 0, 0
   text 100, 115, "Height:"
   D = textbutton(250, 120, "<")
   U = textbutton(300, 120, ">")
   if U > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FillHeight
   endif
   if D > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FillHeight
   endif
   if D + U = 0 then MouseTimer = 0
   if FillHeight < 0 then FillHeight = 0
   if FillHeight > maxHeight then FillHeight = maxHeight
   ink 0, 0
   center text 275, 115, str$(FillHeight)

   `Apply button
   if button(200, 150, "Edit") > 0
      repeat
      until mouseclick() = 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FillHeight
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
      endif
      GoOut = 1
   endif
return

WorldRand:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display From and To Height
   ink 0, 0
   text 100, 115, "Min Height:"
   text 100, 135, "Max Height:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FHeight
   endif
   if D1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FHeight
   endif
   if U2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc THeight
   endif
   if D2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec THeight
   endif

   `Boundries
   if FHeight < 0 then FHeight = 0
   if FHeight > maxHeight then FHeight = maxHeight
   if THeight < 0 then THeight = 0
   if THeight > maxHeight then THeight = maxHeight

   ink 0, 0
   center text 275, 115, str$(FHeight)
   center text 275, 135, str$(THeight)

   if D1 + U1 + D2 + U2 = 0 then MouseTimer = 0

   `Apply
   if button(200, 160, "Edit") > 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FHeight + rnd(THeight - FHeight)
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

WorldSmooth:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Smooth button
   if button(200, 128, "Edit") > 0
      if object exist(FillWorld) > 0
         SmoothHeightmap(FillWorld)
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

CreateNewWorld:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) = 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display tiles
   ink 0, 0
   text 100, 115, "Tiles X:"
   text 100, 135, "Tiles Z:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then inc TilesX
   endif
   if D1 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then dec TilesX
   endif
   if U2 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then inc TilesZ
   endif
   if D2 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then dec TilesZ
   endif

   `Boundries
   if TilesX > maxTiles then TilesX = maxTiles
   if TilesZ > maxTiles then TilesZ = maxTiles
   if TilesX < 1 then TilesX = 1
   if TilesZ < 1 then TilesZ = 1

   `Display tiles
   ink 0, 0
   center text 275, 115, str$(TilesX)
   center text 275, 135, str$(TilesZ)

   `Reset timer
   if D1 + D2 + U1 + U2 = 0 then MouseTimer = 0

   `Display size
   select typ
      case 1 : add1$ = "_" : add2$ = "" : add3$ = "" : endcase
      case 2 : add1$ = "" : add2$ = "_" : add3$ = "" : endcase
      case 3 : add1$ = "" : add2$ = "" : add3$ = "_" : endcase
   endselect
   text 100, 155, "Size X:" + sizex$ + add1$
   text 100, 175, "Size Y:" + sizey$ + add2$
   text 100, 195, "Size Z:" + sizez$ + add3$

   `Type
   if mouseclick() = 1
      if mousex() > 100 and mousex() < 300
         if mousey() > 155 and mousey() < 172 then typ = 1
         if mousey() > 175 and mousey() < 183 then typ = 2
         if mousey() > 195 and mousey() < 203 then typ = 3
      endif
   endif
   if typ > 0
      char$ = entry$()
      select asc(char$)
         case 13 : typ = 0 : endcase
         case 8
            if typ = 1 then sizex$ = left$(sizex$, len(sizex$) - 1)
            if typ = 2 then sizey$ = left$(sizey$, len(sizey$) - 1)
            if typ = 3 then sizez$ = left$(sizez$, len(sizez$) - 1)
         endcase
         case default
            if typ = 1 then sizex$ = sizex$ + char$
            if typ = 2 then sizey$ = sizey$ + char$
            if typ = 3 then sizez$ = sizez$ + char$
         endcase
      endselect
   endif
   clear entry buffer

   `Create button
   if button(200, 220, "Create") > 0
      if object exist(FillWorld) = 0

         `Store variables
         World(FillWorld).sx# = val(sizex$)
         World(FillWorld).sy# = val(sizey$)
         World(FillWorld).sz# = val(sizez$)
         World(FillWorld).tx = TilesX
         World(FillWorld).tz = TilesZ

         `Create World mesh
         CreateWorldMesh(FillWorld)
         make object FillWorld, FillWorld, 0
         set object collision to polygons FillWorld
         GoOut = 1
      endif
   endif

return

UpdateWorld:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
      posx$ = str$(World(FillWorld).x#)
      posy$ = str$(World(FillWorld).y#)
      posz$ = str$(World(FillWorld).z#)
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
      posx$ = str$(World(FillWorld).x#)
      posy$ = str$(World(FillWorld).y#)
      posz$ = str$(World(FillWorld).z#)
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Get position
   `Display size
   ink 0, 0
   select typ
      case 0 : add1$ = "" : add2$ = "" : add3$ = "" : endcase
      case 1 : add1$ = "_" : add2$ = "" : add3$ = "" : endcase
      case 2 : add1$ = "" : add2$ = "_" : add3$ = "" : endcase
      case 3 : add1$ = "" : add2$ = "" : add3$ = "_" : endcase
   endselect
   text 100, 115, "Position X:" + posx$ + add1$
   text 100, 135, "Position Y:" + posy$ + add2$
   text 100, 155, "Position Z:" + posz$ + add3$

   `Type
   if mouseclick() = 1
      if mousex() > 100 and mousex() < 300
         if mousey() >= 115 and mousey() < 135 then typ = 1
         if mousey() >= 135 and mousey() < 155 then typ = 2
         if mousey() >= 155 and mousey() < 175 then typ = 3
      endif
   endif
   if typ > 0
      char$ = entry$()
      select asc(char$)
         case 13 : typ = 0 : endcase
         case 8
            if typ = 1 and len(posx$) > 0 then posx$ = left$(posx$, len(posx$) - 1)
            if typ = 2 and len(posy$) > 0 then posy$ = left$(posy$, len(posy$) - 1)
            if typ = 3 and len(posz$) > 0 then posz$ = left$(posz$, len(posz$) - 1)
         endcase
         case default
            if typ = 1 then posx$ = posx$ + char$
            if typ = 2 then posy$ = posy$ + char$
            if typ = 3 then posz$ = posz$ + char$
         endcase
      endselect
   endif
   clear entry buffer

   `Update button
   if button(200, 220, "Update") > 0
      if object exist(FillWorld) = 1

         `Store variables
         World(FillWorld).x# = val(posx$)
         World(FillWorld).y# = val(posy$)
         World(FillWorld).z# = val(posz$)

         `Create World mesh
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

   `Delete button
   if button(310, 220, "Delete") > 0
      if object exist(FillWorld) = 1

         `Reset heightmap
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tz + 1
               Heightmap(FillWorld, x, y) = 0
            next x
         next y

         `Reset tile map
         for y = 1 to World(FillWorld).tz
            for x = 1 to World(FillWorld).tx
               Tile(FillWorld, x, y).turned = FALSE
            next x
         next y

         `Reset world data
         World(FillWorld).x# = 0 : World(FillWorld).y# = 0 : World(FillWorld).z# = 0
         World(FillWorld).sx# = 0 : World(FillWorld).sy# = 0 : World(FillWorld).sz# = 0
         World(FillWorld).tx = 0 : World(FillWorld).tz = 0

         `Delete objects, meshes and memblocks
         delete object FillWorld
         if mesh exist(FillWord) > 0 then delete mesh FillWorld
         if memblock exist(FillWorld) > 0 then delete memblock FillWorld
         GoOut = 1
      endif
   endif

return

`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXPORT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Export:

   `Init
   FileExp = 0
   FileName$ = ""
   TypAct = 0

   `Get background
   ink rgb(255, 255, 255), 0
   box 5, 5, 350, 250
   ink rgb(100, 100, 255), 0
   box 10, 10, 340, 30
   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Input
   ink 0, 0
   do

      `Refresh background
      paste image maxImages + 1, 0, 0

      `Input
      if TypAct = 1
         char$ = entry$()
         select asc(char$)
            case 13
               TypAct = 0
            endcase
            case 8
               FileName$ = left$(FileName$, len(FileName$) - 1)
            endcase
            case default
               FileName$ = FileName$ + char$
            endcase
         endselect
      else

         `Type if clicked on filename area.
         if mousex() > 10 and mousex() < 340
            if mousey() > 10 and mousey() < 30
               if mouseclick() = 1 then TypAct = 1
            endif
         endif
      endif
      clear entry buffer

      `Display input
      if TypAct = 1 then add$ = "_" else add$ = ""
      text 12, 12, "Filename:" + FileName$ + add$

      `Export buttons
      if button(70, 50, "DBO object") > 0 then Msg$ = SaveDBO(FileName$) : exit
      if button(180, 50, "Heightmap") > 0 then Msg$ = SaveHeightmap(FileName$) : exit
      if button(290, 50, "Return") > 0
         exit
      endif

      sync
   loop

return

`**************************
`Functions
`**************************

function UpdateWorldObj(w)
   position object w, World(w).x#, World(w).y#, World(w).z#
endfunction

function SmoothHeightmap(w)

   `Extract data
   tx = World(w).tx + 1
   tz = World(w).tz + 1

   `temporary copy of heightmap
   dim TEMP(tx, tz)
   for y = 1 to tz : for x = 1 to tx : TEMP(x, y) = Heightmap(w, x, y) : next x : next y

   `Smooth heights
   for y = 2 to tz - 1
      for x = 2 to tx - 1

         fHeight# = TEMP(x, y) * 0.5

         `Top down left and right
         fHeight# = fHeight# + (TEMP(x - 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x + 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y - 1) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y + 1) * 0.08)

         `top-left/right and bottom-left/right
         fHeight# = fHeight# + (TEMP(x - 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x - 1, y + 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y + 1) * 0.045)

         `store final height in the destination heightmap
         Heightmap(w, x, y) = fHeight#
      next x
   next y

   `Sides
   for y = 2 to tz - 1

      `Left row
      fHeight# = TEMP(1, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(1, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(1, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(2, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(2, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(2, y + 1) * 0.045)

      Heightmap(w, 1, y) = fHeight#

      `Right row
      fHeight# = TEMP(tx, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(tx, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx - 1, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(tx - 1, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(tx - 1, y + 1) * 0.045)

      Heightmap(w, tx, y) = fHeight#
   next y

   for x = 2 to tx - 1

      `Left row
      fHeight# = TEMP(x, 1) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x + 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x - 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)

      Heightmap(w, x, 1) = fHeight#

      `Right row
      fHeight# = TEMP(x, tz) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz - 1) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x - 1, tz - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(x + 1, tz - 1) * 0.045)

      Heightmap(w, x, tz) = fHeight#
   next x

   `Corners
   fHeight# = TEMP(1, 1) * 0.795
   fHeight# = fHeight# + (TEMP(1, 2) * 0.08) + (TEMP(2,1) * 0.08) + (TEMP(2, 2) * 0.045)
   Heightmap(w, 1, 1) = fHeight#

   fHeight# = TEMP(1, tz) * 0.795
   fHeight# = fHeight# + (TEMP(1, tz - 1) * 0.08) + (TEMP(2, tz) * 0.08) + (TEMP(2, tz - 1) * 0.045)
   Heightmap(w, 1, tz) = fHeight#

   fHeight# = TEMP(tx, 1) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, 1) * 0.08) + (TEMP(tx, 2) * 0.08) + (TEMP(tx - 1, 2) * 0.045)
   Heightmap(w, tx, 1) = fHeight#

   fHeight# = TEMP(tx, tz) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, tz) * 0.08) + (TEMP(tx, tz - 1) * 0.08) + (TEMP(tx - 1, tz - 1) * 0.045)
   Heightmap(w, tx, tz) = fHeight#

   `Undim temporary array
   undim TEMP(0)

endfunction

function SaveHeightmap(file$)

   if file$ <> ""
      for w = 1 to maxWorlds
         if object exist(w) > 0
            if file exist(file$ + str$(w) + ".bmp") = 0
               `Return message
               msg$ = "Save complete"

               width = World(w).tx + 1
               height= World(w).tz + 1

               `Create image memblock
               make memblock maxWorlds + 1, 12 + (width * height * 4)
               write memblock dword maxWorlds + 1, 0, width
               write memblock dword maxWorlds + 1, 4, height
               write memblock dword maxWorlds + 1, 8, 32

               `Write pixels
               for y = 1 to height
                  for x = 1 to width

                     `Calc position
                     pos = 12 + (((y-1)*width + x - 1)*4)

                     `Write color using heightmap
                     h = Heightmap(w, x, y)
                     write memblock dword maxWorlds + 1, pos, rgb(h, h, h)

                  next x
               next y

               `Export image
               make image from memblock maxImages + 2, maxWorlds + 1
               delete memblock maxWorlds + 1
               save image file$ + str$(w) + ".bmp", maxImages + 2
            else
               msg$ = "File already exist"
               exitfunction msg$
            endif
         endif
      next w
   else
      msg$ = "File name is invalid"
   endif

endfunction msg$

function SaveDBO(file$)

   climb = 0

   `Create Export file
   for w = 1 to maxWorlds

      `If w exists, add as a limb
      if object exist(w) > 0
         if object exist(maxWorlds + 20) = 0
            clone object maxWorlds + 20, w
            offset limb maxWorlds + 20, 0, World(w).x#, World(w).y#, World(w).z#
         else
            inc climb
            add limb maxWorlds + 20, climb, w
            offset limb maxWorlds + 20, climb, World(w).x#, World(w).y#, World(w).z#
         endif
      endif
   next w

   if file$ <> ""
      if file exist(file$ + ".dbo") = 0
         save object file$ + ".dbo", maxWorlds + 20
         msg$ = "Save complete"
      else
         msg$ = "File already exists."
      endif
   else
      msg$ = "File name is invalid"
   endif
   perform checklist for object limbs maxWorlds + 20
   msg$ = str$(checklist quantity())
   if object exist(maxWorlds + 20) > 0 then delete object maxWorlds + 20

endfunction msg$

function textbutton(x, y, txt$)
   pressed = 0
   tx = text width(txt$) / 2
   ty = text height(txt$) / 2
   if mousex() > x - tx and mousex() < x + tx
      if mousey() > y - ty and mousey() < y + ty
         pressed = 1
      endif
   endif
   if pressed = 1 then ink rgb(0, 0, 255), 0 else ink 0, 0
   center text x, y - ty, txt$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

function button(x, y, txt$)

   Pressed = 0

   `box
   ink 0, 0
   box x - 50, y - 8, x + 50, y + 8
   if mousex() > x - 50 and mousex() < x + 50 and mousey() > y - 8 and mousey() < y + 8
      ink rgb(100, 100, 255), 0
      Pressed = 1
   else
      ink rgb(255, 255, 255), 0
   endif
   box x - 49, y - 7, x + 49, y + 7

   `Text
   ink 0, 0
   center text x, y - text height(txt$)/2, txt$

   if mouseclick() = 0 then Pressed = 0

endfunction Pressed

function PositionCursor(cur, w, tx, tz)

   `Calculate position
   Ctx# = (tx * World(w).sx# / World(w).tx) - (World(w).sx#/2)
   Ctz# = (tz * World(w).sz# / World(w).tz) - (World(w).sz#/2)
   if tx >= 0 and tx <= World(w).tx
      if tz >= 0 and tz <= World(w).tz
         Cty# = World(w).sy# / maxHeight * Heightmap(w, tx + 1, tz + 1)
      endif
   endif

   `Update position
   position object cur, World(w).x# + Ctx#, World(w).y# + Cty#, World(w).z# + Ctz#

endfunction

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         `Turned tiles
         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |\    |
         | \   |
         |   \ |
         |    \|
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

`>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<
ToolsData:
data "Point path"
data "4 point path"
data "Round Hill"

Rem Project: 007Terrain
Rem Created: 23/05/2006 01:02:57

Rem ***** Main Source File *****

rem **************************************************

    Gosub INIT_VariablesAndDatastructures

    InitDisplay()

    CreateMain()

    CreateButtons()

    CreateBrushTexture()

    DefaultTerrain()

rem **************************************************
rem **************************************************
rem **************************************************

    set current bitmap 0

    do

        rem **************************************************
        rem Refresh main GUI to enable menu change
        rem **************************************************

        paste image 1,0,0,1

        rem **************************************************
        rem Check for new action
        rem **************************************************

        MseBtn = mouseclick()

        TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2
        BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / FD(0).SegSize )
        BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / FD(0).SegSize )

        if mousex() >= 24 and mousex() <=1000 and mousey() >= 24 and mousey() <=640

            rem Actions when mouse in viewport
            select OD(0).MainAction

                case 1

                    ZoomCamera()
                    MoveCamera( MseBtn )

                endcase

                case 2

                    ZoomCamera()

                        if controlkey()

                            MoveCamera( MseBtn )

                        else

                            if ClickHeld = 0 or BrushMoved = 1

                                SetBaseHeights( MseBtn, BrushX, BrushZ )
                                ClickHeld = 1

                            endif

                            AdjustTerrainData( MseBtn, BrushX, BrushZ )

                        endif

                        if BD(0).Changed = 0
                            CreateBrushMesh()
                            BD(0).Changed = 1
                        endif

                        oldx# = BD(0).Xpos
                        oldz# = BD(0).ZPos

                        PositionBrush()
                        MoldBrushToTerrain()

                        if BD(0).Xpos <> oldx# or BD(0).ZPos <> oldz#

                            BrushMoved = 1

                        else

                            BrushMoved = 0

                        endif

                endcase

            endselect

        else

            rem Check for a menu button press
            if MseBtn

                Button = CheckMainButtons()

                if Button <> -1

                    Buttons(Button).State = 1
                    ClearButtonGroup( "MAIN", Button )

                    OD(0).Menu = Buttons(Button).Action
                    OD(0).Group = Buttons(Button).Title

                else

                    if OD(0).Menu <> -1

                        Button = CheckSubButtons( OD(0).Group )

                        if Button <> - 1

                            rem **************************************************
                            rem Instigate a repeat delay
                            rem **************************************************

                            if OD(0).LastButton = Button

                                Buttons(Button).State = 1
                                OD(0).Action = Buttons(Button).Action

                                if OD(0).RepeatCount = -1

                                    OD(0).RepeatCount = 1

                                else

                                    inc OD(0).RepeatCount

                                    if OD(0).RepeatCount >= OD(0).RepeatDelay

                                        OD(0).RepeatCount = 0
                                        OD(0).RepeatDelay = 5

                                    endif

                                endif

                            else

                                if OD(0).RepeatCount = -1

                                    Buttons(Button).State = 1
                                    OD(0).Action = Buttons(Button).Action
                                    OD(0).LastButton = Button

                                endif

                            endif

                        endif

                    endif

                endif

            else

                OD(0).Action = -1
                OD(0).RepeatCount = -1
                OD(0).LastButton = -1
                OD(0).RepeatDelay = 50

            endif

        endif

        if not MseBtn

            ClickHeld = 0

            null = mousemovex()
            null = mousemovey()
            null = mousemovez()

        endif

        rem **************************************************
        rem Display menu's and buttons in current state
        rem **************************************************

        ShowButtons( "MAIN" )

        if OD(0).Menu <> -1

            DisplaySubMenu()

        endif

        rem **************************************************
        rem Show brush co-ordinates and range
        rem **************************************************

        BrushX$ = str$( BrushX ): if BD(0).Width > 1 then BrushX$ = BrushX$ + " - " + str$( BrushX + BD(0).Width - 1 )
        BrushZ$ = str$( BrushZ ): if BD(0).Length > 1 then BrushZ$ = BrushZ$ + " - " + str$( BrushZ + BD(0).Length - 1 )

        set text size 16
        center text 64,700,"Brush X": center text 64,720,BrushX$
        center text 128,700,"Brush Z": center text 128,720,BrushZ$

        rem **************************************************
        rem Perform current action if any
        rem **************************************************

        if OD(0).Action <> -1

            PerformCurrentAction()

        endif

        rem **************************************************
        rem **************************************************

        sync

    loop

rem **************************************************
rem **************************************************
rem **************************************************

function SetBaseHeights( MseBtn, BrushX, BrushZ )

    rem If base mode is absolute, find the base in the brush area
    if BD(0).MBBase <> 1

        BaseSet = 0

        for z = 0 to BD(0).Width-1

            for x = 0 to BD(0).Length - 1

                if BrushX + x > 0 and BrushX + x < FD(0).Segments and BrushZ + z > 0 and BrushZ + z < FD(0).Segments

                    if BaseSet = 0

                        Base# = VertexData( BrushX + x, BrushZ + z ).Height
                        BaseSet = 1

                    endif

                    rem Are we raising or lowering the terrain
                    if MseBtn = 1

                        rem Raising, so find lowest height in brush area
                        if VertexData( BrushX + x, BrushZ + z ).Height <  Base#
                            Base# = VertexData( BrushX + x, BrushZ + z ).Height
                        endif

                    else

                        rem Lowering, so find highest height in brush area
                        if VertexData( BrushX + x, BrushZ + z ).Height > Base#
                            Base# = VertexData( BrushX + z, BrushZ + z ).Height
                        endif

                    endif

                endif

            next x

        next z

    endif

    rem Set the base height and reset the increase on vertices in brush area
    for z = 0 to BD(0).Width-1

        for x = 0 to BD(0).Length - 1

            if BrushX + x >= 0 and BrushX + x <= FD(0).Segments and BrushZ + z >= 0 and BrushZ + z <= FD(0).Segments

                if BD(0).MBBase = 1

                    VertexData( BrushX + x, BrushZ + z ).HtBase = VertexData( BrushX + x, BrushZ + z ).Height

                else

                    VertexData( BrushX + x, BrushZ + z ).HtBase = Base#

                endif

                VertexData( BrushX + x, BrushZ + z ).HtInc = 0

            endif

        next x

    next z

endfunction

function SmoothRough( MseBtn, BrushX, BrushZ )

    cx# = ( BD(0).Width - 1 ) / 2
    cz# = ( BD(0).Length - 1 ) / 2

    for z = 0 to BD(0).Length-1

        for x = 0 to BD(0).Width-1

            if BrushX + x >0 and BrushX + x < FD(0).Segments and BrushZ + z >0 and BrushZ + z < FD(0).Segments

                dx# = x - cx#
                dz# = z - cz#

                pd# = ( (dx#^2)/(cx#^2) ) + ( (dz#^2)/(cz#^2) )

                if BD(0).MBShape = 3
                    Rad# = 1
                else
                    Rad# = 2
                endif

                if pd# <= Rad#

                    h1# = VertexData( BrushX + x, BrushZ + z ).Height

                    if MseBtn = 1

                        h2# = VertexData( BrushX + x + 1, BrushZ + z ).Height
                        h3# = VertexData( BrushX + x, BrushZ + z + 1 ).Height
                        h4# = VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height
                        h5# = VertexData( BrushX + x - 1, BrushZ + z ).Height
                        h6# = VertexData( BrushX + x, BrushZ + z - 1 ).Height
                        h7# = VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height

                        AvgHt# = (h2#+h3#+h4#+h5#+h6#+h7#)/6
                        HtDif# = h1# - AvgHt#

                        NewHt# = h1# - ( HtDif# / BD(0).Magnitude  )

                    else

                        RndHt# = rnd( BD(0).Magnitude * 2 ) - BD(0).Magnitude
                        NewHt# = h1# + ( RndHt#  / 10 )

                    endif

                    VertexData( BrushX + x, BrushZ + z ).Height = NewHt#

                endif

            endif

        next x

    next z

endfunction

function RaiseLower( MseBtn, BrushX, BrushZ )

    cx# = ( BD(0).Width - 1 ) / 2
    cz# = ( BD(0).Length - 1 ) / 2

    for z = 0 to BD(0).Length-1

        for x = 0 to BD(0).Width-1

            if BrushX + x >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z <= FD(0).Segments

                   dx# = x - cx#
                   dz# = z - cz#

                   pd# = ( (dx#^2)/(cx#^2) ) + ( (dz#^2)/(cz#^2) )

                   if BD(0).MBShape = 3
                        Rad# = 1
                   else
                        Rad# = 2
                   endif


                   Adjust# = BD(0).Magnitude

                    if BD(0).MBOperation = 4

                        Adjust# = Adjust# / ( (pd#+.5)^2 )

                    endif

                    if BD(0).MBOperation = 3

                        ang# = (pd# / Rad#) * 180
                        if ang# < 0 then ang# = 0
                        if ang# > 180 then ang# = 180

                        Adjust# = Adjust# + ( Adjust# * sin( ang#  + 90 ) )

                    endif

                    if MseBtn = 2 then Adjust# = Adjust# * -1

                    Adjust# = Adjust# / 10.0

                    inc VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust#

                    Base# = VertexData( BrushX + x, BrushZ + z ).HtBase
                    Increase# = VertexData( BrushX + x, BrushZ + z ).HtInc

                    if BD(0).MBBase = 1

                        if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase#

                    else

                        if MseBtn = 1

                            if Base# + Increase# > VertexData( BrushX + x, BrushZ + z ).Height

                                if VertexData( BrushX + x, BrushZ + z ).Height < Base#

                                    if pd# <= Rad# then inc VertexData( BrushX + x, BrushZ + z ).Height, Increase#
                                    dec VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust#

                                else

                                    if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase#

                                endif

                            endif

                        else

                            if Base# + Increase# < VertexData( BrushX + x, BrushZ + z ).Height

                                if VertexData( BrushX + x, BrushZ + z ).Height > Base#

                                    if pd# <= Rad# then inc VertexData( BrushX + x, BrushZ + z ).Height, Increase#
                                    dec VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust#

                                else

                                    if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase#

                                endif

                            endif

                        endif

                    endif

            endif

        next x

    next z

endfunction

function CalculateNormals( BrushX, BrushZ )

    rem ********************************************************************
    rem Initialise vectors
    rem ********************************************************************

    Prime = 1
    Vert2 = 2
    Vert3 = 3
    FaceNormal = 4
    FinalNormal = 5

    null = make vector3( Prime )
    null = make vector3( Vert2 )
    null = make vector3( Vert3 )
    null = make vector3( FaceNormal )
    null = make vector3( FinalNormal )

    rem ********************************************************************
    rem Loop through all vertices in brush area
    rem ********************************************************************

    for z = 0 to BD(0).Length-1

        for x = 0 to BD(0).Width-1

            if BrushX + x >=0 and BrushX + x + 1 <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z + 1 <= FD(0).Segments

                rem ********************************************************************
                rem Calc normal for first triangle
                rem ********************************************************************

                    lft# = ( BrushX + x ) * FD(0).SegSize
                    rgt# = ( BrushX + x + 1 ) * FD(0).SegSize
                    btm# = ( BrushZ + z ) * FD(0).SegSize
                    top# = ( BrushZ + z + 1 ) * FD(0).SegSize

                    set vector3 Prime, lft#, VertexData( BrushX + x, BrushZ + z ).Height, btm#
                    set vector3 Vert2, lft#, VertexData( BrushX + x, BrushZ + z + 1 ).Height, top#
                    set vector3 Vert3, rgt#, VertexData( BrushX + x + 1, BrushZ + z ).Height, btm#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

            endif

            if BrushX + x -1 >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z + 1 <= FD(0).Segments

                rem ********************************************************************
                rem Calc normal for second triangle
                rem ********************************************************************

                    lft# = ( BrushX + x - 1 ) * FD(0).SegSize
                    rgt# = ( BrushX + x ) * FD(0).SegSize

                    set vector3 Vert2, lft#, VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height, top#
                    set vector3 Vert3, rgt#, VertexData( BrushX + x, BrushZ + z + 1 ).Height, top#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

                rem ********************************************************************
                rem Calc normal for third triangle
                rem ********************************************************************

                    set vector3 Vert2, lft#, VertexData( BrushX + x - 1, BrushZ + z ).Height, btm#
                    set vector3 Vert3, lft#, VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height, top#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

            endif

            if BrushX + x -1 >=0 and BrushX + x <= FD(0).Segments and BrushZ + z -1 >=0 and BrushZ + z <= FD(0).Segments

                rem ********************************************************************
                rem Calc normal for fourth triangle
                rem ********************************************************************

                    btm# = ( BrushZ + z - 1 ) * FD(0).SegSize
                    top# = ( BrushZ + z ) * FD(0).SegSize

                    set vector3 Vert2, rgt#, VertexData( BrushX + x, BrushZ + z -1 ).Height, btm#
                    set vector3 Vert3, lft#, VertexData( BrushX + x - 1, BrushZ + z ).Height, top#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

            endif

            if BrushX + x >=0 and BrushX + x + 1 <= FD(0).Segments and BrushZ + z -1 >=0 and BrushZ + z <= FD(0).Segments

                rem ********************************************************************
                rem Calc normal for fifth triangle
                rem ********************************************************************

                    lft# = ( BrushX + x ) * FD(0).SegSize
                    rgt# = ( BrushX + x + 1 ) * FD(0).SegSize
                    btm# = ( BrushZ + z - 1 ) * FD(0).SegSize
                    top# = ( BrushZ + z ) * FD(0).SegSize

                    set vector3 Vert2, rgt#, VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height, btm#
                    set vector3 Vert3, lft#, VertexData( BrushX + x, BrushZ + z - 1 ).Height, btm#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

                rem ********************************************************************
                rem Calc normal for sixth triangle
                rem ********************************************************************

                    set vector3 Vert2, rgt#, VertexData( BrushX + x + 1, BrushZ + z ).Height, top#
                    set vector3 Vert3, rgt#, VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height, btm#

                    subtract vector3 Vert2, Vert2, Prime
                    subtract vector3 Vert3, Vert3, Prime

                    cross product vector3 FaceNormal, Vert2, Vert3
                    add vector3 FinalNormal, FinalNormal, FaceNormal

            endif

            if BrushX + x >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z <= FD(0).Segments

                rem ********************************************************************
                rem Normalise the result
                rem ********************************************************************

                    normalize vector3 FinalNormal, FinalNormal

                    VertexData( BrushX + x, BrushZ + z ).NormX = x vector3( FinalNormal )
                    VertexData( BrushX + x, BrushZ + z ).NormY = y vector3( FinalNormal )
                    VertexData( BrushX + x, BrushZ + z ).NormZ = z vector3( FinalNormal )

            endif

        next x

    next z

endfunction

function AdjustTerrainData( MseBtn, BrushX, BrushZ )

    if MseBtn

        rem Pre - adjust the height of a vertex in the height array
        rem according to current brush settings

        select BD(0).MBOperation

            case 1

                RaiseLower( MseBtn, BrushX, BrushZ )
                CalculateNormals( BrushX, BrushZ )

                ApplyBrushToTerrain( BrushX, BrushZ )

            endcase

            case 2

                SmoothRough( MseBtn, BrushX, BrushZ )
                CalculateNormals( BrushX, BrushZ )

                ApplyBrushToTerrain( BrushX, BrushZ )

            endcase

            case 3

                RaiseLower( MseBtn, BrushX, BrushZ )
                CalculateNormals( BrushX, BrushZ )

                ApplyBrushToTerrain( BrushX, BrushZ )

            endcase

            case 4

                RaiseLower( MseBtn, BrushX, BrushZ )
                CalculateNormals( BrushX, BrushZ )

                ApplyBrushToTerrain( BrushX, BrushZ )

            endcase

        endselect

    endif

endfunction

function ApplyBrushToTerrain( BrushX, BrushZ )

    TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2
    TWidth_Offset = ( FD(0).Segments * 6 )

    lock vertexdata for limb 1,0,1

    for z = 0 to BD(0).Length-1

        for x = 0 to BD(0).Width-1

            vert_x = BrushX + x
            vert_z = BrushZ + z

            if vert_x >= 0 and vert_x <= FD(0).Segments and vert_z >=0 and vert_z <= FD(0).Segments

                rem 1st vertex
                prime_index = ( vert_x * 6 ) + ( vert_z * TWidth_Offset )
                if vert_x < FD(0).Segments and vert_z < FD(0).Segments
                   UpdateVertex( prime_index, vert_x, vert_z )
                endif

                if vert_x > 0 and vert_z < FD(0).Segments

                    rem 2nd vertex
                    vert_index = prime_index - 1
                    if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z )

                    rem 3rd vertex
                    vert_index = prime_index - 4
                    if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z )

                endif

                if vert_z > 0

                    if vert_x > 0
                        rem 4th vertex
                        vert_index = prime_index - ( TWidth_Offset + 2 )
                        if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z )
                    endif

                    if vert_x < FD(0).Segments
                        rem 5th vertex
                        vert_index = prime_index - ( TWidth_Offset - 1 )
                        if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z )

                        rem 6th vertex
                        vert_index = prime_index - ( TWidth_Offset - 3 )
                        if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z )
                    endif

                endif

            endif

        next x

    next z

    unlock vertexdata

endfunction

function ChangeVertexHeight( vert_index, NewHeight# )

    vx# = get vertexdata position x( vert_index )
    vy# = get vertexdata position y( vert_index )
    vz# = get vertexdata position z( vert_index )

    set vertexdata position vert_index, vx#, NewHeight#, vz#

endfunction

function UpdateVertex( vert_index, vert_x, vert_z )

    vx# = get vertexdata position x( vert_index )
    vy# = get vertexdata position y( vert_index )
    vz# = get vertexdata position z( vert_index )

    set vertexdata position vert_index, vx#, VertexData( vert_x, vert_z ).Height, vz#

    nx# = VertexData( vert_x, vert_z ).NormX
    ny# = VertexData( vert_x, vert_z ).NormY
    nz# = VertexData( vert_x, vert_z ).NormZ

    set vertexdata normals vert_index, nx#, ny#, nz#

endfunction

function CircleFill( cx,cy,rad )

    radsq = rad^2

    for x = 0 to rad

        y = sqrt( radsq - ( x^2 ) )

        line cx+x, cy+y, cx+x, cy-1-y
        line cx-1-x, cy+y, cx-1-x, cy-1-y

    next x

endfunction

function IsEven( CheckNum# )

    if CheckNum# / 2 = Int(CheckNum# / 2)
        Result = 1
    else
        Result = 0
    endif

endfunction Result

function PositionBrush()

    CamXpos# = camera position x()
    CamYpos# = camera position y()
    CamZpos# = camera position z()
    CamXang# = camera angle x()

    roughd# = CamYpos#

    pick screen mousex(), mousey(), roughd#

    bx# = get pick vector x()
    by# = get pick vector y()
    bz# = get pick vector z()

    Factor# = -( CamYpos# / by# )

    bx#=bx#*Factor#
    by#=by#*Factor#
    bz#=bz#*Factor#

    off# = FD(0).SegSize / -2

    boffx# = (BD(0).Width - 1) * off#
    boffz# = (BD(0).Length - 1) * off#

    BD(0).Xpos = RoundOff( (CamXpos# + bx# + boffx# ) / FD(0).SegSize ) * FD(0).SegSize + off#
    BD(0).Zpos = RoundOff( (CamZpos# + bz# + boffz# ) / FD(0).SegSize ) * FD(0).SegSize + off#
    BD(0).YPos = 0.1: rem CamYpos# + by#

    position object 2, BD(0).Xpos, BD(0).YPos, BD(0).Zpos

endfunction

function RoundOff( Value# )

    IntPart = floor(Value#)
    Decimal# = Value# - IntPart

    if Decimal# >= 0.5
        Result = ceil(Value#)
    else
        Result = floor(Value#)
    endif

endfunction Result

function MoveCamera( MoveType )

    Xpos# = camera position x()
    Ypos# = camera position y()
    Zpos# = camera position z()

    Xang# = camera angle x()
    Yang# = camera angle y()
    Zang# = camera angle z()

    XSpeed# = mousemovex()
    ZSpeed# = mousemovey()

    SpeedScale# = ( Ypos# / 100 )
    if SpeedScale# > 1.0 then SpeedScale# = 1.0
    if SpeedScale# < 0.05 then SpeedScale# = 0.05

    select MoveType

        case 1

            XSpeed# = XSpeed# * SpeedScale#
            ZSpeed# = ZSpeed# * SpeedScale#

            Xpos# = newxvalue( Xpos#, Yang#, ZSpeed# )
            Zpos# = newzvalue( Zpos#, Yang#, ZSpeed# )

            Xpos# = newxvalue( Xpos#, wrapvalue( Yang# + 90 ), -XSpeed# )
            Zpos# = newzvalue( Zpos#, wrapvalue( Yang# + 90 ), -XSpeed# )

        endcase

        case 2

            inc YAng#, XSpeed#
            inc Xang#, ZSpeed#

            rem if wrapvalue(XAng#) >85 then XAng# = 85
            rem if wrapvalue(XAng#) <10 then XAng# = 10

        endcase

    endselect

    position camera Xpos#, Ypos#, Zpos#
    rotate camera XAng#, YAng#, ZAng#

endfunction

function ZoomCamera()

    Xpos# = camera position x()
    Ypos# = camera position y()
    Zpos# = camera position z()

    YSpeed# = mousemovez() / - 10.0

    rem Also need zoom keys in case there is no mouse wheel
    if YSpeed# = 0

        YSpeed# = ( keystate(31) - keystate(17) )

    endif

    SpeedScale# = ( Ypos# / 100 )
    if SpeedScale# > 1.0 then SpeedScale# = 1.0
    if SpeedScale# < 0.05 then SpeedScale# = 0.05

    if YSpeed# <0 then YSpeed# = YSpeed# * SpeedScale#
    Ypos# = Ypos# + YSpeed#

    position camera Xpos#, Ypos#, Zpos#

endfunction

function DefaultTerrain()

    FD(0).Name = "Default"
    FD(0).Segments = 50
    FD(0).SegSize = 10
    FD(0).Saved = 0

    CreateTerrain()

    BD(0).Width = 1
    BD(0).Length = 1
    BD(0).Magnitude = 1

    OD(0).Menu = 4
    OD(0).MainAction = 1

endfunction

function MoldBrushToTerrain()

    BWidth_Offset = ( BD(0).Width * 12 )
    TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2
    BSegSize# = FD(0).SegSize / 2

    BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / FD(0).SegSize )
    BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / FD(0).SegSize )

    BSegX# = BD(0).Width * 2
    BSegZ# = BD(0).Length * 2

    BSizeX# = BD(0).Width * FD(0).SegSize
    BSizeZ# = BD(0).Length * FD(0).SegSize

    lock vertexdata for limb 2,0,1

    for z = 0 to BSegZ#-1

        for x = 0 to BSegX#-1

            Brush_Vx# = BD(0).Xpos + ( x * BSegSize# )
            Brush_Vz# = BD(0).Zpos + ( z * BSegSize# )

            rem ****************************************************
            rem Calculate heights
            rem ****************************************************

            if Brush_Vx# >= -TSize# and Brush_Vx# < TSize# and Brush_Vz# >= -TSize# and Brush_Vz# < TSize#

                Hx = BrushX + floor( x/2 )
                Hz = BrushZ + floor( z/2 )

                if Hx < FD(0).Segments
                    rgtht# = VertexData( Hx+1, Hz ).Height
                else
                    rgtht# = 0
                endif

                if Hz < FD(0).Segments
                    topht# = VertexData( Hx, Hz+1 ).Height
                else
                    topht# = 0
                endif

                if Hz > 0
                    btmht# = VertexData( Hx, Hz-1 ).Height
                else
                    btmht# = 0
                endif

                if Hx < FD(0).Segments and Hz > 0
                    btmrgtht# = VertexData( Hx+1, Hz-1 ).Height
                else
                    btmrgtht# = 0
                endif

                if Hx > 0
                    lftht# = VertexData( Hx-1, Hz ).Height
                else
                    lftht# = 0
                endif

                if Hx > 0 and Hz < FD(0).Segments
                    toplftht# = VertexData( Hx-1, Hz+1 ).Height
                else
                    toplftht# = 0
                endif

                if IsEven(x+1)=1 and IsEven(z+1)=1

                    Height1# = VertexData( Hx, Hz ).Height
                    Height2# = ( VertexData( Hx, Hz ).Height + topht# ) / 2
                    Height3# = ( VertexData( Hx, Hz ).Height + rgtht# ) / 2
                    Height4# = ( topht# + rgtht# ) / 2

                endif

                if IsEven(x+1)=1 and IsEven(z+1)=0

                    Height1# = ( VertexData( Hx, Hz ).Height + btmht# ) / 2
                    Height2# = VertexData( Hx, Hz ).Height
                    Height3# = ( VertexData( Hx, Hz ).Height + btmrgtht# ) / 2
                    Height4# = ( VertexData( Hx, Hz ).Height + rgtht# ) / 2

                endif

                if IsEven(x+1)=0 and IsEven(z+1)=1

                    Height1# = ( lftht# + VertexData( Hx, Hz ).Height ) / 2
                    Height2# = ( toplftht# + VertexData( Hx, Hz ).Height ) / 2
                    Height3# = VertexData( Hx, Hz ).Height
                    Height4# = ( VertexData( Hx, Hz ).Height + topht# ) / 2

                endif

                if IsEven(x+1)=0 and IsEven(z+1)=0

                    Height1# = ( lftht# + btmht# ) / 2
                    Height2# = ( lftht# + VertexData( Hx, Hz ).Height ) / 2
                    Height3# = ( VertexData( Hx, Hz ).Height + btmht# ) / 2
                    Height4# = VertexData( Hx, Hz ).Height

                endif

            else

                Height1# = 0
                Height2# = 0
                Height3# = 0
                Height4# = 0

            endif

            rem ****************************************************
            rem Set heights
            rem ****************************************************

            rem 1st vertex
            prime_index = ( x * 6 ) + ( z * BWidth_Offset )
            ChangeVertexHeight( prime_index, Height1# )

            rem 2nd vertex
            vert_index = prime_index + 1
            ChangeVertexHeight( vert_index, Height2# )

            rem 3rd vertex
            vert_index = prime_index + 2
            ChangeVertexHeight( vert_index, Height3# )

            rem 4th vertex
            vert_index = prime_index + 3
            ChangeVertexHeight( vert_index, Height2# )

            rem 5th vertex
            vert_index = prime_index + 4
            ChangeVertexHeight( vert_index, Height4# )

            rem 6th vertex
            vert_index = prime_index + 5
            ChangeVertexHeight( vert_index, Height3# )

        next x

    next z

    unlock vertexdata

endfunction

function CreateBrushMesh()

    BSegSize# = FD(0).SegSize / 2

    BSegX# = BD(0).Width * 2
    BSegZ# = BD(0).Length * 2

    Memblock=1
    VertexCount = BSegX# * BSegZ# * 6

    make memblock Memblock, ( VertexCount * 36 ) + 12

    write memblock dword Memblock, 0, 338

    write memblock dword Memblock, 4, 36

    write memblock dword Memblock, 8, VertexCount

    PTR=12

    for z = 0 to BSegZ# - 1

        for x = 0 to BSegX# - 1

            lft# = x*BSegSize#
            rgt# = (x+1)*BSegSize#
            btm# = z*BSegSize#
            top# = (z+1)*BSegSize#

            lftU# = x / BSegX#
            rgtU# = (x+1) / BSegX#
            btmV# = z / BSegZ#
            topV# = (z+1) / BSegZ#

            col =  rgb(255,255,255)
            rem First triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col, lftU#, btmV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

            rem Second Triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

        next x

    next z

    make mesh from memblock 1, 1
    delete memblock 1

    if object exist(2)
        change mesh 2, 0, 1
    else
        make object 2, 1, 0
    endif

    delete mesh 1

    texture object 2,BD(0).MBShape

    ghost object on 2
    fade object 2, 75

endfunction

function CreateBrushTexture()

    create bitmap 2,256,256
    ink rgb(200,200,255),rgb(200,200,255)

    box 0,0,256,256

    get image 2,0,0,256,256,1

    cls 0

    CircleFill( 128,128,127 )

    get image 3,0,0,256,256,1

endfunction

function CreateTerrain()

    undim VertexData(0)
    dim VertexData( FD(0).Segments, FD(0).Segments ) as Vertex

    TSize = FD(0).Segments * FD(0).SegSize
    offset# = TSize / -2

    if object exist(1) then delete object 1

    CreateMeshFromHeights( 0, 0, FD(0).Segments, FD(0).Segments, FD(0).SegSize )
    make object 1, 1, 0
    delete mesh 1

    set object wireframe 1,1
    set object cull 1,1

    position object 1, offset#,0,offset#

    position camera 0,100,0
    xrotate camera 10

endfunction

function WriteVertexToMemblock( Memblock, PTR, X#, Y#, Z#, NX#, NY#, NZ#, COL, U#, V# )

    Rem Vertex Xpos
    write memblock float Memblock, PTR, X#
    inc PTR,4

    Rem Vertex Ypos
    write memblock float Memblock, PTR, Y#
    inc PTR,4

    Rem Vertex Zpos
    write memblock float Memblock, PTR, Z#
    inc PTR,4

    rem Vertex Normal X
    write memblock float Memblock, PTR, NX#
    inc PTR,4

    rem Vertex Normal Y
    write memblock float Memblock, PTR, NY#
    inc PTR,4

    rem Vertex Normal Z
    write memblock float Memblock, PTR, NZ#
    inc PTR,4

    rem Vertex Colour
    write memblock dword Memblock, PTR, COL
    inc PTR,4

    rem Vertex Texture U Co-ord
    write memblock float Memblock, PTR, U#
    inc PTR,4

    rem Vertex Texture V Co-ord
    write memblock float Memblock, PTR, V#
    inc PTR,4

endfunction PTR

function CreateMeshFromHeights( StartX, StartZ, SegX, SegZ, SegSize )

    Memblock=1
    VertexCount = ( SegX * SegZ )*6

    make memblock Memblock, (VertexCount * 36) + 12

    write memblock dword Memblock, 0, 338

    write memblock dword Memblock, 4, 36

    write memblock dword Memblock, 8, VertexCount

    PTR=12

    for z = 0 to SegZ-1

        for x = 0 to SegX-1

            lft# = x*SegSize
            rgt# = (x+1)*SegSize
            btm# = z*SegSize
            top# = (z+1)*SegSize

            lftU# = x / SegX
            rgtU# = (x+1) / SegX
            btmV# = z / SegZ
            topV# = (z+1) / SegZ

            col =  rgb(rnd(100)+50,rnd(100)+150,0)
            rem First triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col , lftU#, btmV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

            rem Second Triangle
            PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# )
            PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# )

        next x

    next z

    make mesh from memblock 1, 1
    delete memblock 1

endfunction

function CreateButtons()

    sync
    restore ButtonData

    for l = 0 to ButtonCount(0)

        read Buttons( l ).Group
        read Buttons( l ).SubGroup
        read Buttons( l ).Title
        read Buttons( l ).Action
        read Buttons( l ).Xpos
        read Buttons( l ).Ypos
        read Buttons( l ).Width
        read Buttons( l ).Height

        Buttons( l ).State = -1

        if bitmap exist(2) = 1
            delete bitmap 2
        endif

        create bitmap 2, Buttons( l ).Width, Buttons( l ).Height

        Buttons( l ).UpImage = CreateButton( l, (l*2)+4, 0, rgb( 100,50,50), rgb(255,255,0) )
        Buttons( l ).DnImage = CreateButton( l, (l*2)+5, 1, rgb( 100,50,50), rgb(255,255,0) )

        delete bitmap 2

    next l

endfunction

function CreateButton( BI, ImageNum, State, BackColour, TextColour )

    cls BackColour

    set text font "Arial"
    set text to bold
    set text size 14

    x = ( Buttons( BI ).Width / 2 )
    y = ( Buttons( BI ).Height / 2 ) - 7

    Width = Buttons( BI ).Width
    Height = Buttons( BI ).Height

    ink 0,0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    if state = 0
        ink rgb(255,255,255),0
    else
        ink 0,0
    endif

    line 1,1,1,Height-1
    line 1,1,Width-1,1

    if state = 0
        ink 0,0
    else
        ink rgb(255,255,255),0
    endif

    line Width-3,Height-3,Width-3,1
    line Width-3,Height-3,1,Height-3

    ink rgb(1,1,1),0
    center text x, y, Buttons( BI ).Title

    blur bitmap 2,6

    line 0,0,Width,0
    line 0,0,0,Height
    line 0,Height,Width,Height
    line Width,Height,Width,0

    ink TextColour,0
    center text x, y, Buttons( BI ).Title

    get image ImageNum, 0, 0, Width, Height

endfunction ImageNum

function CheckMainButtons()

    ButtonPressed = -1

    for l = 0 to 2

        xmin = Buttons( l ).Xpos
        ymin = Buttons( l ).Ypos
        xmax = xmin + Buttons( l ).Width
        ymax = ymin + Buttons( l ).Height

        if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

            ButtonPressed = l

        endif

    next l

endfunction ButtonPressed

function CheckSubButtons( Group$ )

    ButtonPressed = -1

    for l = 3 to ButtonCount(0)

        if Buttons(l).Group = Group$

            xmin = Buttons( l ).Xpos
            ymin = Buttons( l ).Ypos
            xmax = xmin + Buttons( l ).Width
            ymax = ymin + Buttons( l ).Height

            if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax

                ButtonPressed = l

            endif

        endif

    next l

endfunction ButtonPressed

function ClearButtonGroup( Group$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).Group = Group$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ClearButtonSubGroup( SubGroup$, Selected )

    for l = 0 to ButtonCount(0)

        if Buttons(l).SubGroup = SubGroup$

            if l <> Selected then Buttons(l).State = -1

        endif

    next l

endfunction

function ShowButtons( Group$ )

    for l = 0 to ButtonCount(0)

        if Buttons( l ).Group = Group$

            if Buttons( l ).State = 1

                img = Buttons( l ).DnImage

            else

                img = Buttons( l ).UpImage

            endif

            paste image img, Buttons( l ).Xpos, Buttons( l ).Ypos

        endif

    next l

endfunction

function InitDisplay()

    set display mode 1024,768,32

    autocam off

    sync on
    sync rate 0

    set camera view 24,24,1000,640

    set ambient light 15

    fog on
    fog color 100,100,200
    fog distance 2000

    backdrop on
    color backdrop rgb(100,100,125)

    position light 0,0,1000,1000
    set ambient light 0

endfunction

function CreateMain()

    create bitmap 1,1024,768

    cls rgb(100,100,100)

    ink rgb(1,1,1),0
    box 3,3,1021,765

    ink rgb(100,150,100),0
    box 4,4,1020,764

    rem Viewport
    ink rgb(1,1,1),0
    box 22,22,1002,642
    ink 0,0
    box 24,24,1000,640

    rem sub action panel
    ink rgb(1,1,1),0
    box 254,654,1002,746
    ink rgb(90,110,90),0
    box 256,656,1000,744

    get image 1,0,0,1024,768
    delete bitmap 1

endfunction

function SetDefaultMoldBrush()

    if Buttons(12).State <> 1 and Buttons(13).State <>1

        Buttons(13).State = 1
        FD(0).Wireframe = 1
        set object wireframe 1, FD(0).Wireframe

    endif

    if Buttons(14).State <> 1 and Buttons(15).State <>1

        Buttons(14).State = 1
        BD(0).MBShape = 2

    endif

    if Buttons(16).State <> 1 and Buttons(17).State <>1

        Buttons(16).State = 1
        BD(0).MBBase = 1

    endif

    if Buttons(18).State <> 1 and Buttons(19).State <>1

        Buttons(18).State = 1
        BD(0).MBIncType = 1

    endif

    if Buttons(20).State <> 1 and Buttons(21).State <>1 and Buttons(22).State <>1 and Buttons(23).State <>1

        Buttons(20).State = 1
        BD(0).MBOperation = 1

    endif

endfunction

function DisplaySubMenu()

    ink rgb(10,40,10),0
    set text size 14

    select OD(0).Menu

        rem File Menu
        case 1

            if object exist(2) then delete object 2

            text 270,666, "Filename"
            text 340,666, ":  " + FD(0).Name
            text 270,692, "Segments"
            text 340,692, ":  " + str$( FD(0).Segments )
            text 270,718, "Seg Size"
            text 340,718, ":  " + str$( FD(0).SegSize )

            OD(0).MainAction = 1
            BD(0).Changed = 0

        endcase

        rem Mold Menu
        case 2

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            if OD(0).MainAction <>2

                SetDefaultMoldBrush()
                OD(0).MainAction = 2

            endif

        endcase

        rem Paint Menu
        case 3

            text 270,666, "Brush Width"
            text 360,666, ":  " + str$( BD(0).Width )
            text 270,692, "Brush Length"
            text 360,692, ":  " + str$( BD(0).Length )
            text 270,718, "Magnitude"
            text 360,718, ":  " + str$( BD(0).Magnitude )

            OD(0).MainAction = 3
            BD(0).Changed = 0

        endcase

        case 4

            set text size 12
            text 270,660, "Welcome to the 007 Terrain Editor by McLaine."
            text 270,676, "In 'FILE' mode, move and turn by clicking and dragging in the viewport. 'W' & 'S' or mousewheel to zoom."
            text 270,692, "In 'MOLD' mode, Left Click in viewport to raise ground. Right Click to lower ground."
            text 270,708, "In 'MOLD' mode, hold control to allow camera movement as in 'FILE' mode."
            text 270,724, "Use the 'SMOOTH' function with the right mouse button to add roughness."

        endcase

    endselect

    ShowButtons( OD(0).Group )

endfunction

function PerformCurrentAction()

    select OD(0).Menu

        case 1

            FileAction()

        endcase

        case 2

            MoldAction()

        endcase

        case 3

            PaintAction()

        endcase

    endselect

endfunction

function FileAction()

    if OD(0).RepeatCount <= 0

       select OD(0).Action

           rem Load Terrain
           case 1

               set cursor 550,666
               input "Load file: ", fn$

           endcase

           rem Save Terrain
           case 2

               set cursor 550,666
               input "Save as: ", fn$

           endcase

           rem New Terrain
           case 3

               set cursor 550,666
               input "New filename: ", FD(0).Name
               set cursor 550,692
               input "Segments: ", FD(0).Segments
               set cursor 550,718
               input "Segment Size: ", FD(0).SegSize

               CreateTerrain()

                Buttons(13).State = 1
                FD(0).Wireframe = 1
                set object wireframe 1, FD(0).Wireframe

           endcase

       endselect

    endif

    ClearButtonGroup( "FILE", -1 )
    OD(0).Action = -1

endfunction

function MoldAction()

    if OD(0).Action >=1 and OD(0).Action <=6

        if OD(0).RepeatCount <=0

            ChangeBrushSize()
            BD(0).Changed = 0

        endif

        ClearButtonSubGroup( "MBSIZE", -1 )

    endif

    if OD(0).Action = 7 or OD(0).Action = 8

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 7

                    FD(0).Wireframe = 0

                endcase

                case 8

                    FD(0).Wireframe = 1

                endcase

            endselect

        endif

        set object wireframe 1, FD(0).Wireframe
        ClearButtonSubGroup( "TTYPE", OD(0).LastButton )

    endif

    if OD(0).Action = 9 or OD(0).Action = 10

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 9

                    BD(0).MBShape = 2

                endcase

                case 10

                    BD(0).MBShape = 3

                endcase

            endselect

            texture object 2, BD(0).MBShape

        endif

        ClearButtonSubGroup( "MBSHAPE", OD(0).LastButton )

    endif

    if OD(0).Action = 11 or OD(0).Action = 12

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 11

                    rem Brush adds to current terrain height
                    BD(0).MBBase = 1

                endcase

                case 12

                    rem Brush adds to an absolute base and only changes terrain
                    rem if the new height exceeds the current terrain height
                    rem in the relative direction
                    BD(0).MBBase = 0

                endcase

            endselect

        endif

        ClearButtonSubGroup( "MBBASE", OD(0).LastButton )

    endif

    if OD(0).Action = 13 or OD(0).Action = 14

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 13

                    rem Brush adds a fixed constant value
                    BD(0).MBIncType = 1

                endcase

                case 14

                    rem Brush adds a random value based on magnitude
                    BD(0).MBIncType = 0

                endcase

            endselect

        endif

        ClearButtonSubGroup( "MBINC", OD(0).LastButton )

    endif

    if OD(0).Action >= 15 and OD(0).Action <=18

        if OD(0).RepeatCount <=0

            select OD(0).Action

                case 15

                    rem set Plateau operation (Default)
                    BD(0).MBOperation = 1

                endcase

                case 16

                    rem set smoothing operation
                    BD(0).MBOperation = 2

                endcase

                case 17

                    rem set hill operation
                    BD(0).MBOperation = 3

                endcase

                case 18

                    rem set peak operation
                    BD(0).MBOperation = 4

                endcase

            endselect

        endif

        ClearButtonSubGroup( "MBOP", OD(0).LastButton )

    endif

    OD(0).Action = -1

endfunction

function PaintAction()

endfunction

function ChangeBrushSize()

    select OD(0).Action

        rem Decrease Brush Width
        case 1

            if BD(0).Width > 1 then dec BD(0).Width

        endcase

        rem Increase Brush Width
        case 2

            if BD(0).Width < FD(0).Segments + 1 then inc BD(0).Width

        endcase

        rem Decrease Brush Length
        case 3

            if BD(0).Length > 1 then dec BD(0).Length

        endcase

        rem Increase Brush Length
        case 4

            if BD(0).Length < FD(0).Segments + 1 then inc BD(0).Length

        endcase

        rem Decrease Brush Magnitude
        case 5

            if BD(0).Magnitude > 1 then dec BD(0).Magnitude

        endcase

        rem Increase Brush Magnitude
        case 6

            if BD(0).Magnitude < 100 then inc BD(0).Magnitude

        endcase

    endselect

endfunction

rem **************************************************

INIT_VariablesAndDatastructures:

    type Camera

        XPos# as float
        YPos# as float
        ZPos# as float

        XAng# as float
        YAng# as float
        ZAng# as float

        Pitch# as float
        Yaw# as float
        Roll# as float

        Slide# as float
        Speed# as float

    endtype

    type Button

        Group as string
        SubGroup as string
        Title as string
        Action as integer
        Xpos as integer
        Ypos as integer
        Width as integer
        Height as integer
        State as integer
        UpImage as integer
        DnImage as integer

    endtype

    type File

        Name as String
        Segments as integer
        SegSize as float
        Saved as integer
        Wireframe as integer

    endtype

    type Operation

        Menu as integer
        Group as string
        MainAction as integer
        Action as integer
        LastButton as integer
        RepeatCount as integer
        RepeatDelay as integer

    endtype

    type Brush

        Changed as integer
        Width as integer
        Length as integer
        Magnitude as integer
        MBShape as integer
        MBBase as integer
        MBIncType as integer
        MBOperation as integer
        Xpos as float
        Ypos as float
        Zpos as float

    endtype

    type Vertex

        Flipped as integer
        Height as float
        HtBase as float
        HtInc as float
        NormX as float
        NormY as float
        NormZ as float
        TexU as float
        TexV as float

    endtype

    dim PD(0) as Camera
    dim FD(0) as File
    dim OD(0) as Operation
    dim BD(0) as Brush

    dim ButtonCount(0) as integer
        ButtonCount(0)= 25

    dim Buttons( ButtonCount(0) ) as Button

return

rem **************************************************

ButtonData:
data "MAIN", "MAIN", "FILE", 1, 28, 656, 64, 24
data "MAIN", "MAIN", "MOLD", 2, 102, 656, 64, 24
data "MAIN", "MAIN", "PAINT", 3, 176, 656, 64, 24
data "FILE", "FILE", "LOAD", 1, 450, 660, 64, 24
data "FILE", "FILE", "SAVE", 2, 450, 688, 64, 24
data "FILE", "FILE", "NEW", 3, 450, 716, 64, 24
data "MOLD", "MBSIZE", "-", 1, 400, 660, 24, 24
data "MOLD", "MBSIZE", "+", 2, 430, 660, 24, 24
data "MOLD", "MBSIZE", "-", 3, 400, 688, 24, 24
data "MOLD", "MBSIZE", "+", 4, 430, 688, 24, 24
data "MOLD", "MBSIZE", "-", 5, 400, 716, 24, 24
data "MOLD", "MBSIZE", "+", 6, 430, 716, 24, 24
data "MOLD", "TTYPE", "SOLID", 7, 500, 674, 64, 24
data "MOLD", "TTYPE", "WIRE", 8, 500, 702, 64, 24
data "MOLD", "MBSHAPE", "SQUARE", 9, 602, 674, 64, 24
data "MOLD", "MBSHAPE", "ROUND", 10, 602, 702, 64, 24
data "MOLD", "MBBASE", "REL", 11, 702, 674, 64, 24
data "MOLD", "MBBASE", "ABS", 12, 702, 702, 64, 24
data "MOLD", "MBOP", "PLATEAU", 15, 838, 674, 64, 24
data "MOLD", "MBOP", "SMOOTH", 16, 838, 702, 64, 24
data "MOLD", "MBOP", "HILL", 17, 906, 674, 64, 24
data "MOLD", "MBOP", "PEAK", 18, 906, 702, 64, 24
data "PAINT", "PBSIZE", "-", 1, 400, 660, 24, 24
data "PAINT", "PBSIZE", "+", 2, 430, 660, 24, 24
data "PAINT", "PBSIZE", "-", 3, 400, 688, 24, 24
data "PAINT", "PBSIZE", "+", 4, 430, 688, 24, 24

remstart
`>>>>>>>>>>>>>>>>>>>>>>>> Controls <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
viewing: Crtl + wasd keys and mouse movement
Edit: Move the cursor over the world and click to edit the height
Change current height: Drag bar up/down on the right (255 = max height)
Change current radius when in Round Hill mode: drag bar up/down on the right
Change current tool: up and down keys

Shortkeys:
W: Turns wireframe on/off (when in editing mode)
G: Turns ghost on/off (when in editing mode)
T: Turn tile when in 4-point mode.
C: Turns culling on/off
remend

sync on : sync rate 100
autocam off

`Set font
set text font "Comic Sans MS"
set text size 16

`variables
#constant maxWorlds = 5
#constant maxTiles = 100
#constant maxHeight = 255.0
#constant maxTools = 3
#constant maxImages = 100

global MouseLocked as boolean
global WorldCursor as integer
global CHeight# as float
global CTool as integer
global WireFrame as integer
global Ghosted as integer
global Culled as integer

type tile
   offsetx# as float
   offsety# as float
   offsetz# as float
   turned as boolean
endtype
type world
   x# as float
   y# as float
   z# as float
   sx# as float
   sz# as float
   sy# as float
   tx as integer
   tz as integer
   img as integer
   imgx as integer
   imgy as integer
endtype

`initialize
dim World(maxWorlds) as world
dim Heightmap(maxWorlds, maxTiles+1, maxTiles+1) as float
dim Tile(maxWorlds, maxTiles, maxTiles) as tile
dim Tools(maxTools) as string

`Init tools
restore ToolsData
for i = 1 to maxTools
   read tool$
   Tools(i) = tool$
next i

`Create mouse pointer
make object cube maxWorlds + 1, 1
color object maxWorlds + 1, rgb(0, 0, 255)
set object emissive maxWorlds + 1, rgb(0,0,255)
for c = 1 to 4
   make object cube maxWorlds + 1 + c, 1
   color object maxWorlds + 1 + c, rgb(0, 255, 0)
   ghost object on maxWorlds + 1 + c
   set object emissive maxWorlds + 1 + c, rgb(0, 255, 0)
   hide object maxWorlds + 1 + c
next c

cls
ink rgb(0, 255, 0), 0
circle 100, 100, 100
get image maxImages + 4, 0, 0, 200, 200, 1

`Create vector for distances
null = make vector3(1)

`initialize
CTool = 1 : show object maxWorlds + 2
CHeight# = 0.0
Ang# = 0.0

`initialize camera
position camera -100, 100, 100
point camera 0, 0, 0
color backdrop 0, 50

`Create HUD images
cls
color1 = rgb(128, 128, 255)
color2 = rgb(255, 255, 255)
box 0, screen height() - 20, screen width() - 1, screen height() - 1, color1, color2, color1, color2
box screen width() - 20, 0, screen width() - 1, screen height() - 1, color2, color2, color1, color1
box screen width() - 20, screen height() - 20, screen width() - 1, screen height() - 1, color1, color2, color1, color1
ink rgb(255, 0, 0), 0
line screen width() - 10, screen height() - 20 - maxHeight, screen width() - 10, screen height() - 20
get image maxImages + 11, 0, 0, screen width(), screen height(), 1

color1 = rgb(100, 100, 255)
cls
box 0, 0, 350, 16, color1, rgb(128, 128, 255), color1, rgb(128, 128, 255)
get image maxImages + 12, 0, 0, 350, 16, 1

cls
box 0, 0, 100, 16, color1, color2, color1, color2
get image maxImages + 14, 0, 0, 100, 16, 1

cls
box 0, 0, 100, 16, color2, color1, color2, color1
get image maxImages + 15, 0, 0, 100, 16, 1

do

   `Handle mouse in 3D if mouse is not locked
   if MouseLocked = 0
      gosub Handle3Dmouse
      if WorldCursor > 0 then gosub EditWorld

      `show cursor
      if object visible(maxWorlds + 1) = 0 then show object maxWorlds + 1
   else

      if object visible(maxWorlds + 1) = 1 then hide object maxWorlds + 1

   endif

   `Camera movement
   if controlkey() = 1

      `Reset mouse
      if MouseLocked = 0

         `Stop the screen to "jump" when pressing ctrl
         position mouse screen width()/2, screen height()/2
         null = mousemovex()
         null = mousemovey()

         `Lock mouse
         MouseLocked = 1
      endif

      `Rotate camera with the mouse
      rotate camera wrapvalue(camera angle x() + (mousemovey()*0.2)), wrapvalue(camera angle y() + (mousemovex()*0.2)), 0
      position mouse screen width()/2, screen height()/2

      `controls
      if keystate(17) = 1 then move camera 0.5
      if keystate(31) = 1 then move camera -0.5
      if keystate(30) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()-90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()-90), 0.5)
      endif
      if keystate(32) = 1
         position camera newxvalue(camera position x(), wrapvalue(camera angle y()+90), 0.5), camera position y(), newzvalue(camera position z(), wrapvalue(camera angle y()+90), 0.5)
      endif
   endif

   `Control HUD
   gosub HUDControl

   `Unlock
   if controlkey() = 0 and mousex() < screen width() - 20 and mousey() < screen height() - 20 then MouseLocked = 0

   for i = 1 to maxWorlds
      if object exist(i) > 0
         UpdateWorldObj(i)
      endif
   next i

   sync
loop

`Handle mouse
Handle3Dmouse:

   `get camera information
   camx# = camera position x()
   camy# = camera position y()
   camz# = camera position z()

   `setup vector
   pick screen mousex(), mousey(), 1500
   mx1# = get pick vector x()
   my1# = get pick vector y()
   mz1# = get pick vector z()

   `Get world and intersection point
   WorldCursor = 0
   olddist# = 1500.0
   for w = 1 to maxWorlds
      if object exist(w) = 1
         dist# = intersect object(w, camx#, camy#, camz#, camx# + mx1#, camy# + my1#, camz# + mz1#)

         if dist# > 0.0 and dist# < olddist#
            mx# = (mx1# / 1500.0 * dist#)
            my# = (my1# / 1500.0 * dist#)
            mz# = (mz1# / 1500.0 * dist#)
            WorldCursor = w
            olddist# = dist#
         endif
      endif
   next w

   `Calc world coords
   mx# = camx# + mx#
   my# = camy# + my#
   mz# = camz# + mz#

   `Update pointer
   position object maxWorlds + 1, mx#, my#, mz#

   `Get second pointer(s) position
   if WorldCursor > 0
      tx# = World(WorldCursor).tx * ((mx# - World(WorldCursor).x#)+World(WorldCursor).sx#/2) / World(WorldCursor).sx#
      tz# = World(WorldCursor).tz * ((mz# - World(WorldCursor).z#)+World(WorldCursor).sz#/2) / World(WorldCursor).sz#
      select CTool
         case 1
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
         endcase
         case 2
            tx = int(tx#) : tz = int(tz#)
            PositionCursor(maxWorlds + 2, WorldCursor, tx, tz)
            PositionCursor(maxWorlds + 3, WorldCursor, tx + 1, tz)
            PositionCursor(maxWorlds + 4, WorldCursor, tx, tz + 1)
            PositionCursor(maxWorlds + 5, WorldCursor, tx + 1, tz + 1)
         endcase
         case 3
            Ang# = wrapvalue(Ang# + 1.0)
            tx = int(tx# + 0.5) : tz = int(tz# + 0.5)
            for c = 1 to 4
               x# = mx# + cos(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sx# / World(WorldCursor).tx)
               z# = mz# + sin(wrapvalue(Ang# + (c-1)*90)) * (CHeight# * 0.2) * (World(WorldCursor).sz# / World(WorldCursor).tz)
               position object maxWorlds + 1 + c, x#, World(WorldCursor).y# + intersect object(WorldCursor, x#, World(WorldCursor).y#, z#, x#, World(WorldCursor).y# + World(WorldCursor).sy#, z#), z#
            next c
         endcase
      endselect
   endif

return

EditWorld:

   `Change Edit Mode
   if upkey() = 1 and KeyHold = 0
      KeyHold = 1
      inc CTool
   endif
   if downkey() = 1 and KeyHold = 0
      KeyHold = 1
      dec CTool
   endif

   `Check
   if KeyHold > 0

      `Boundry
      if CTool < 1 then CTool = maxTools
      if CTool > maxTools then CTool = 1

      `Hide - unhide cursor
      select CTool
         case 1
            show object maxWorlds + 2
            hide object maxWorlds + 3
            hide object maxWorlds + 4
            hide object maxWorlds + 5
         endcase
         case 2
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
         case 3
            for c = 1 to 4 : show object maxWorlds + 1 + c : next c
         endcase
      endselect
   endif

   `Get tool
   select CTool
      case 1
         if mouseclick() = 1 then Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#
      endcase
      case 2

         if mouseclick() = 1
            if tx >= 0 and tz >= 0
               `First point
               if tx <= World(WorldCursor).tx and tz <= World(WorldCursor).tz
                  Heightmap(WorldCursor, tx + 1, tz + 1) = CHeight#

                  `Second point
                  if tx <= World(WorldCursor).tx - 1
                     Heightmap(WorldCursor, tx + 2, tz + 1) = CHeight#
                     `Third point
                     if tz <= World(WorldCursor).tz - 1
                        Heightmap(WorldCursor, tx + 2, tz + 2) = CHeight#
                     endif
                  endif

                  `Last point
                  if tz <= World(WorldCursor).tz -1
                     Heightmap(WorldCursor, tx + 1, tz + 2) = CHeight#
                  endif
               endif
            endif
         endif

      endcase
      case 3

         rad = int(CHeight# * 0.2)

         if mouseclick() = 1 then in = 1
         if mouseclick() = 2 then in = -1

         `Calculate all positions
         if mouseclick() > 0
            for x = int(tx - rad) to int(tx + rad) + 1
               for y = int(tz - rad) to int(tz + rad) + 1

                  `Calc distance
                  set vector3 1, tx - x, 0, tz - y
                  Dist# = length vector3(1)

                  `If that distance <= rad then that point is edited
                  if Dist# <= rad

                     `Check if the point is in the world
                     if x >= 0 and x <= World(WorldCursor).tx
                        if y >= 0 and y <= World(WorldCursor).tz

                           `Increase height
                           Height = Heightmap(WorldCursor, x + 1, y + 1) + (rad - Dist#) * in

                           `Boundries
                           if Height < 0 then Height = 0
                           if Height > maxHeight then Height = maxHeight

                           `Update
                           Heightmap(WorldCursor, x + 1, y + 1) = Height

                        endif
                     endif

                  endif
               next y
            next x
         endif
      endcase
   endselect

   if mouseclick() > 0
      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Right click
   if keystate(20) = 1 and CTool = 2 and KeyHold = 0
      KeyHold = 1

      `Boundries
      if tx >= 0 and tz >= 0
         if tx <= World(WorldCursor).tx - 1 and tz <= World(WorldCursor).tz - 1
            if Tile(WorldCursor, tx + 1, tz + 1).turned = 0
               Tile(WorldCursor, tx + 1, tz + 1).turned = 1
            else
               Tile(WorldCursor, tx + 1, tz + 1).turned = 0
            endif
         endif
      endif

      `Update world mesh
      UpdateWorldMesh(WorldCursor)
      change mesh WorldCursor, 0, WorldCursor
   endif

   `Wireframe on off
   if keystate(17) > 0 and KeyHold = 0
      KeyHold = 1
      Wireframe = abs(Wireframe - 1)
      if Wireframe = 1 then set object wireframe WorldCursor, 1 else set object wireframe WorldCursor, 0
   endif
   if keystate(34) > 0 and KeyHold = 0
      KeyHold = 1
      Ghosted = abs(Ghosted - 1)
      if Ghosted = 1 then ghost object on WorldCursor else ghost object off WorldCursor
   endif
   if keystate(46) > 0 and KeyHold = 0
      KeyHold = 1
      Culled = abs(Culled - 1)
      if Culled = 1 then set object cull WorldCursor, 0 else set object cull WorldCursor, 0
   endif

   `Unlock keyhold
   if upkey() + downkey() + mouseclick() + keystate(17) + keystate(34) + keystate(20) + keystate(46) = 0 then KeyHold = 0

return

HUDControl:

   `Paste HUD
   paste image maxImages + 11, 1, 1, 1

   `Display cursor information
   ink rgb(255, 255, 255), 0
   set cursor 0, 0
   print "Tile: ", tx, " : ", tz
   print "Pointed world: ", WorldCursor
   print "Current tool: " + Tools(CTool)

   `Additional message
   ink rgb(0,255,0),0
   if msg$ <> ""
      inc Time
      print msg$
   else
      Time = 0
   endif
   if Time > 250 then msg$ = ""

   `Height indicator
   ink rgb(0,255,0),0
   box screen width() - 11, screen height() - 21 - CHeight#, screen width() - 9, screen height() - 19 - CHeight#
   ink rgb(255,255,255),0
   if CTool = 3
      center text screen width() - 10, 10, str$(int(CHeight# * 0.2))
   else
      center text screen width() - 10, 10, str$(CHeight#)
   endif

   `Right menu
   if mousex() > screen width() - 20
      MouseLocked = 1
      if mouseclick() = 1
         CHeight# = screen height() - mousey() - 20
         if CHeight# > maxHeight then CHeight# = maxHeight
         if CHeight# < 0 then CHeight# = 0
      endif
   endif

   `Bottom menu
   if mousey() > screen height() - 20
      MouseLocked = 1
   endif

   `Tools
   if button(60, screen height() - 10, "Tools") > 0 then gosub Tools
   if button(170, screen height() - 10, "Export") > 0 then gosub Export
   if button(280, screen height() - 10, "Exit") > 0 then end

return

Tools:

   `Get background image
      `Background
      ink rgb(255, 255, 255), 0
      box 50, 50, 450, 350
   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Initialize
   FillWorld = 1 : FillHeight = 0
   FHeight = 0 : THeight = 0
   MouseTimer = 0
   TilesX = 1 : TilesZ = 1
   Tool = 1 : GoOut = 0
   posx$ = str$(World(1).x#) : posy$ = str$(World(1).y#) : posz$ = str$(World(1).z#)
   sizex$ = str$(World(1).sx#) : sizey$ = str$(World(1).sy#) : sizez$ = str$(World(1).sz#)

   clear entry buffer

   do

      `Background
      paste image maxImages + 1, 0, 0

      `Select tool
      if textbutton(85, 80, "<") > 0 and hold = 0
         hold = 1
         dec Tool
         if Tool < 1 then Tool = 1
      endif
      if textbutton(250, 80, ">") > 0 and hold = 0
         hold = 1
         inc Tool
         if Tool > 5 then Tool = 5
      endif

      `Display tool

      ink rgb(0, 0, 255), 0
      select Tool
         case 1
            text 100, 75, "Create World"
            gosub CreateNewWorld
         endcase
         case 2
            text 100, 75, "Update World"
            gosub UpdateWorld
         endcase
         case 3
            text 100, 75, "Fill"
            gosub Fill
         endcase
         case 4
            text 100, 75, "Randomize"
            gosub WorldRand
         endcase
         case 5
            text 100, 75, "Smooth"
            gosub WorldSmooth
         endcase
      endselect

      `Display quit button
      if button(200, 340, "Return") > 0 then GoOut = 1

      `Unlock mouse
      if mouseclick() = 0 then hold = 0

      `Quit tools
      if GoOut > 0
         repeat : until mouseclick() = 0
         return
      endif

      sync
   loop

return

`>>>>> Tools <<<<<<<
Fill:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Height selecting
   ink 0, 0
   text 100, 115, "Height:"
   D = textbutton(250, 120, "<")
   U = textbutton(300, 120, ">")
   if U > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FillHeight
   endif
   if D > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FillHeight
   endif
   if D + U = 0 then MouseTimer = 0
   if FillHeight < 0 then FillHeight = 0
   if FillHeight > maxHeight then FillHeight = maxHeight
   ink 0, 0
   center text 275, 115, str$(FillHeight)

   `Apply button
   if button(200, 150, "Edit") > 0
      repeat
      until mouseclick() = 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FillHeight
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
      endif
      GoOut = 1
   endif
return

WorldRand:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display From and To Height
   ink 0, 0
   text 100, 115, "Min Height:"
   text 100, 135, "Max Height:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc FHeight
   endif
   if D1 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec FHeight
   endif
   if U2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then inc THeight
   endif
   if D2 > 0
      inc MouseTimer
      if MouseTimer = 1 or MouseTimer > 50 then dec THeight
   endif

   `Boundries
   if FHeight < 0 then FHeight = 0
   if FHeight > maxHeight then FHeight = maxHeight
   if THeight < 0 then THeight = 0
   if THeight > maxHeight then THeight = maxHeight

   ink 0, 0
   center text 275, 115, str$(FHeight)
   center text 275, 135, str$(THeight)

   if D1 + U1 + D2 + U2 = 0 then MouseTimer = 0

   `Apply
   if button(200, 160, "Edit") > 0
      if object exist(FillWorld) > 0
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tx + 1
               Heightmap(FillWorld, x, y) = FHeight + rnd(THeight - FHeight)
            next x
         next y
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

WorldSmooth:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Smooth button
   if button(200, 128, "Edit") > 0
      if object exist(FillWorld) > 0
         SmoothHeightmap(FillWorld)
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

return

CreateNewWorld:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
   endif

   `Display filled world
   if object exist(FillWorld) = 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Display tiles
   ink 0, 0
   text 100, 115, "Tiles X:"
   text 100, 135, "Tiles Z:"
   D1 = textbutton(250, 120, "<") : U1 = textbutton(300, 120, ">")
   D2 = textbutton(250, 140, "<") : U2 = textbutton(300, 140, ">")
   if U1 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then inc TilesX
   endif
   if D1 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then dec TilesX
   endif
   if U2 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then inc TilesZ
   endif
   if D2 > 0
      inc MouseTimer : if MouseTimer = 1 or MouseTimer > 50 then dec TilesZ
   endif

   `Boundries
   if TilesX > maxTiles then TilesX = maxTiles
   if TilesZ > maxTiles then TilesZ = maxTiles
   if TilesX < 1 then TilesX = 1
   if TilesZ < 1 then TilesZ = 1

   `Display tiles
   ink 0, 0
   center text 275, 115, str$(TilesX)
   center text 275, 135, str$(TilesZ)

   `Reset timer
   if D1 + D2 + U1 + U2 = 0 then MouseTimer = 0

   `Display size
   select typ
      case 1 : add1$ = "_" : add2$ = "" : add3$ = "" : endcase
      case 2 : add1$ = "" : add2$ = "_" : add3$ = "" : endcase
      case 3 : add1$ = "" : add2$ = "" : add3$ = "_" : endcase
   endselect
   paste image maxImages + 12, 75, 155
   paste image maxImages + 12, 75, 175
   paste image maxImages + 12, 75, 195
   text 100, 155, "Size X:" + sizex$ + add1$
   text 100, 175, "Size Y:" + sizey$ + add2$
   text 100, 195, "Size Z:" + sizez$ + add3$

   `Type
   if mouseclick() = 1
      if mousex() > 100 and mousex() < 300
         if mousey() > 155 and mousey() < 172 then typ = 1
         if mousey() > 175 and mousey() < 183 then typ = 2
         if mousey() > 195 and mousey() < 203 then typ = 3
      endif
   endif
   if typ > 0
      char$ = entry$()
      select asc(char$)
         case 13 : typ = 0 : endcase
         case 8
            if typ = 1 then sizex$ = left$(sizex$, len(sizex$) - 1)
            if typ = 2 then sizey$ = left$(sizey$, len(sizey$) - 1)
            if typ = 3 then sizez$ = left$(sizez$, len(sizez$) - 1)
         endcase
         case default
            if typ = 1 then sizex$ = sizex$ + char$
            if typ = 2 then sizey$ = sizey$ + char$
            if typ = 3 then sizez$ = sizez$ + char$
         endcase
      endselect
   endif
   clear entry buffer

   `Create button
   if button(200, 230, "Create") > 0
      if object exist(FillWorld) = 0

         `Store variables
         World(FillWorld).sx# = val(sizex$)
         World(FillWorld).sy# = val(sizey$)
         World(FillWorld).sz# = val(sizez$)
         World(FillWorld).tx = TilesX
         World(FillWorld).tz = TilesZ

         `Create World mesh
         CreateWorldMesh(FillWorld)
         make object FillWorld, FillWorld, 0
         set object collision to polygons FillWorld
         GoOut = 1
      endif
   endif

return

UpdateWorld:

   ink 0, 0
   text 100, 95, "World:"

   `World selecting
   if textbutton(250, 100, "<") > 0 and hold = 0
      hold = 1 : dec FillWorld
      if FillWorld < 1 then FillWorld = maxWorlds
      posx$ = str$(World(FillWorld).x#)
      posy$ = str$(World(FillWorld).y#)
      posz$ = str$(World(FillWorld).z#)
   endif
   if textbutton(300, 100, ">") > 0 and hold = 0
      hold = 1 : inc FillWorld
      if FillWorld > maxWorlds then FillWorld = 1
      posx$ = str$(World(FillWorld).x#)
      posy$ = str$(World(FillWorld).y#)
      posz$ = str$(World(FillWorld).z#)
   endif

   `Display filled world
   if object exist(FillWorld) > 0 then ink rgb(0, 255, 0), 0 else ink rgb(255, 0, 0), 0
   center text 275, 95, str$(FillWorld)

   `Get position
   `Display size
   ink 0, 0
   select typ
      case 0 : add1$ = "" : add2$ = "" : add3$ = "" : endcase
      case 1 : add1$ = "_" : add2$ = "" : add3$ = "" : endcase
      case 2 : add1$ = "" : add2$ = "_" : add3$ = "" : endcase
      case 3 : add1$ = "" : add2$ = "" : add3$ = "_" : endcase
   endselect
   paste image maxImages + 12, 75, 115
   paste image maxImages + 12, 75, 135
   paste image maxImages + 12, 75, 155
   text 100, 115, "Position X:" + posx$ + add1$
   text 100, 135, "Position Y:" + posy$ + add2$
   text 100, 155, "Position Z:" + posz$ + add3$

   `Type
   if mouseclick() = 1
      if mousex() > 100 and mousex() < 300
         if mousey() >= 115 and mousey() < 135 then typ = 1
         if mousey() >= 135 and mousey() < 155 then typ = 2
         if mousey() >= 155 and mousey() < 175 then typ = 3
      endif
   endif
   if typ > 0
      char$ = entry$()
      select asc(char$)
         case 13 : typ = 0 : endcase
         case 8
            if typ = 1 and len(posx$) > 0 then posx$ = left$(posx$, len(posx$) - 1)
            if typ = 2 and len(posy$) > 0 then posy$ = left$(posy$, len(posy$) - 1)
            if typ = 3 and len(posz$) > 0 then posz$ = left$(posz$, len(posz$) - 1)
         endcase
         case default
            if typ = 1 then posx$ = posx$ + char$
            if typ = 2 then posy$ = posy$ + char$
            if typ = 3 then posz$ = posz$ + char$
         endcase
      endselect
   endif
   clear entry buffer

   `Update button
   if button(200, 220, "Update") > 0
      if object exist(FillWorld) = 1

         `Store variables
         World(FillWorld).x# = val(posx$)
         World(FillWorld).y# = val(posy$)
         World(FillWorld).z# = val(posz$)

         `Create World mesh
         UpdateWorldMesh(FillWorld)
         change mesh FillWorld, 0, FillWorld
         GoOut = 1
      endif
   endif

   `Delete button
   if button(310, 220, "Delete") > 0
      if object exist(FillWorld) = 1

         `Reset heightmap
         for y = 1 to World(FillWorld).tz + 1
            for x = 1 to World(FillWorld).tz + 1
               Heightmap(FillWorld, x, y) = 0
            next x
         next y

         `Reset tile map
         for y = 1 to World(FillWorld).tz
            for x = 1 to World(FillWorld).tx
               Tile(FillWorld, x, y).turned = FALSE
            next x
         next y

         `Reset world data
         World(FillWorld).x# = 0 : World(FillWorld).y# = 0 : World(FillWorld).z# = 0
         World(FillWorld).sx# = 0 : World(FillWorld).sy# = 0 : World(FillWorld).sz# = 0
         World(FillWorld).tx = 0 : World(FillWorld).tz = 0

         `Delete objects, meshes and memblocks
         delete object FillWorld
         if mesh exist(FillWord) > 0 then delete mesh FillWorld
         if memblock exist(FillWorld) > 0 then delete memblock FillWorld
         GoOut = 1
      endif
   endif

return

`>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXPORT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Export:

   `Init
   FileExp = 0
   FileName$ = ""
   TypAct = 0

   `Get background
   ink rgb(255, 255, 255), 0
   box 5, 5, 350, 250
   ink rgb(100, 100, 255), 0
   box 10, 10, 340, 30
   get image maxImages + 1, 0, 0, screen width(), screen height(), 1

   `Input
   ink 0, 0
   do

      `Refresh background
      paste image maxImages + 1, 0, 0

      `Input
      if TypAct = 1
         char$ = entry$()
         select asc(char$)
            case 13
               TypAct = 0
            endcase
            case 8
               FileName$ = left$(FileName$, len(FileName$) - 1)
            endcase
            case default
               FileName$ = FileName$ + char$
            endcase
         endselect
      else

         `Type if clicked on filename area.
         if mousex() > 10 and mousex() < 340
            if mousey() > 10 and mousey() < 30
               if mouseclick() = 1 then TypAct = 1
            endif
         endif
      endif
      clear entry buffer

      `Display input
      if TypAct = 1 then add$ = "_" else add$ = ""
      paste image maxImages + 12, 12, 12
      text 12, 12, "Filename:" + FileName$ + add$

      `Export buttons
      if button(70, 50, "DBO object") > 0 then Msg$ = SaveDBO(FileName$) : exit
      if button(180, 50, "Heightmap") > 0 then Msg$ = SaveHeightmap(FileName$) : exit
      if button(290, 50, "Return") > 0
         exit
      endif

      sync
   loop

return

`**************************
`Functions
`**************************

function UpdateWorldObj(w)
   position object w, World(w).x#, World(w).y#, World(w).z#
endfunction

function SmoothHeightmap(w)

   `Extract data
   tx = World(w).tx + 1
   tz = World(w).tz + 1

   `temporary copy of heightmap
   dim TEMP(tx, tz)
   for y = 1 to tz : for x = 1 to tx : TEMP(x, y) = Heightmap(w, x, y) : next x : next y

   `Smooth heights
   for y = 2 to tz - 1
      for x = 2 to tx - 1

         fHeight# = TEMP(x, y) * 0.5

         `Top down left and right
         fHeight# = fHeight# + (TEMP(x - 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x + 1, y) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y - 1) * 0.08)
         fHeight# = fHeight# + (TEMP(x, y + 1) * 0.08)

         `top-left/right and bottom-left/right
         fHeight# = fHeight# + (TEMP(x - 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x - 1, y + 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y - 1) * 0.045)
         fHeight# = fHeight# + (TEMP(x + 1, y + 1) * 0.045)

         `store final height in the destination heightmap
         Heightmap(w, x, y) = fHeight#
      next x
   next y

   `Sides
   for y = 2 to tz - 1

      `Left row
      fHeight# = TEMP(1, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(1, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(1, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(2, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(2, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(2, y + 1) * 0.045)

      Heightmap(w, 1, y) = fHeight#

      `Right row
      fHeight# = TEMP(tx, y) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(tx, y + 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx, y - 1) * 0.08)
      fHeight# = fHeight# + (TEMP(tx - 1, y) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(tx - 1, y - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(tx - 1, y + 1) * 0.045)

      Heightmap(w, tx, y) = fHeight#
   next y

   for x = 2 to tx - 1

      `Left row
      fHeight# = TEMP(x, 1) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x + 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x - 1, 1) * 0.08)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)
      fHeight# = fHeight# + (TEMP(x, 2) * 0.045)

      Heightmap(w, x, 1) = fHeight#

      `Right row
      fHeight# = TEMP(x, tz) * 0.65

      `Top down and right
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz) * 0.08)
      fHeight# = fHeight# + (TEMP(x, tz - 1) * 0.08)

      `Topleft and bottomleft
      fHeight# = fHeight# + (TEMP(x - 1, tz - 1) * 0.045)
      fHeight# = fHeight# + (TEMP(x + 1, tz - 1) * 0.045)

      Heightmap(w, x, tz) = fHeight#
   next x

   `Corners
   fHeight# = TEMP(1, 1) * 0.795
   fHeight# = fHeight# + (TEMP(1, 2) * 0.08) + (TEMP(2,1) * 0.08) + (TEMP(2, 2) * 0.045)
   Heightmap(w, 1, 1) = fHeight#

   fHeight# = TEMP(1, tz) * 0.795
   fHeight# = fHeight# + (TEMP(1, tz - 1) * 0.08) + (TEMP(2, tz) * 0.08) + (TEMP(2, tz - 1) * 0.045)
   Heightmap(w, 1, tz) = fHeight#

   fHeight# = TEMP(tx, 1) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, 1) * 0.08) + (TEMP(tx, 2) * 0.08) + (TEMP(tx - 1, 2) * 0.045)
   Heightmap(w, tx, 1) = fHeight#

   fHeight# = TEMP(tx, tz) * 0.795
   fHeight# = fHeight# + (TEMP(tx - 1, tz) * 0.08) + (TEMP(tx, tz - 1) * 0.08) + (TEMP(tx - 1, tz - 1) * 0.045)
   Heightmap(w, tx, tz) = fHeight#

   `Undim temporary array
   undim TEMP(0)

endfunction

function SaveHeightmap(file$)

   if file$ <> ""
      for w = 1 to maxWorlds
         if object exist(w) > 0
            if file exist(file$ + str$(w) + ".bmp") = 0
               `Return message
               msg$ = "Save complete"

               width = World(w).tx + 1
               height= World(w).tz + 1

               `Create image memblock
               make memblock maxWorlds + 1, 12 + (width * height * 4)
               write memblock dword maxWorlds + 1, 0, width
               write memblock dword maxWorlds + 1, 4, height
               write memblock dword maxWorlds + 1, 8, 32

               `Write pixels
               for y = 1 to height
                  for x = 1 to width

                     `Calc position
                     pos = 12 + (((y-1)*width + x - 1)*4)

                     `Write color using heightmap
                     h = Heightmap(w, x, y)
                     write memblock dword maxWorlds + 1, pos, rgb(h, h, h)

                  next x
               next y

               `Export image
               make image from memblock maxImages + 2, maxWorlds + 1
               delete memblock maxWorlds + 1
               save image file$ + str$(w) + ".bmp", maxImages + 2
            else
               msg$ = "File already exist"
               exitfunction msg$
            endif
         endif
      next w
   else
      msg$ = "File name is invalid"
   endif

endfunction msg$

function SaveDBO(file$)

   climb = 0

   `Create Export file
   for w = 1 to maxWorlds

      `If w exists, add as a limb
      if object exist(w) > 0
         if object exist(maxWorlds + 20) = 0
            clone object maxWorlds + 20, w
            offset limb maxWorlds + 20, 0, World(w).x#, World(w).y#, World(w).z#
         else
            inc climb
            add limb maxWorlds + 20, climb, w
            offset limb maxWorlds + 20, climb, World(w).x#, World(w).y#, World(w).z#
         endif
      endif
   next w

   if file$ <> ""
      if file exist(file$ + ".dbo") = 0
         save object file$ + ".dbo", maxWorlds + 20
         msg$ = "Save complete"
      else
         msg$ = "File already exists."
      endif
   else
      msg$ = "File name is invalid"
   endif
   perform checklist for object limbs maxWorlds + 20
   msg$ = str$(checklist quantity())
   if object exist(maxWorlds + 20) > 0 then delete object maxWorlds + 20

endfunction msg$

function textbutton(x, y, txt$)
   pressed = 0
   tx = text width(txt$) / 2
   ty = text height(txt$) / 2
   if mousex() > x - tx and mousex() < x + tx
      if mousey() > y - ty and mousey() < y + ty
         pressed = 1
      endif
   endif
   if pressed = 1 then ink rgb(0, 0, 255), 0 else ink 0, 0
   center text x, y - ty, txt$
   if mouseclick() = 0 then pressed = 0
endfunction pressed

function button(x, y, txt$)

   Pressed = 0

   `box
   paste image maxImages + 14, x - 50, y - 8
   if mousex() > x - 50 and mousex() < x + 50 and mousey() > y - 8 and mousey() < y + 8
      Pressed = 1
   endif

   `Text
   ink 0, 0
   if Pressed = 0 then ink 0, 0 else ink rgb(0, 0, 255), 0
   if mouseclick() = 0
      Pressed = 0
   else
      if Pressed = 1
         paste image maxImages + 15, x - 50, y - 8
      endif
   endif
   center text x, y - text height(txt$)/2, txt$

endfunction Pressed

function PositionCursor(cur, w, tx, tz)

   `Calculate position
   Ctx# = (tx * World(w).sx# / World(w).tx) - (World(w).sx#/2)
   Ctz# = (tz * World(w).sz# / World(w).tz) - (World(w).sz#/2)
   if tx >= 0 and tx <= World(w).tx
      if tz >= 0 and tz <= World(w).tz
         Cty# = World(w).sy# / maxHeight * Heightmap(w, tx + 1, tz + 1)
      endif
   endif

   `Update position
   position object cur, World(w).x# + Ctx#, World(w).y# + Cty#, World(w).z# + Ctz#

endfunction

function UpdateWorldMesh(w)

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   for y = 1 to World(w).tz
      for x = 1 to World(w).tx
         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         `Turned tiles
         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function CreateWorldMesh(w)

   `Calculate number of triangles
   Tri = World(w).tx * World(w).tz * 2

   `Calculate step values
   stX# = World(w).sx# / World(w).tx
   stZ# = World(w).sz# / World(w).tz
   scY# = World(w).sy#

   `Calculate position
   cX# = - (World(w).sx#/2)
   cZ# = - (World(w).sz#/2)

   `Create a memblock (3 verts each triangle)
   make memblock w, 12 + (Tri * 3 * 36)
   write memblock dword w, 0, 338
   write memblock dword w, 4, 36
   write memblock dword w, 8, Tri * 3

   `Write memblocks
   for y = 1 to World(w).tx
      for x = 1 to World(w).tz

         p = 1 + (((y-1)*World(w).tx + x - 1)*6)

         remstart
         Our face looks this way if turned = FALSE
         +-----+
         |    /|
         |   / |
         | /   |
         |/    |
         +-----+
         else
         +-----+
         |\    |
         | \   |
         |   \ |
         |    \|
         +-----+
         remend

         `1st triangle
         x1# = cX# + ((x-1)*stX#)
         x2# = cX# + (x*stX#)
         z1# = cZ# + ((y-1)*stZ#)
         z2# = cZ# + (y*stZ#)

         h1# = scY# / maxHeight * Heightmap(w, x, y)
         h2# = scY# / maxHeight * Heightmap(w, x+1, y)
         h3# = scY# / maxHeight * Heightmap(w, x, y+1)
         h4# = scY# / maxHeight * Heightmap(w, x+1, y+1)

         if Tile(w, x, y).turned = FALSE
            `First tri
            WriteVertex(w, p, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+1, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
            WriteVertex(w, p+2, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+4, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+5, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)
         else
            `First tri
            WriteVertex(w, p, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+1, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
            WriteVertex(w, p+2, x2#, h2#, z1#, x2#, h2# + 10.0, z1#, 1.0, 0.0)

            `Second tri
            WriteVertex(w, p+3, x1#, h1#, z1#, x1#, h1# + 10.0, z1#, 0.0, 0.0)
            WriteVertex(w, p+4, x1#, h3#, z2#, x1#, h3# + 10.0, z2#, 0.0, 1.0)
            WriteVertex(w, p+5, x2#, h4#, z2#, x2#, h4# + 10.0, z2#, 1.0, 1.0)
         endif

      next x
   next y

   make mesh from memblock w, w

endfunction

function WriteVertex(mem, nr, x#, y#, z#, nx#, ny#, nz#, uvx#, uvy#)

   pos = 12 + ((nr-1)*36)

   write memblock float mem, pos, x#
   write memblock float mem, pos+4, y#
   write memblock float mem, pos+8, z#
   write memblock float mem, pos+12,nx#
   write memblock float mem, pos+16,ny#
   write memblock float mem, pos+20,nz#
   write memblock dword mem, pos+24, rgb(255,255,255)
   write memblock float mem, pos+28, uvx#
   write memblock float mem, pos+32, uvy#

endfunction

`>>>>>>>>>>> DATA <<<<<<<<<<<<<<<<<
ToolsData:
data "Point path"
data "4 point path"
data "Round Hill"

data "MOLD", "MBSIZE", "+

function DefaultTerrain()

    FD(0).Name = "Default"
    FD(0).Segments = 20
    FD(0).SegSize = 5
    FD(0).Saved = 0

    CreateTerrain()

    BD(0).Width = 1
    BD(0).Length = 1
    BD(0).Magnitude = 1

    OD(0).Menu = 4
    OD(0).MainAction = 1

endfunction

Sven B

Mclaine

-Must be able to save as .dbo and as a heightmap.