Code archives/3D Graphics - Misc/Heightland

This code has been declared by its author to be Public Domain code.

Download source code

Heightland by Doiron2002
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