Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Полезные функции

Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново...

Ответ
 
Опции темы
Старый 23.11.2013, 00:00   #1
IgorOK
Мастер
 
Аватар для IgorOK
 
Регистрация: 26.10.2009
Сообщений: 1,194
Написано 615 полезных сообщений
(для 2,209 пользователей)
QuickHull

Реализация простенького алгоритма QuickHull на блице.

Управление в примере:
Нажатием мыши - ставим точки
Пробел - сгенерировать оболочку

Function Bank_Add(Bank, Value)
	Local Size=BankSize(Bank)
	ResizeBank(Bank, Size+4)
	PokeInt Bank, Size, Value
	Return Size/4
End Function

Function Bank_Remove(Bank, Index)
	Local Size=BankSize(Bank)-4
	Local NewBank=CreateBank(Size)
	Local Offset=Index*4

	If Offset
		CopyBank Bank, 4, NewBank, 0, Size
		
	Else If Offset=Size
		CopyBank Bank, 0, NewBank, 0, Size
		
	Else
		CopyBank Bank, 0, NewBank, 0, Offset
		CopyBank Bank, Offset+4, NewBank, Offset, Size-Offset
	EndIf

	FreeBank Bank
	Return NewBank
End Function


Function Mouse_X()
	Return MouseX()-OX
End Function

Function Mouse_Y()
	Return MouseY()-OY
End Function










Global Count

Type TPoint
	Field X#, Y#
	Field C[3]
	Field Name$
End Type

Type TSegment
	Field A.TPoint, B.TPoint, Top.TPoint
	Field XW#, YW#
	
	Field PBank, PCount
End Type

Global OX=GraphicsWidth()/2, OY=GraphicsHeight()/2

Global EdgeA.TPoint, EdgeB.TPoint


Function NewPoint.TPoint(X#, Y#, R=255, G=255, B=255, Name$="")
	Local P.TPoint=New TPoint
	P\X=X
	P\Y=Y
	P\C[0]=R
	P\C[1]=G
	P\C[2]=B
	P\Name=Name
	
	Count=Count+1
	
	Return P
End Function

Function FindEdges()
	Local MinX#=9999999
	Local MaxX#=-99999999
	
	For P.TPoint=Each TPoint
		If P\X<MinX
			MinX=P\X
			EdgeA=P
		EndIf

		If P\X>MaxX
			MaxX=P\X
			EdgeB=P
		EndIf
	Next

	If EdgeA=Null Then Return
	
	EdgeA\C[0]=0
	EdgeA\C[1]=0

	EdgeB\C[1]=0
	EdgeB\C[2]=0
End Function



Function Build()
	FindEdges()

	;Build first segment
	Local AXW#=EdgeB\X-EdgeA\X
	Local AYW#=EdgeB\Y-EdgeA\Y

	;Up direction
	Local U.TSegment=New TSegment
	U\A=EdgeA
	U\B=EdgeB
	U\XW=AXW
	U\YW=AYW
	U\PBank=CreateBank(0)

	;Down direction
	Local D.TSegment=New TSegment
	D\A=EdgeB
	D\B=EdgeA
	D\XW=-AXW
	D\YW=-AYW
	D\PBank=CreateBank(0)

	Local MaxW#=0
	Local MinW#=0
	
	For P.TPoint=Each TPoint
		If P<>EdgeA And P<>EdgeB
			Local XW#=P\X-EdgeA\X
			Local YW#=P\Y-EdgeA\Y
	
			Local W#=XW*AYW-YW*AXW
	
			If W>=0
				Bank_Add(U\PBank, Handle(P))
				U\PCount=U\PCount+1
			Else
				Bank_Add(D\PBank, Handle(P))
				D\PCount=D\PCount+1
			EndIf

			If W>MaxW
				U\Top=P
				MaxW=W
				
			Else If W<MinW
				D\Top=P
				MinW=W
			EndIf
		EndIf
	Next

	Extend()
End Function

Function Extend()
	Repeat
		Local Clear=True
		Local Segment.TSegment
		
		For Segment=Each TSegment
			If Segment\PCount<>0
				Clear=False
				
				Local Top.TPoint=Segment\Top
			
				;Left
				Local L.TSegment=New TSegment
				L\A=Segment\A
				L\B=Top
				L\XW=L\B\X-L\A\X
				L\YW=L\B\Y-L\A\Y
				L\PBank=CreateBank(0)
			
				;Right
				Local R.TSegment=New TSegment
				R\A=Top
				R\B=Segment\B
				R\XW=R\B\X-R\A\X
				R\YW=R\B\Y-R\A\Y
				R\PBank=CreateBank(0)
			
				Local P.TPoint
			
				Local LMaxW#=0, RMaxW#=0
			
				For Index=0 To Segment\PCount-1
					P=Object.TPoint(PeekInt(Segment\PBank, Index*4))
			
					If P<>Top And P<>Segment\A And P<>Segment\B
						Local LXW#=P\X-L\A\X
						Local LYW#=P\Y-L\A\Y
						Local LW#=LXW*L\YW-LYW*L\XW
				
						Local RXW#=P\X-R\A\X
						Local RYW#=P\Y-R\A\Y
						Local RW#=RXW*R\YW-RYW*R\XW
						
						If LW>0
							Bank_Add(L\PBank, Handle(P))
							L\PCount=L\PCount+1
			
							If LW>LMaxW
								L\Top=P
								LMaxW=LW
							EndIf
							
						Else If RW>0
							Bank_Add(R\PBank, Handle(P))
							R\PCount=R\PCount+1
			
							If RW>RMaxW
								R\Top=P
								RMaxW=RW
							EndIf
						EndIf
					EndIf
				Next
			
				;Delete segment
				FreeBank Segment\PBank
				Delete Segment

				Render()
				Flip:Cls
				;Stop
			EndIf
		Next

		If Clear Then Exit
	Forever
End Function

Function FindTop.TPoint(Segment.TSegment)
	Local MaxW=-1

	Local P.TPoint
	Local Top.TPoint

	For Index=0 To Segment\PCount-1
		P=Object.TPoint(PeekInt(Segment\PBank, Index*4))
		
		Local XW#=P\X-Segment\A\X
		Local YW#=P\Y-Segment\A\Y

		Local W#=XW*Segment\YW-YW*Segment\XW
		
		If W>MaxW
			MaxW=W
			Top=P
		EndIf
	Next

	Top\C[0]=0
	Top\C[2]=0

	Return Top
End Function

Function Render()
	For P.TPoint=Each TPoint
		Color P\C[0], P\C[1], P\C[2]
		Text OX+P\X, OY+P\Y, "+", True, True

		Color 255, 255, 255
		Text OX+P\X, OY+P\Y+20, P\Name, True, True
	Next

	For S.TSegment=Each TSegment
		Line OX+S\A\X, OY+S\A\Y, OX+S\B\X, OY+S\B\Y
	Next
End Function

Graphics 1024, 768, 32, 2
SetBuffer BackBuffer()

OX=GraphicsWidth()/2
OY=GraphicsHeight()/2

While Not KeyHit(1)
	If MouseHit(1)
		NewPoint(Mouse_X(), Mouse_Y())
	EndIf

	If KeyHit(57)
		Build()
	EndIf
	
	Render()
	Flip:Cls
Wend
End
(Offline)
 
Ответить с цитированием
Эти 5 пользователя(ей) сказали Спасибо IgorOK за это полезное сообщение:
FREE MAN (23.11.2013), KCEPOKC (23.11.2013), MadMedic (23.11.2013), Nerd (23.11.2013), tirarex (23.11.2013)
Старый 23.11.2013, 14:30   #2
IgorOK
Мастер
 
Аватар для IgorOK
 
Регистрация: 26.10.2009
Сообщений: 1,194
Написано 615 полезных сообщений
(для 2,209 пользователей)
Ответ: QuickHull

Немного грязный код выложил. Забыл что функция Bank_Remove(), не используется.
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 14:29.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com