Code archives/3D Graphics - Mesh/minib3d - converted terrain functions

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

Download source code

minib3d - converted terrain functions by Warner
(Posted 19 years ago)
I'm not exactly sure what it does, because the desciption was
in Russian, but it uses something called roam to optimize
terrain generation from an heightmap.
You'll need to supply a (!) 512x512 (!) file called 'heightmap.bmp'.
For other image sizes, change MinimumTileSize.
And you'll need minib3d installed. 
'terrain

	Import sidesign.minib3d
	
	Graphics3D 640,480,0,2
	
	Global RoamMaxHeightError#=3.0
	Global MinimumTileSize=64
	
	light=CreateLight()
		
	RoamTerrainMaxHeight#=40.96
	
	HmapImage:TPixmap=LoadPixmap("heightmap4.bmp")
	Global RoamTerrainWidth=PixmapWidth(HmapImage)-1
	Global RoamTerrainHeight#[RoamTerrainWidth+1+1,RoamTerrainWidth+1+1]
	
	For PixX=0 To RoamTerrainWidth
	For PixY=0 To RoamTerrainWidth
	        Pixel=ReadPixel(HmapImage,PixX,PixY)
	        RedColor=Pixel & $FF
	        RoamTerrainHeight#(PixX,PixY)=((RedColor/255.0))*RoamTerrainMaxHeight
	Next
	Next
	
	RoamMaxTriangles=RoamTerrainWidth*RoamTerrainWidth*2-1
	
	Global RoamBaseNeighbor%[RoamMaxTriangles*10+1]
	Global RoamBaseNeighborFlag%[RoamMaxTriangles*10+1]


'---
Function FindTriBaseNeighbor(Number)
	If RoamBaseNeighbor(number)>0 
		Return 
	EndIf
	If Number<4
        Select Number
                Case 1
                        RoamBaseNeighbor(Number)=1
                        RoamBaseNeighborFlag(Number)=1 '????? ? ?????? ?????????
                Case 2
                        RoamBaseNeighbor(Number)=0      '??? ??????
                        RoamBaseNeighborFlag(Number)=0
                Case 3
                        RoamBaseNeighbor(Number)=0      '??? ??????
                        RoamBaseNeighborFlag(Number)=0
        End Select
Return
EndIf

Parent=Number Shr 1
ParentLeftChild=(Parent Shl 1)
ParentRightChild=(Parent Shl 1)+1

PraParent=Parent Shr 1
PraParentLeftChild=(PraParent Shl 1)
PraParentRightChild=(PraParent Shl 1)+1

If Number=ParentLeftChild And Parent=PraParentLeftChild
        '??????? ??????? ??????? ??????? ???????  ???????????,
        PraParentRightChildRightChild=(PraParentRightChild Shl 1)+1
        '??????? ???????? ??????? ????????? ???????? ????????????
        RoamBaseNeighbor(Number)=PraParentRightChildRightChild
        RoamBaseNeighborFlag(Number)=0
        '??????? ?????????? ???????? ????? ??????? ?????????
        '??????? ??????? ??????? ??????? ???????????
        RoamBaseNeighbor(PraParentRightChildRightChild)=Number
        RoamBaseNeighborFlag(PraParentRightChildRightChild)=0
Return
EndIf

'??? ?? ?????? No3 , ?? ? ???????? ???????
If Number=ParentRightChild And Parent=PraParentRightChild
        '??????? ?????? ??????? ?????? ???????  ???????????,
        PraParentLeftChildLeftChild=(PraParentLeftChild Shl 1)
        '??????? ???????? ??????? ????????? ???????? ????????????
        RoamBaseNeighbor(Number)=PraParentLeftChildLeftChild
        RoamBaseNeighborFlag(Number)=0
        '??????? ?????????? ???????? ????? ??????? ?????????
        '?????? ??????? ?????? ??????? ???????????
        RoamBaseNeighbor(PraParentLeftChildLeftChild)=Number
        RoamBaseNeighborFlag(PraParentLeftChildLeftChild)=0
Return
EndIf

'?????? ????????? ???? ?? ? ??????????? ????? ?????????

PraParentBaseNeighbor=RoamBaseNeighbor(PraParent)
PraParentBaseNeighborFlag=RoamBaseNeighborFlag(PraParent)

'???? ???, ?? ? ? ???????? ???? ?? ?????
If PraParentBaseNeighbor=0
        RoamBaseNeighbor(Number)=0
        RoamBaseNeighborFlag(Number)=0
        Return
EndIf

'???????? ?????? No4
'???? ??????? ??????????? ????? ???????, ? ???????? - ?????
If Number=ParentRightChild And Parent=PraParentLeftChild
        '??????? ????? ????? ??????? ??????? ??????? ?????? ????????? ???????????
    PraParentBaseNeighborRightChild=(PraParentBaseNeighbor Shl 1)+1
    PraParentBaseNeighborRightChildLeftChild=(PraParentBaseNeighborRightChild Shl 1)
        '??????? ? ?????? ? ???????? ???? ?? ????? ???????????
    RoamBaseNeighbor(Number)=PraParentBaseNeighborRightChildLeftChild
    RoamBaseNeighborFlag(Number)=PraParentBaseNeighborFlag
        ' ? ????????
    RoamBaseNeighbor(PraParentBaseNeighborRightChildLeftChild)=Number
    RoamBaseNeighborFlag(PraParentBaseNeighborRightChildLeftChild)=PraParentBaseNeighborFlag
    Return
EndIf

'?????? ???????? ????????? ?????? No4 ????????
'????? ??????? ??????????? ????? ???????, ? ???????? - ??????
If Number=ParentLeftChild And Parent=PraParentRightChild
        '??????? ????? ????? ??????? ??????? ??????? ?????? ????????? ???????????
    PraParentBaseNeighborLeftChild=(PraParentBaseNeighbor Shl 1)
    PraParentBaseNeighborLeftChildRightChild=(PraParentBaseNeighborLeftChild Shl 1)+1
        '??????? ? ?????? ? ???????? ???? ?? ????? ???????????
    RoamBaseNeighbor(Number)=PraParentBaseNeighborLeftChildRightChild
    RoamBaseNeighborFlag(Number)=PraParentBaseNeighborFlag
        ' ? ????????
    RoamBaseNeighbor(PraParentBaseNeighborLeftChildRightChild)=Number
    RoamBaseNeighborFlag(PraParentBaseNeighborLeftChildRightChild)=PraParentBaseNeighborFlag
EndIf

End Function

'??????????????? ??????? ???? ????????????? ? ????? ?? ??????? ?????????
For CurrentNumber=1 To RoamMaxTriangles
  FindTriBaseNeighbor(CurrentNumber)
Next

'??? ??????????? ????? ????? ????? ?? ????? ????????

Global RoamCriticalTriLevel=RoamTerrainWidth*RoamTerrainWidth-1
'??????? ????? ?????? ??? ???????? ?????????? ?????? ?????????????
Global RoamTriangle[1+1]
RoamTriangle(0)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2) '????? 0 - ?????? ??????? ???????????
RoamTriangle(1)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2) '????? 1 - ????? ?????? ???????????
'??????????? ???????????
Global MinTileSizeLevel=2^(RoamTerrainWidth/MinimumTileSize)

' ???????, ???????????? ????? ?? ???? ??????????? ??? ???

Function RoamBreakTriangle(x0,z0,x1,z1,x2,z2,Number,Branch)

'???? ??????????? ?????? ? ????? ???????? ????????????????
If Number>RoamCriticalTriLevel
        '???????? ??? ?? ????? ? ???????
        PokeByte(RoamTriangle(Branch),Number,0)
        Return
EndIf

'???? ??????????? ?????? ? ????? ????????????? ?????????? ???????????
If Number<MinTileSizeLevel
        '??????? ?????????? ??????????? ?????
        xC=(x0+x2)/2
        zC=(z0+z2)/2
        '??????? ????????
        LeftChild=(Number Shl 1)
        RightChild=(Number Shl 1)+1
        '???????? ??????????? ??? ????????
        PokeByte(RoamTriangle(Branch),Number,1)
        '???????? ??????? ?????????? ??? ????????
        RoamBreakTriangle(x1,z1,xC,zC,x0,z0,LeftChild,Branch)
        RoamBreakTriangle(x2,z2,xC,zC,x1,z1,RightChild,Branch)
        '???????, ????? ?? ?????? ?????? ?????????
        Return
EndIf

'???? ??????????? ??? ??????? ??? ??????? (? ???????? ForceSplit)
'?? ???? ????????? ??? ????????
 If PeekByte(RoamTriangle(Branch),Number)=1
        xC=(x0+x2)/2
        zC=(z0+z2)/2
        LeftChild=(Number Shl 1)
        RightChild=(Number Shl 1)+1
        RoamBreakTriangle(x1,z1,xC,zC,x0,z0,LeftChild,Branch)
        RoamBreakTriangle(x2,z2,xC,zC,x1,z1,RightChild,Branch)
        Return
EndIf

'????? ?????????? ???????? ???????? ???? ??????????? ????????? ???
'?? ????????? ??????????? - ??? ???????? ??????????? ??????
xC=(x0+x2)/2
zC=(z0+z2)/2
'??????????? ??????
DeltaHeight#=Abs(RoamTerrainHeight(xC,zC)-(RoamTerrainHeight(x0,z0)+RoamTerrainHeight(x2,z2))*0.5)
'???? ??? ?????? ???????????? ?????? ?? ?????????
If DeltaHeight>=RoamMaxHeightError
        ' - " -"
        xC=(x0+x2)/2
        zC=(z0+z2)/2
        LeftChild=(Number Shl 1)
        RightChild=(Number Shl 1)+1
        PokeByte(RoamTriangle(Branch),Number,1)
        RoamBreakTriangle(x1,z1,xC,zC,x0,z0,LeftChild,Branch)
        RoamBreakTriangle(x2,z2,xC,zC,x1,z1,RightChild,Branch)
        ' ???? ? ???????????? ???? ????? ????????? ?? ?????????
        ' ??? ??????????? ???????? (?? ????)
        If RoamBaseNeighbor(Number)>0
                '???????? ???????? ??? ????????????? ????? ????????? ????? ????? Xor
                RoamForceSplitTri(RoamBaseNeighbor(Number),Branch ~ RoamBaseNeighborFlag(Number))
        EndIf

EndIf
End Function
'???????, ??????????? ?????? ????????? ????????????
Function RoamForceSplitTri(Number,Branch)
'???? ??????????? ??? ?????? ?? ???????
If PeekByte(RoamTriangle(Branch),Number)=1
        Return
EndIf
'???????? ??? ????????
PokeByte(RoamTriangle(Branch),Number,1)
'??????? ??????? ??? ?????? ?????????
If RoamBaseNeighbor(Number)>0
        RoamForceSplitTri(RoamBaseNeighbor(Number),Branch ~ RoamBaseNeighborFlag(Number))
EndIf
'? ????????? ? ????????
Parent=Number Shr 1
RoamForceSplitTri(Parent,Branch)
End Function

'??????? ???

Global Terrain=CreateMesh()
'???????? ??? ? ????? ????
PositionEntity Terrain,-0.5*RoamTerrainWidth,0,-0.5*RoamTerrainWidth
'????? ???????? ? ?????????
tex=LoadTexture("sand.jpg")
ScaleTexture tex,14,14
'EntityTexture Terrain,tex
'??????? ??????? ? ?????? ?????????
Global RoamSurface=CreateSurface(Terrain)
Global RoamVertex[RoamTerrainWidth+1,RoamTerrainWidth+1]

'??????? ????????? ??????????? ?? ????? ??????
Function RoamCreateTriangle(x0,z0,x1,z1,x2,z2,Number,Branch)
'???? ??????????? ??????, ?? ???????? ? ??? ????????
 If PeekByte(RoamTriangle(Branch),Number)=1
        xC=(x0+x2)/2
        zC=(z0+z2)/2
        LeftChild=(Number Shl 1)
        RightChild=(Number Shl 1)+1
        RoamCreateTriangle(x1,z1,xC,zC,x0,z0,LeftChild,Branch)
        RoamCreateTriangle(x2,z2,xC,zC,x1,z1,RightChild,Branch)
        Return
Else
        '??? ??????? ??????????

        '????????? ?????? ?? ??????? 0
        If RoamVertex(x0,z0)=0
                RoamVertex(x0,z0)=AddVertex(RoamSurface,x0,RoamTerrainHeight(x0,z0),z0,x0,z0)
        EndIf

        '????????? ?????? ?? ??????? 1
        If RoamVertex(x1,z1)=0
                RoamVertex(x1,z1)=AddVertex(RoamSurface,x1,RoamTerrainHeight(x1,z1),z1,x1,z1)
        EndIf

        '????????? ?????? ?? ??????? 2
        If RoamVertex(x2,z2)=0
                RoamVertex(x2,z2)=AddVertex(RoamSurface,x2,RoamTerrainHeight(x2,z2),z2,x2,z2)
        EndIf

        '???????
        AddTriangle (RoamSurface,RoamVertex(x0,z0),RoamVertex(x1,z1),RoamVertex(x2,z2))
       
EndIf

End Function

Function CreateLand()


'??????? ????? ?????? ????? ?????? ?????????????
'FreeBank RoamTriangle(0)
'FreeBank RoamTriangle(1)
'? ??????? ?????? ??????
RoamTriangle(0)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2)
RoamTriangle(1)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2)
'??????????? ?????? ?????????
Global RoamVertex[RoamTerrainWidth+1,RoamTerrainWidth+1]
'??????? ??????? ? ??????? ??????? 0
ClearSurface RoamSurface,1,1
AddVertex RoamSurface,0,0,0
'????????? ????????????
RoamBreakTriangle(0,RoamTerrainWidth,RoamTerrainWidth,RoamTerrainWidth,RoamTerrainWidth,0,1,0)
RoamBreakTriangle(RoamTerrainWidth,0,0,0,0,RoamTerrainWidth,1,1)
'??????? ????????????
RoamCreateTriangle(0,RoamTerrainWidth,RoamTerrainWidth,RoamTerrainWidth,RoamTerrainWidth,0,1,0)
RoamCreateTriangle(RoamTerrainWidth,0,0,0,0,RoamTerrainWidth,1,1)
'????????? ???????
UpdateNormals(Terrain)
ScaleEntity Terrain, 10, 4, 10
PositionEntity Terrain, 0, 0, 0

End Function

	CreateLand()	

	ScaleMesh terrain, 1, 5, 1
	tex2 = LoadTexture("heightmap.bmp")
	ScaleTexture tex2, 512, 512
	EntityTexture terrain, tex2
	EntityType terrain, 2
	'CreateOctree(terrain, 200, 5)

	cam = CreateCamera()
	CameraRange cam, 1, 10000
	EntityType cam, 1
	EntityRadius cam, 2.0
	PositionEntity cam, 0, 150, 0
	
	'used by fps
	Local old_ms:Int = MilliSecs()
	Local renders:Int
	Local fps:Int
	
	'setup collisions
	Collisions 1, 2, 2
	
	Repeat
	
		Wireframe KeyDown(KEY_W)
		
		If KeyDown(KEY_LEFT) Then MoveEntity cam, -1, 0, 0
		If KeyDown(KEY_RIGHT) Then MoveEntity cam, +1, 0, 0
		If KeyDown(KEY_DOWN) Then MoveEntity cam, 0, 0, -1
		If KeyDown(KEY_UP) Then MoveEntity cam, 0, 0, +1
	
		If KeyDown(KEY_A) Then MoveEntity cam, 0, +1, 0
		If KeyDown(KEY_Z) Then MoveEntity cam, 0, -1, 0
		
		UpdateWorld	
		RenderWorld
	
		renders :+ 1
		If MilliSecs() -old_ms >= 1000
			old_ms = MilliSecs()
			fps = renders
			renders = 0
		EndIf
	
		Text 0, 20, "FPS: " + String(fps)
		
		Flip 0
		
	Until KeyHit(KEY_ESCAPE)
	
	End