Challenge:
Winner?:
Yes
Code Snippet:
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)