Code archives/3D Graphics - Misc/Heightland
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
This program essentially takes a HEIGHTMAP (a greyscale image where white represents the highest point of a landscape and black the lowest one), blends it with the four textures from the TEXTURE BLENDER window and gives a COLOURMAP (representing the texture of the landscape) as a result. It also comes with some useful functions, as the ability to have a 3D preview of the generated landscape and the preset saving function. In order to work it integrates the both excellent Rhodan's colourmap algorithm and Yappy's GUI. Full credits are provided within the website and the application itself. Head over Heightland's website in order to download the main executable and/or the source code with all the needed support files: Heightland Homepage [updated to version 0.5a, now with complete html documentation] Here below there is the main code, without support files: | |||||
;=================================================================================== ; ; "Heightland 0.5b - Heightmap based Texture Landscape Generator" ; ; --CREDITS-- ; Procedural Colourmap Algorithm: Rhodan (Pat Meloy, derived from a tutorial by Tobias Franke) ; GUI: Yappy (Stewart Yapp) ; Interface & advanced functions: Doiron (Leonardo D'Alessandri) ; ; Special thanks to all the blitz community! ; ;=================================================================================== Include "XLnt-3D_v1.0.bb" Include "start.bb" AppTitle ("Heightland 0.5b - Heightmap based Texture Landscape Generator") Const FPS = 30 Global fstep Global ExitProgram=False Global Windowed period=1000/FPS time=MilliSecs()-period GUI_GFXSETUP() SetFont LoadFont("VERDANA",14,True) StartDir$=CurrentDir() Global snowlev,snowblend,stonelev,stoneblend,grasslev,grassblend,sandblend ;** SKINS ** ;ChangeDir StartDir$ ;DefaultSkin=LoadImage("skin_darkoak.bmp") ;GUI_DEFAULT_SKIN(DefaultSkin) ;CREATE **TEXTURE BLENDING WINDOW** Blending.Window=GUI_WINDOW.window(8,8,400,464,"TEXTURE BLENDER",1,0,1,0,0) SnowFrame.gadget=GUI_FRAME.gadget(Blending.Window,10,20,260,100,"Snow",0,"Snow Related Settings") SnowText1.gadget=GUI_TEXT.gadget(Blending.Window,20,35,200,10,"Snow start level:","")SnowText1.gadget=GUI_TEXT.gadget(Blending.Window,20,35,200,10,"Snow start level:","") SnowStartSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,50,180,192,0,255,1,1,"pull slider") SnowText2.gadget=GUI_TEXT.gadget(Blending.Window,20,65,200,10,"Snow blending range:","") SnowRangeSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,80,180,12,0,255,1,1,"pull slider") SnowStartValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,48,35,SnowStartSlider\slider\val,"",0,0,"") SnowRangeValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,78,35,SnowRangeSlider\slider\val,"",0,0,"") SnowInputFile.gadget=GUI_TXTINPUT.gadget(Blending.Window,20,100,172,".\TextureSets\Default\snowtexture.bmp","File:",0,1,"") SnowLoadFile.gadget=GUI_BUTTUN.gadget(Blending.Window,230,100,33,"dirs",1,"Leaf through your folders...") SnowTexture.gadget=GUI_IMAGEBOX.gadget(Blending.Window,280,26,110,100,SnowInputFile\txtinput\txt$,1,1,"") StoneFrame.gadget=GUI_FRAME.gadget(Blending.Window,10,130,260,100,"Stone",0,"Stone Related Settings") StoneText1.gadget=GUI_TEXT.gadget(Blending.Window,20,145,200,10,"Stone start level:","") StoneStartSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,160,180,128,0,255,1,1,"pull slider") StoneText2.gadget=GUI_TEXT.gadget(Blending.Window,20,175,200,10,"Stone blending range:","") StoneRangeSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,190,180,12,0,255,1,1,"pull slider") StoneStartValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,158,35,StoneStartSlider\slider\val,"",0,0,"") StoneRangeValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,188,35,StoneRangeSlider\slider\val,"",0,0,"") StoneInputFile.gadget=GUI_TXTINPUT.gadget(Blending.Window,20,210,172,".\TextureSets\Default\stonetexture.bmp","File:",0,1,"") StoneLoadFile.gadget=GUI_BUTTUN.gadget(Blending.Window,230,210,33,"dirs",1,"Leaf through your folders...") StoneTexture.gadget=GUI_IMAGEBOX.gadget(Blending.Window,280,136,110,100,StoneInputFile\txtinput\txt$,1,1,"") GrassFrame.gadget=GUI_FRAME.gadget(Blending.Window,10,240,260,100,"Grass",0,"Grass Related Settings") GrassText1.gadget=GUI_TEXT.gadget(Blending.Window,20,255,200,10,"Grass start level:","") GrassStartSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,270,180,64,0,255,1,1,"pull slider") GrassText2.gadget=GUI_TEXT.gadget(Blending.Window,20,285,200,10,"Grass blending range:","") GrassRangeSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,300,180,64,0,255,1,1,"pull slider") GrassStartValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,268,35,GrassStartSlider\slider\val,"",0,0,"") GrassRangeValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,298,35,GrassRangeSlider\slider\val,"",0,0,"") GrassInputFile.gadget=GUI_TXTINPUT.gadget(Blending.Window,20,320,172,".\TextureSets\Default\grasstexture.bmp","File:",0,1,"") GrassLoadFile.gadget=GUI_BUTTUN.gadget(Blending.Window,230,320,33,"dirs",1,"Leaf through your folders...") GrassTexture.gadget=GUI_IMAGEBOX.gadget(Blending.Window,280,246,110,100,GrassInputFile\txtinput\txt$,1,1,"") SandFrame.gadget=GUI_FRAME.gadget(Blending.Window,10,350,260,100,"Sand",0,"Sand Related Settings") SandText2.gadget=GUI_TEXT.gadget(Blending.Window,20,395,200,10,"Sand blending range:","") SandRangeSlider.gadget=GUI_SLIDER.gadget(Blending.Window,20,410,180,64,0,255,1,1,"pull slider") SandRangeValue.gadget=GUI_TXTINPUT.gadget(Blending.Window,229,408,35,SandRangeSlider\slider\val,"",0,0,"") SandInputFile.gadget=GUI_TXTINPUT.gadget(Blending.Window,20,430,172,".\TextureSets\Default\sandtexture.bmp","File:",0,1,"") SandLoadFile.gadget=GUI_BUTTUN.gadget(Blending.Window,230,430,33,"dirs",1,"Leaf through your folders...") SandTexture.gadget=GUI_IMAGEBOX.gadget(Blending.Window,280,356,110,100,SandInputFile\txtinput\txt$,1,1,"") ;CREATE **HEIGHTMAP WINDOW** HeightmapLoad.Window=GUI_WINDOW.window(421,8,240,265,"HEIGHTMAP",1,0,1,0,0) HeightmapLoadFile.gadget=GUI_BUTTUN.gadget(HeightmapLoad.Window,HeightmapLoad.window\w/3-10,HeightmapLoad.window\h-20,33,"load heightmap",1,"") HeightmapTexture.gadget=GUI_IMAGEBOX.gadget(HeightmapLoad.Window,10,20,220,220,"Heightmaps\heightmap.bmp",1,1,"") ;CREATE **COLOURMAP WINDOW** Colourmap.Window=GUI_WINDOW.window(421,287,240,265,"COLOURMAP",1,0,1,0,0) ColourmapPreview.gadget=GUI_BUTTUN.gadget(Colourmap.Window,HeightmapLoad.window\w/2-StringWidth("...preview...")/1.7,21,33,"...preview...",1,"") ColourmapTexture.gadget=GUI_IMAGEBOX.gadget(Colourmap.Window,18,40,200,200,"Colourmaps\Colourmap.bmp",1,1,"") ColourmapRenderFile.gadget=GUI_BUTTUN.gadget(Colourmap.Window,HeightmapLoad.window\w/2-StringWidth("render to file...")/1.7,HeightmapLoad.window\h-20,33,"render to file...",1,"render colourmap (cpu intensive)") ColourmapLoadFile.gadget=GUI_BUTTUN.gadget(Colourmap.Window,HeightmapLoad.window\w-55,HeightmapLoad.window\h-20,33,"load",1,"load a premade colourmap") ;CREATE **TEXTURESET WINDOW** TextureSet.Window=GUI_WINDOW.window(8,486,400,100,"TEXTURE SETS",1,0,1,0,0) TextureSetFrame.gadget=GUI_FRAME.gadget(TextureSet.Window,10,20,378,40,"Current Texture Set",0,"") TextureSetInputFile.gadget=GUI_TXTINPUT.gadget(TextureSet.Window,20,40,283,".\TextureSets\default.set","File:",0,1,"") TextureSetLoadFile.gadget=GUI_BUTTUN.gadget(TextureSet.Window,343,40,33,"dirs",1,"Leaf through your folders...") TextureSetNewFile.gadget=GUI_BUTTUN.gadget(TextureSet.Window,12,75,118,"NEW",1,"Creates a new Texture Set") TextureSetSaveFile.gadget=GUI_BUTTUN.gadget(TextureSet.Window,140,75,119,"SAVE",1,"Saves current Texture Set") TextureSetSaveAsFile.gadget=GUI_BUTTUN.gadget(TextureSet.Window,267,75,118,"SAVE AS...",1,"Saves current Texture Set with a new filename") ;CREATE **MAIN WINDOW** Main.Window=GUI_WINDOW.window(675,8,80,100,"MAIN",1,0,1,0,0) Credits.gadget=GUI_BUTTUN.gadget(Main.Window,18,32,70,"Credits",1,"") About.Window=GUI_WINDOW.window(GraphicsWidth()/2-200,GraphicsHeight()/2-200,400,400,"CREDITS",1,0,1,0,0) FIL=ReadFile("Credits.dat") Repeat A$=A$+ReadLine$(FIL)+Chr$(10) Until Eof(FIL) CloseFile FIL CreditsText.gadget=GUI_TEXT.gadget(About.Window,70,40,360,360,A$,"") Backtowork.gadget=GUI_BUTTUN.gadget(About.Window,About.Window\h/2-100,About.Window\h-40,200,"Back to work...",1,"") GUI_OPENWIN(About.Window) GUI_HIDEWIN(About.Window) Help.gadget=GUI_BUTTUN.gadget(Main.Window,18,52,70,"Help",1,"") HelpPopUp.Window=GUI_WINDOW.window(GraphicsWidth()/2-200,GraphicsHeight()/2-200,400,400,"HELP",1,0,1,0,0) FIL=ReadFile("Help.dat") Repeat B$=B$+ReadLine$(FIL)+Chr$(10) Until Eof(FIL) CloseFile FIL HelpText.gadget=GUI_TEXT.gadget(HelpPopup.Window,20,40,360,360,B$,"") Backtowork2.gadget=GUI_BUTTUN.gadget(HelpPopUp.Window,HelpPopUp.Window\h/2-100,HelpPopUp.Window\h-40,200,"Back to work...",1,"") GUI_OPENWIN(HelpPopUp.Window) GUI_HIDEWIN(HelpPopUp.Window) Quit.gadget=GUI_BUTTUN.gadget(Main.Window,18,72,70,"Quit",1,"") AreYouSure.Window=GUI_WINDOW.window(GraphicsWidth()/2-200,GraphicsHeight()/2-50,400,100,"QUITTING... ARE YOU SURE?",1,0,1,0,0) AreYouSureText.gadget=GUI_TEXT.gadget(AreYouSure.Window,AreYouSure.Window\w-290,AreYouSure.Window\h/2-20,200,10,"Do you really want to quit?","") yes.gadget=GUI_BUTTUN.gadget(AreYouSure.Window,50,AreYouSure.Window\h/2+20,100,"Yes...",1,"Have a nice day...") no.gadget=GUI_BUTTUN.gadget(AreYouSure.Window,AreYouSure.Window\w-150,AreYouSure.Window\h/2+20,100,"NO!",1,"I hit the wrong button...") GUI_OPENWIN(AreYouSure.Window) GUI_HIDEWIN(AreYouSure.Window) ;CREATE **3D CONTROLS WINDOW** LandscapeControls.Window=GUI_WINDOW.window(675,118,80,100,"3D VIEW",1,0,1,0,0) Preview3D.gadget=GUI_BUTTUN.gadget(LandscapeControls.Window,12,32,70,"3D Preview",1,"") GUI_GADACTIVE(Preview3D.gadget,0) GUI_OPENWIN(Blending.Window) GUI_OPENWIN(HeightmapLoad.Window) GUI_OPENWIN(Colourmap.Window) GUI_OPENWIN(TextureSet.Window) GUI_OPENWIN(Main.Window) GUI_OPENWIN(LandscapeControls.Window) GUI_QMENU_ON=1 Dim mymaps(4) mymaps(0)=LoadImage(SnowInputFile\txtinput\txt$) mymaps(1)=LoadImage(StoneInputFile\txtinput\txt$) mymaps(2)=LoadImage(GrassInputFile\txtinput\txt$) mymaps(3)=LoadImage(SandInputFile\txtinput\txt$) snowlev=SnowStartSlider\slider\val snowblend=SnowRangeSlider\slider\val stonelev=StoneStartSlider\slider\val stoneblend=StoneRangeSlider\slider\val grasslev=GrassStartSlider\slider\val grassblend=GrassRangeSlider\slider\val sandblend=SandRangeSlider\slider\val While ExitProgram=False ClsColor 54,71,110 Select True Case GUI_GADHIT.gadget=SnowLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a texture To load (snow)",".bmp#.jpg#.png#","TextureSets\Default") ChangeDir StartDir$ GUI_SETTEXT(SnowInputFile.gadget,FILE$) GUI_SETTEXT(SnowTexture.gadget,FILE$) mymaps(0)=LoadImage(SnowInputFile\txtinput\txt$) If mymaps(0)="0" Or mymaps(0)="NONE" GUI_WINACTIVE(Colourmap.window,0) : GUI_GADACTIVE(ColourmapPreview.gadget,0) : GUI_GADACTIVE(ColourmapRenderFile.gadget,0) ChangeDir startdir$ GUI_SETTEXT(SnowTexture.gadget,"InvalidFilename.bmp") Else GUI_WINACTIVE(Colourmap.window,1) : GUI_GADACTIVE(ColourmapPreview.gadget,1) : GUI_GADACTIVE(ColourmapRenderFile.gadget,1) EndIf Case GUI_GADHIT.gadget=StoneLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a texture to load (stone)",".bmp#.jpg#.png##","TextureSets\Default") ChangeDir StartDir$ GUI_SETTEXT(StoneInputFile.gadget,FILE$) GUI_SETTEXT(StoneTexture.gadget,FILE$) mymaps(1)=LoadImage(StoneInputFile\txtinput\txt$) If mymaps(1)="0" Or mymaps(1)="NONE" GUI_WINACTIVE(Colourmap.window,0) : GUI_GADACTIVE(ColourmapPreview.gadget,0) : GUI_GADACTIVE(ColourmapRenderFile.gadget,0) ChangeDir startdir$ GUI_SETTEXT(StoneTexture.gadget,"InvalidFilename.bmp") Else GUI_WINACTIVE(Colourmap.window,1) : GUI_GADACTIVE(ColourmapPreview.gadget,1) : GUI_GADACTIVE(ColourmapRenderFile.gadget,1) EndIf Case GUI_GADHIT.gadget=GrassLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a texture to load (grass)",".bmp#.jpg#.png##","TextureSets\Default") ChangeDir StartDir$ GUI_SETTEXT(GrassInputFile.gadget,FILE$) GUI_SETTEXT(GrassTexture.gadget,FILE$) mymaps(2)=LoadImage(GrassInputFile\txtinput\txt$) If mymaps(2)="0" Or mymaps(2)="NONE" GUI_WINACTIVE(Colourmap.window,0) : GUI_GADACTIVE(ColourmapPreview.gadget,0) : GUI_GADACTIVE(ColourmapRenderFile.gadget,0) ChangeDir startdir$ GUI_SETTEXT(GrassTexture.gadget,"InvalidFilename.bmp") Else GUI_WINACTIVE(Colourmap.window,1) : GUI_GADACTIVE(ColourmapPreview.gadget,1) : GUI_GADACTIVE(ColourmapRenderFile.gadget,1) EndIf Case GUI_GADHIT.gadget=SandLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a texture to load (sand)",".bmp#.jpg#.png##","TextureSets\Default") ChangeDir StartDir$ GUI_SETTEXT(SandInputFile.gadget,FILE$) GUI_SETTEXT(SandTexture.gadget,FILE$) mymaps(3)=LoadImage(SandInputFile\txtinput\txt$) If mymaps(3)="0" Or mymaps(3)="NONE" GUI_WINACTIVE(Colourmap.window,0) : GUI_GADACTIVE(ColourmapPreview.gadget,0) : GUI_GADACTIVE(ColourmapRenderFile.gadget,0) ChangeDir startdir$ GUI_SETTEXT(SandTexture.gadget,"InvalidFilename.bmp") Else GUI_WINACTIVE(Colourmap.window,1) : GUI_GADACTIVE(ColourmapPreview.gadget,1) : GUI_GADACTIVE(ColourmapRenderFile.gadget,1) EndIf Case GUI_GADHIT.gadget=HeightmapLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a heightmap to load",".bmp#.jpg#.png#.all#","Heightmaps\") ChangeDir StartDir$ GUI_SETTEXT(HeightmapTexture.gadget,FILE$) If LoadImage(FILE$)="0" Or LoadImage(FILE$)="NONE" GUI_WINACTIVE(Colourmap.window,0) : GUI_GADACTIVE(ColourmapPreview.gadget,0) : GUI_GADACTIVE(ColourmapRenderFile.gadget,0) ChangeDir startdir$ GUI_SETTEXT(HeightmapTexture.gadget,"InvalidFilename.bmp") Else GUI_WINACTIVE(Colourmap.window,1) : GUI_GADACTIVE(ColourmapPreview.gadget,1) : GUI_GADACTIVE(ColourmapRenderFile.gadget,1) EndIf Case GUI_GADHIT.gadget=ColourmapRenderFile.gadget FILE$=GUI_FILEREQUEST("Select a destination for the colourmap",".bmp#","Colourmaps\") ChangeDir StartDir$ If Right(FILE$,1)="\" Then FILE$=FILE$+"DefaultColourMap.bmp" If Right$(FILE$,4)<>".bmp" Then FILE$=FILE$+".bmp" ProcessColourmap(HeightMapTexture\IMAGEBOX\FILE$,FILE$) GUI_SETTEXT(ColourmapTexture.gadget,FILE$) GUI_GADACTIVE(Preview3D.gadget,1) Case GUI_GADHIT.gadget=ColourmapLoadFile.gadget FILE$=GUI_FILEREQUEST("Please Select a colourmap to load",".bmp#.jpg#.png#.all#","Colourmaps\") ChangeDir StartDir$ GUI_SETTEXT(ColourmapTexture.gadget,FILE$) If LoadImage(FILE$)="0" Or LoadImage(FILE$)="NONE" GUI_GADACTIVE(Preview3D.gadget,0) ChangeDir startdir$ GUI_SETTEXT(ColourmapTexture.gadget,"InvalidFilename.bmp") Else GUI_GADACTIVE(Preview3D.gadget,1) EndIf Case GUI_GADHIT.gadget=ColourmapPreview.gadget ProcessColourmap(HeightMapTexture\IMAGEBOX\FILE$,"",True) ChangeDir StartDir$ GUI_SETTEXT(ColourmapTexture.gadget,"preview.bm_") GUI_GADACTIVE(Preview3D.gadget,1) Case GUI_GADHIT.gadget=TextureSetNewFile.gadget Or GUI_GADHIT.gadget=TextureSetLoadFile.gadget If GUI_GADHIT.gadget=TextureSetLoadFile.gadget Then FILE$=GUI_FILEREQUEST("Please Select a Texture Set to load",".set#","TextureSets\") ChangeDir StartDir$ If GUI_GADHIT.gadget=TextureSetNewFile.gadget Or FileType(FILE$)<>1 Then FILE$="TextureSets\Default.set" ChangeDir StartDir$ FIL=ReadFile(FILE$) CurrentLine$=ReadLine$(FIL) GUI_SETTEXT(SnowInputFile.gadget,CurrentLine$) GUI_SETTEXT(SnowTexture.gadget,CurrentLine$) CurrentLine$=ReadLine$(FIL) GUI_SETTEXT(StoneInputFile.gadget,CurrentLine$) GUI_SETTEXT(StoneTexture.gadget,CurrentLine$) CurrentLine$=ReadLine$(FIL) GUI_SETTEXT(GrassInputFile.gadget,CurrentLine$) GUI_SETTEXT(GrassTexture.gadget,CurrentLine$) CurrentLine$=ReadLine$(FIL) GUI_SETTEXT(SandInputFile.gadget,CurrentLine$) GUI_SETTEXT(SandTexture.gadget,CurrentLine$) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(SnowStartSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(SnowRangeSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(StoneStartSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(StoneRangeSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(GrassRangeSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(GrassStartSlider.gadget,CurrentLineInt) CurrentLineInt=ReadByte(FIL) GUI_SETVAL(SandRangeSlider.gadget,CurrentLineInt) CloseFile FIL mymaps(0)=LoadImage(SnowInputFile\txtinput\txt$) mymaps(1)=LoadImage(StoneInputFile\txtinput\txt$) mymaps(2)=LoadImage(GrassInputFile\txtinput\txt$) mymaps(3)=LoadImage(SandInputFile\txtinput\txt$) snowlev=SnowStartSlider\slider\val snowblend=SnowRangeSlider\slider\val stonelev=StoneStartSlider\slider\val stoneblend=StoneRangeSlider\slider\val grasslev=GrassStartSlider\slider\val grassblend=GrassRangeSlider\slider\val sandblend=SandRangeSlider\slider\val GUI_SETTEXT(TextureSetInputFile.gadget,FILE$) Case GUI_GADHIT.gadget=TextureSetSaveFile.gadget Or GUI_GADHIT.gadget=TextureSetSaveAsFile.gadget If GUI_GADHIT.gadget=TextureSetSaveAsFile.gadget FILE$=GUI_FILEREQUEST("Please Select a destination for the Texture",".set#","TextureSets\") Else FILE$=TextureSetInputFile\txtinput\txt$ EndIf ; If GUI_GADHIT.gadget=TextureSetSaveFile.gadget Then FILE$=TextureSetInputFile\txtinput\txt$ ChangeDir StartDir$ If Right(FILE$,1)="\" Or Right(FILE$,1)="" Then FILE$=FILE$+"noname" If Right$(FILE$,4)<>".set" Then FILE$=FILE$+".set" PresetFile=WriteFile(FILE$) WriteLine(PresetFile,SnowInputFile\txtinput\txt$) WriteLine(PresetFile,StoneInputFile\txtinput\txt$) WriteLine(PresetFile,GrassInputFile\txtinput\txt$) WriteLine(PresetFile,SandInputFile\txtinput\txt$) WriteByte(PresetFile,snowlev) WriteByte(PresetFile,snowblend) WriteByte(PresetFile,stonelev) WriteByte(PresetFile,stoneblend) WriteByte(PresetFile,grasslev) WriteByte(PresetFile,grassblend) WriteByte(PresetFile,sandblend) CloseFile PresetFile GUI_SETTEXT(TextureSetInputFile.gadget,FILE$) Case GUI_GADHIT.gadget=Credits.gadget GUI_SHOWWIN(About.Window) GUI_WINFRONT(About.Window) Back=False Repeat If GUI_GADHIT.gadget=Backtowork.gadget GUI_HIDEWIN(About.Window) FlushMouse() back=True EndIf GUI() Flip Until back=True Case GUI_GADHIT.gadget=Help.gadget GUI_SHOWWIN(HelpPopUp.Window) GUI_WINFRONT(HelpPopUp.Window) Back=False Repeat If GUI_GADHIT.gadget=Backtowork2.gadget GUI_HIDEWIN(HelpPopUp.Window) FlushMouse() back=True EndIf GUI() Flip Until back=True Case GUI_GADHIT.gadget=quit.gadget Or KeyDown(1) GUI_SHOWWIN(AreYouSure.Window) GUI_WINFRONT(AreYouSure.Window) Back=False Repeat Select True Case GUI_GADHIT.gadget=yes.gadget ExitProgram=True Case GUI_GADHIT.gadget=no.gadget GUI_HIDEWIN(AreYouSure.Window) FlushMouse() back=True End Select GUI() Flip Until ExitProgram=True Or back=True Case GUI_GADHIT.gadget=Preview3D.gadget GUI_HIDEWIN(Blending.Window) GUI_HIDEWIN(HeightmapLoad.Window) GUI_HIDEWIN(Colourmap.Window) GUI_HIDEWIN(TextureSet.Window) GUI_HIDEWIN(Main.Window) GUI_HIDEWIN(LandscapeControls.Window) ;-----------3D PREVIEW CODE------------ ;Ambient Light AmbientLight 255,255,255 ;Load Terrain terrain=LoadTerrain(HeightMapTexture\IMAGEBOX\FILE$) ChangeDir StartDir$ CMap=LoadTexture(ColourMapTexture\IMAGEBOX\FILE$) ScaleTexture CMap,TerrainSize(terrain),TerrainSize(terrain) EntityTexture terrain,CMap ScaleEntity terrain,2,400,2 TerrainDetail terrain,3000,True TerrainShading terrain,True PositionEntity terrain,-TerrainSize(terrain),0,-TerrainSize(terrain) TerrainPitch=CreatePivot() TerrainYaw=CreatePivot(TerrainPitch) PositionEntity TerrainPitch,0,0,0 EntityParent terrain,TerrainYaw RotateEntity terrainPitch,-10,0,0 ;Init Camera Camera=CreateCamera() SetBuffer FrontBuffer() PositionEntity camera,0,0,-2000 TurnEntity camera,0,0,0 CameraRange camera,0.01,10000 CameraFogMode camera,1 CameraFogRange camera,200,8000 CameraFogColor camera,240,230,200 CameraClsColor camera,54,71,110 CameraViewport camera,0,0,GraphicsWidth(),GraphicsHeight() Zoom#=1 QuitPreview.Window=GUI_WINDOW.window(GraphicsWidth()/2-310,20,620,40,"3D PREVIEW... ( press [ESC] to return )",1,0,0,0,0) If Right(ColourMapTexture\IMAGEBOX\FILE$,11)<>"preview.bm_" QuitPreviewText.gadget=GUI_TEXT.gadget(QuitPreview.Window,150,20,580,"","3D LANDSCAPE PREVIEW - FULL DETAIL","") Else QuitPreviewText.gadget=GUI_TEXT.gadget(QuitPreview.Window,20,20,580,"","3D PREVIEW - LOW DETAIL TEXTURE (SELECT 'RENDER TO FILE...' FOR HIGH DETAIL)","") EndIf GUI_OPENWIN(QuitPreview.Window) PreviewControls.Window=GUI_WINDOW.window(GraphicsWidth()-340,GraphicsHeight()-120,330,110,"3D PREVIEW CONTROLS",1,0,1,0,0) PreviewFrame.gadget=GUI_FRAME.gadget(PreviewControls.Window,10,20,280,75,"TERRAIN HEIGHT AND DETAIL LEVEL",0,"") PreviewDetailText.gadget=GUI_TEXT.gadget(PreviewControls.Window,20,35,200,10,"Terrain Detail level:","") PreviewDetailSlider.gadget=GUI_SLIDER.gadget(PreviewControls.Window,20,50,180,2000,1,10000,1,1,"pull slider") PreviewDetailValue.gadget=GUI_TXTINPUT.gadget(PreviewControls.Window,230,47,53,PreviewDetailSlider\slider\val,"",0,0,"") PreviewHeightText.gadget=GUI_TEXT.gadget(PreviewControls.Window,20,65,200,10,"Terrain Height:","") PreviewHeightSlider.gadget=GUI_SLIDER.gadget(PreviewControls.Window,20,80,180,400,1,1000,1,1,"pull slider") PreviewHeightValue.gadget=GUI_TXTINPUT.gadget(PreviewControls.Window,230,77,53,PreviewHeightSlider\slider\val,"",0,0,"") PreviewZoomText.gadget=GUI_TEXT.gadget(PreviewControls.Window,295,37,20,90,"Z O O M","") PreviewZoomSlider.gadget=GUI_SLIDER.gadget(PreviewControls.Window,310,26,52,2000,0,8000,0,1,"pull slider") GUI_OPENWIN(PreviewControls.Window) While KeyDown(1)=False If MouseDown(2) If LookStart=False If MouseHit(2)=1 Then oldxmouse=MouseX() : oldymouse=MouseY() MoveMouse GraphicsWidth()/2,GraphicsHeight()/2 HidePointer() Lookstart=True GUI_MOUSE_ON=0 EndIf ; Mouse x and y speed mxs=MouseXSpeed()/4 mys=MouseYSpeed()/4 ; Destination camera angle x and y values dest_cam_pitch#=limit(dest_cam_pitch#+mys,-90,-10) dest_cam_yaw#=dest_cam_yaw#-mxs ; Current camera angle x and y values cam_yaw#=cam_yaw+(dest_cam_yaw-cam_yaw)/2 cam_pitch#=cam_pitch+(dest_cam_pitch-cam_pitch)/2 RotateEntity terrainPitch,cam_pitch#,0,0 RotateEntity terrainYaw,0,cam_yaw#,0 MoveMouse GraphicsWidth()/2,GraphicsHeight()/2 MovePointer=True Else If LookStart=True And MouseDown(2)=False Lookstart=False MoveMouse oldxmouse,oldymouse ShowPointer() If Not Windowed Then GUI_MOUSE_ON=1 EndIf MovePointer=False FlushMouse() EndIf PositionEntity camera,EntityX(camera),EntityY(camera),-PreviewZoomSlider\slider\val GUI_SETVAL(PreviewZoomSlider.gadget,PreviewZoomSlider\slider\val-MouseZSpeed()*100) RenderWorld tween If MouseDown(1) And (GUI_GADHIT.gadget=PreviewDetailSlider.gadget Or GUI_GADHIT.gadget=PreviewHeightSlider.gadget) GUI_SETTEXT(PreviewDetailValue.gadget,PreviewDetailSlider\slider\val) TerrainDetail terrain,PreviewDetailSlider\slider\val,True GUI_SETTEXT(PreviewHeightValue.gadget,PreviewHeightSlider\slider\val) ScaleEntity terrain,2,PreviewHeightSlider\slider\val,2 EndIf GUI() If MovePointer Then Text GraphicsWidth()/2,GraphicsHeight()/2,"+" Flip Wend ;--------END OF 3D PREVIEW CODE-------- FreeEntity Terrain FreeEntity Camera FreeEntity TerrainPitch GUI_FREEWIN(QuitPreview.Window) GUI_FREEWIN(PreviewControls.Window) GUI_OPENWIN(Blending.Window) GUI_OPENWIN(HeightmapLoad.Window) GUI_OPENWIN(Colourmap.Window) GUI_OPENWIN(TextureSet.Window) GUI_OPENWIN(Main.Window) GUI_OPENWIN(LandscapeControls.Window) FlushKeys() FlushMouse() End Select If GUI_WINHOVER.WINDOW<>Null If MouseDown(1) Then GUI_WINFRONT(GUI_WINHOVER.WINDOW) EndIf snowlev=SnowStartSlider\slider\val snowblend=SnowRangeSlider\slider\val stonelev=StoneStartSlider\slider\val stoneblend=StoneRangeSlider\slider\val grasslev=GrassStartSlider\slider\val grassblend=GrassRangeSlider\slider\val sandblend=SandRangeSlider\slider\val If MouseDown(1) And (GUI_GADHIT.gadget=SnowStartSlider.gadget Or GUI_GADHIT.gadget=SnowRangeSlider.gadget Or GUI_GADHIT.gadget=StoneStartSlider.gadget Or GUI_GADHIT.gadget=StoneRangeSlider.gadget Or GUI_GADHIT.gadget=GrassStartSlider.gadget Or GUI_GADHIT.gadget=GrassRangeSlider.gadget Or GUI_GADHIT.gadget=SandRangeSlider.gadget) GUI_SETTEXT(SnowStartValue.gadget,SnowStartSlider\slider\val) GUI_SETTEXT(SnowRangeValue.gadget,SnowRangeSlider\slider\val) GUI_SETTEXT(StoneStartValue.gadget,StoneStartSlider\slider\val) GUI_SETTEXT(StoneRangeValue.gadget,StoneRangeSlider\slider\val) GUI_SETTEXT(GrassStartValue.gadget,GrassStartSlider\slider\val) GUI_SETTEXT(GrassRangeValue.gadget,GrassRangeSlider\slider\val) GUI_SETTEXT(SandRangeValue.gadget,SandRangeSlider\slider\val) EndIf GUI() FlushMouse() Flip Wend Function ProcessColourmap(Heightmapfile$,Colourmap$,Preview=False) Render.Window=GUI_WINDOW.window(GraphicsWidth()/2-300,GraphicsHeight()/2-20,600,40,"RENDERING IN PROGRESS... ( [ESC] To abort )",1,0,0,0,0) RenderText.gadget=GUI_TEXT.gadget(Render.Window,190,20,560,"","Completed: ","") RenderPercentage.gadget=GUI_PROG(Render.Window,270,20,0,100,"") GUI_OPENWIN(Render.Window) snow=0 : stone=1 : grass=2 : sand=3 oldpercent#=0.0 : newpercent#=0.0 ChangeDir StartDir$ heightmap=LoadImage(Heightmapfile$) If Preview=True Then ScaleImage heightmap,.20,.20 resultmap=CreateImage(ImageWidth(heightmap),ImageHeight(heightmap)) heightwidth#=ImageWidth(heightmap) For x=0 To (ImageWidth(heightmap)-1) For y=0 To (ImageHeight(heightmap)-1) SetBuffer ImageBuffer(heightmap) LockBuffer ImageBuffer(heightmap) GetColor(x,y) height#=ColorGreen() ; Pick out one colour channel. I use green ; because the generator I use seems to vary ; green more than the others. UnlockBuffer ImageBuffer(heightmap) newtexnumber=-2 If height# >= snowlev Then texnumber=snow If height#<=snowlev+snowblend newtexnumber=stone fade#=(height#-Float snowlev)/snowblend EndIf ElseIf height# >= stonelev texnumber=stone If height#<=stonelev+stoneblend newtexnumber=grass fade#=(height#-Float stonelev)/Float stoneblend EndIf ElseIf height# >= grasslev texnumber=grass If height#<=grasslev+grassblend newtexnumber=sand fade#=(height#-Float grasslev)/Float grassblend EndIf Else texnumber=sand If height#<=sandblend newtexnumber=-1 fade#=height#/Float sandblend EndIf EndIf SetBuffer ImageBuffer(mymaps(texnumber)) GetColor x Mod ImageWidth(mymaps(texnumber)),y Mod ImageHeight(mymaps(texnumber)) oldred#=ColorRed() oldgreen#=ColorGreen() oldblue#=ColorBlue() If newtexnumber>-1 SetBuffer ImageBuffer(mymaps(newtexnumber)) GetColor x Mod ImageWidth(mymaps(newtexnumber)),y Mod ImageHeight(mymaps(newtexnumber)) newred#=ColorRed() newgreen#=ColorGreen() newblue#=ColorBlue() oldred#=(oldred#*fade#)+(newred#*(1-fade#)) oldgreen#=(oldgreen#*fade#)+(newgreen#*(1-fade#)) oldblue#=(oldblue#*fade#)+(newblue#*(1-fade#)) Else If newtexnumber=-1 ; If fade#<0.5 Then fade#=0.5 oldred#=oldred#*fade# oldgreen#=oldgreen#*fade# If fade#<0.5 Then fade#=0.5 oldblue#=oldblue#*fade# EndIf SetBuffer ImageBuffer(resultmap) Color oldred#,oldgreen#,oldblue# Plot x,y Next SetBuffer FrontBuffer() complete#= Float x / heightwidth * 100 GUI_SETVAL(RenderPercentage.gadget,Int complete#) SetBuffer BackBuffer() GUI() Flip SetBuffer FrontBuffer() RenderWorld If KeyDown(1) Exit EndIf Next GUI_FREEWIN(Render.Window) If Preview=True SaveBuffer(ImageBuffer(resultmap),"preview.bm_") Else SaveBuffer(ImageBuffer(resultmap),Colourmap$) EndIf End Function Function limit#(number#,min#,max#) If number#<min# Then number#=min# If number#>max# Then number#=max# Return number# End Function End |
Comments
None.
Code Archives Forum