' Класс clsOctree.cls - октодерево для квантования цвета и нахождения 256-цветной, оптимальной палитры
' © Кривоус Анатолий Анатольевич (The trick), 2014

#Include Once "project.bi"


Property clsOctree.Child(ByVal Index As Long) As clsOctree Ptr
	Property = mChild(Index)
End Property

Property clsOctree.Child(ByVal Index As Long, ByRef Value As clsOctree Ptr)
	mChild(Index) = Value
End Property

' Получить ближайший похожий цвет из палитры
Property clsOctree.GetNearestPaletteIndex(ByRef Col As RGBTriple) As Long
	Dim Br As Long
	If IsLeaf<>0 Then 
		Return ColorIndex
	EndIf 
	Br = IIf(Col.rgbtRed And Mask(Depth),-1,0) * -4 + _
	IIf(Col.rgbtGreen And Mask(Depth),-1,0) * -2 + _
	IIf(Col.rgbtBlue And Mask(Depth),-1,0) * -1
	return mChild(Br)->GetNearestPaletteIndex(Col)
End Property

' просто для коллекции (в FB по другому нельзя).Для программы не нужно
Property clsOctree.GetNearestPaletteIndex(i As integer)
	GetNearestPaletteIndex = i
End Property

' Получить палитру
Sub clsOctree.GetPalette(Pal() As Long,byref StartIndex As Long = 0)
	Dim rr As Long, rg As Long, rb As Long, i As Long
	If IsLeaf Or Depth = TreeLeafLevel Then
		rr = R \ ColorCount
		rg = G \ ColorCount
		rb = B \ ColorCount
		Pal(StartIndex) = rr * &H10000 Or rg * &H100 Or rb
		ColorIndex = StartIndex
		IsLeaf = True
		StartIndex = StartIndex + 1
	Else
		For i = 0 To 7
			If mChild(i) <> 0 Then
				mChild(i)->GetPalette (Pal(), StartIndex)
			End If
		Next
	End If
End Sub

' Добавить цвет в дерево
Sub clsOctree.AddTree(Col As RGBTriple Ptr, ByVal Depth As Long)

	Dim Br As Long

	ColorCount = ColorCount + 1

	R = R + Col->rgbtRed
	G = G + Col->rgbtGreen
	B = B + Col->rgbtBlue

	If IsLeaf = False And Depth < TreeLeafLevel Then
		Br = IIf(Col->rgbtRed And Mask(Depth),-1,0) * -4 + _
		IIf(Col->rgbtGreen And Mask(Depth),-1,0) * -2 + _
		IIf(Col->rgbtBlue And Mask(Depth),-1,0) * -1

		If mChild(Br) = 0 Then
			ChildCount = ChildCount + 1
			If ChildCount = 2 Then
				Nxt = TreeReduceList(Depth)
				TreeReduceList(Depth) = @this
			End If
		End If
		Depth = Depth + 1
		If mChild(Br) = 0 Then
			mChild(Br) = New clsOctree
			mChild(Br)->Depth = Depth
			mChild(Br)->IsLeaf = Depth >= TreeLeafLevel
			If mChild(Br)->IsLeaf<>0 Then TreeSize = TreeSize + 1
		End If
		mChild(Br)->AddTree Col, Depth
	End If

End Sub
' Удалить все дочерние узлы
Sub clsOctree.KillChild()
	Dim i As Long
	If ChildCount = 0 Then Exit Sub
	For i = 0 To 7
		If  mChild(i) <> 0 Then mChild(i)->KillChild
		Delete mChild(i)
		mChild(i) = 0
	Next
End Sub

' "Обрезать" дерево
Sub clsOctree.ReduceTree()
	Dim Node As clsOctree Ptr, i As Long, d As Long
	i = TreeReduceLevel
	Do While TreeReduceList(i) = 0
		i = i - 1
	Loop
	Node = TreeReduceList(i)
	TreeReduceList(i) = TreeReduceList(i)->Nxt
	Node->IsLeaf = True
	d = Node->Depth
	TreeSize = TreeSize - Node->ChildCount + 1
	Node->KillChild()
	Node = 0
	If d < TreeReduceLevel Then
		TreeReduceLevel = d
		TreeLeafLevel = d + 1
	End If
End Sub

Constructor clsOctree()
	Dim i As Long
	ReDim mChild(7)
	ReDim Mask(7)
	Mask(0) = 128
	For i = 1 To 7
		Mask(i) = Mask(i - 1) \ 2
	Next
End Constructor


