Из загруженной картинки мы узнаем размеры создаваемой поверхности и затем будем выделять память согласно необходимости. Создадим также переменную RoamTerrainMaxHeight# для определния максимальной высоты в карту высот при её загрузке.

;Устанавливаем максимальную высоту
RoamTerrainMaxHeight#=40.96
;Грузим картинку
HmapImage=LoadImage("roam_hmap.jpg")
;Достаем из картинки раземр террайна
Global RoamTerrainWidth=ImageWidth(HmapImage)-1
;создаем массив с картой высот
Dim RoamTerrainHeight#(RoamTerrainWidth,RoamTerrainWidth)
;считываем массив из картинки
SetBuffer ImageBuffer(HmapImage)
LockBuffer ImageBuffer(HmapImage)
For PixX=0 To RoamTerrainWidth
For PixY=0 To RoamTerrainWidth
 Pixel=ReadPixelFast(PixX,PixY)
 RedColor=(Pixel Shr 16) And ($000000FF)
 GreenColor=(Pixel Shr 8) And ($000000FF)
 RoamTerrainHeight#(PixX,PixY)=(RedColor/255.0)*RoamTerrainMaxHeight-(GreenColor/255.0)*RoamTerrainMaxHeight
Next
Next
UnlockBuffer ImageBuffer(HmapImage)
SetBuffer BackBuffer()
;Удаляем картинку, она нам более не нужна
FreeImage HmapImage

Далее определение соседей основания. Сразу же объявим перменную RoamMaxTriangles, показывающую, сколько всего треугольников создается при текущем разрешении террайна. Создаем массивы, содержащие базового соседа и его флаг. Мы перечисляем все трегуольники и заносим данные сразу в массив прямо внутри функции

;маскимальное количество треугольников в террайне

RoamMaxTriangles=RoamTerrainWidth*RoamTerrainWidth*2-1
;массивы содержащие базового соседа и его флаг
Dim RoamBaseNeighbor%(RoamMaxTriangles)
Dim RoamBaseNeighborFlag%(RoamMaxTriangles)

Function FindTriBaseNeighbor(Number)
;если для данного треугольника уже задан сосед, то мы пропускаем
If RoamBaseNeighbor(number)>0 : Return : EndIf
;если это треугольник 1,2 или 3
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

;случай №3 в разделе "Мои добавления в метод " 
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

;тот же случай №3 , но в обратную сторону
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

;проверим случай №4
;если искомый треугольник првый потомок, а родитель - левый
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

;Теперь остается проверить случай №4 наоборот
;когда искомый треугольник левый потомок, а родитель - правый
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

Далее мы можем проверить правильность функции, напчечатав в дебаг данные и проверив их хотя бы по картинке №6.

;проверим несколько треугольников из дебага по картинке
For i=1 To 31
DebugLog "Tri# "+Str(i)+" Base neighbor: "+Str(RoamBaseNeighbor(i)) +" Flag: "+Str(RoamBaseNeighborFlag(i))
Next

Далее мы объявляем нужные нам переменные для бинарного дерева треугольников. RoamCriticalLevel - треугольники с номером больше этой цифры неделимые, то есть принадлежат к самому высокому уровню детализации. Банки памяти для бинарных деревьев треугольников я сохранил в элементах массива для удобства доступа к ним. Один банк для ветки 0, другой банк для ветки 1. MinTileSizeLevel подробнее был описан выше.

;Все трегольники после этого числа не будут делиться
Global RoamCriticalTriLevel=RoamTerrainWidth*RoamTerrainWidth-1
;создаем банки памяти для хранения бинароного дерева треугольников
Dim RoamTriangle(1)
RoamTriangle(0)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2) ;ветка 0 - правый верхний треугольник
RoamTriangle(1)=CreateBank(RoamTerrainWidth*RoamTerrainWidth*2) ;ветка 1 - левый нижний треугольник
;Минимальная детализация
Global MinTileSizeLevel=2^(RoamTerrainWidth/MinimumTileSize)

Далее идет функция, которая определяет, делить ли треугольник или нет, и функция помогающая делить соседа основания. Внутри все откомментировано. Вкратце функция сначала проверяет входит ли треугольник в число наиболее детализированных, затем входит ли треугольник в число обязательно разделяемых, затем определяется помечен ли треугольник как разбитый при ForceSplit, а потом проходит проверка погрешности высоты. ForceSplit сначала проверяет, разбит ли уже треугольник, затем помечает себя разбитым, разбивает соседа основания и переходит к родителю.

; Функция, определяющая стоит ли бить треугольник или нет

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

;если треугольник входит в число наиболее детализированных
If Number>RoamCriticalTriLevel
 ;помечаем как не битый и выходим
 PokeByte(RoamTriangle(Branch),Number,0)
 Return
EndIf

;Если треугольник входит в число треугольников наименьшей детализации
If Number=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 Xor 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 Xor RoamBaseNeighborFlag(Number))
EndIf
;и переходим к родителю
Parent=Number Shr 1
RoamForceSplitTri(Parent,Branch)

End Function

Мы написали функцию, описывающую процесс разбиения треугольников. После её работы у нас имеется сформированное дерево треугольников, согласно которому мы и будем строить меш. Теперь сделаем небольшое отступление. В дереве имеется только информация о том строить ли треугольник по данным вершинам или нет, а о создании вершин в алгоритме как то не говорится. Когда мы строим треугольник, то у нас есть данные только о координатах вершин создаваемого треугольника. Создать все вершины сразу и строить по ним трианглы не получится, поэтому вершины будут строиться динамически. Создадим массив RoamVertex(RoamTerrainWidth,RoamTerrainWidth) в котором будем хранить информацию о том, создана ли вершина или нет. Если вершина создана то значение ячейки будет больше нуля. Т.к. первый вертекс в сюрфейсе имеет номер 0, то перед каждым обновлением будет создавать ни с чем не связаный нулевой вертекс, дабы упросить записи в архиве. Таким образом при создании треугольника проверяем значение всех вертексов треугольника в массиве, и если вершина не создана, то создаем её. После чего создаем треугольник по уже точно существующим вершинам. Таким образом, функция пробегает рекурсивно по дереву и если треугольник создан, то создавая по необходимости вершины добавляет в сюрфейс треугольник.

;создаем меш

Global RoamMesh=CreateMesh()
;помещаем меш в центр мира
PositionEntity RoamMesh,-0.5*RoamTerrainWidth,0,-0.5*RoamTerrainWidth
;грзим текстуру и текстурим
tex=LoadTexture("sand.jpg")
ScaleTexture tex,4,4
EntityTexture RoamMesh,tex
;создаем сурфейс и массив вертексов
Global RoamSurface=CreateSurface(RoamMesh)
Dim RoamVertex(RoamTerrainWidth,RoamTerrainWidth)

;функция создающая треугольник па банку памяти
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)
;пересоздаем массив вертексов
Dim RoamVertex(RoamTerrainWidth,RoamTerrainWidth)
;очищаем сурфейс и создаем вертекс 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(RoamMesh)
End Function

Вот в общем то и все основные принципы алгоритма изложены. Полный работающий пример можно скачать тут http://blitz3d-portal.ucoz.net/load/28-1-0-47
5.Дальнейшие оптимизации
Следующим шагом в создании ландшафта будет добавление динамической детализации. В рассмотренном примере значение RoamMaxHeightError для всей поверхности одинаковое. Для нас необходимо сделать ландшафт наиболее детализированным вблизи камеры. Всякие попытки находить расстояние до камеры и менять значение RoamMaxHeightError согласно этому расстоянию к положительному расстоянию пока не привели. Расчет для каждой координаты расстояния до камеры через квадратный корень очень и очень затратно. Используя маски, тоже не удалось собрать простого и быстрого примера. Поэтому я предлагаю немного другой вариант. Можно создать массив содержащий номер треугольника по координатам и его принадлежность к какой либо из ветвей, например TriangleNumber(TerrainWidth,TerrainWidth,1) (где ",0)" -номер треугольника, ",1)" - номер ветки) и затем исходя из координаты камеры находить треугольники входящие в отрезок [CamX-Dist;CamX+Dist] [CamZ-Dist;CamZ+Dist] и применять к ним функцию RoamForceSplitTri. Заносить в массив стоит треугольники с номером менее RoamCriticalTriLevel, так как это соответствует минимально необходимому уровню. Координату треугольника можно определять по центральной точке. Каждой ячейке массива будет принадлежать только два треугольника, являющиеся соседями оснований. Перебрав все треугольники можно заполнить весь массив. Одна и та же ячейка будет заполняться дважды, треугольником и его соседом основания, так что неважно какой именно треугольник будет в массиве, они оба будут поделены функцией RoamForceSplitTri. Так же есть закономерность в распределении треугольников по уровням. Нарисовав простой рисунок можно выявить эту закономерность и заставить её служить на пользу.