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"