Показать сообщение отдельно
Старый 07.06.2012, 20:46   #1
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
гексогональная тайловая карта(изометрия)

Пример шестиугольной изометрии :

Может кто лучше предложит а?

Function dot(x0,y0,x1,y1,x2,y2)
	Return (x1-x0)*(y2-y1)-(x2-x1)*(y1-y0)
End Function

Function InsideHexagon(px,py,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5)
	If dot(x0,y0,x1,y1,px,py)>0
		If dot(x1,y1,x2,y2,px,py)>0
			If dot(x2,y2,x3,y3,px,py)>0
				If dot(x3,y3,x4,y4,px,py)>0
					If dot(x4,y4,x5,y5,px,py)>0
						If dot(x5,y5,x0,y0,px,py)>0
							Return True
						EndIf
					EndIf
				EndIf
			EndIf
		EndIf
	EndIf
End Function

Type Pos
Field x,y,id
Field i,j ,wood
End Type 


Graphics 800,600,32 ,2

imgtile=CreateImage(41,21) 
SetBuffer ImageBuffer(imgtile) 
	Color 125,22,22
	Line 0,10,10,0
	Line 10,0,30,0
	Line 30,0,40,10
	Line 40,10,30,20
	Line 30,20,10,20
	Line 10,20,0,10
	Color 255,255,255
imgtile0=CreateImage(41,21) 
SetBuffer ImageBuffer(imgtile0) 
	Color 255,0,0
	Rect  10,0,20,20,1
	Color 255,255,255
woods=CreateImage(23,19) 
SetBuffer ImageBuffer(woods) 
	Color 11,255,255
	Oval  13,5,10,10,1
	Color 211,0,125
	Line 20,10,22,18
	Color 255,255,255
SetBuffer BackBuffer() 
d =41  :dd =(d/2)
tilex=26  : tiley=28

sx=  0 : sy=0

For j=-1 To tilex
	For i=-1 To tiley
		If (j Mod 2)  Then
			y =  i*(dd)
		Else
			y =  i*(dd)+ (dd/2)
		EndIf
			x = j*30
			id = id +1
			
			locates.pos = New pos
			locates\x  = x
			locates\y  = y
			locates\id = id
			locates\i  = i
			locates\j  = j
			locates\wood  = Rnd(0,810) 

        Next
Next
FlushMouse 
While Not KeyHit(1) 
Cls
mx = MouseX() : my = MouseY()

	If KeyDown(205) Then sx=sx+5
	If KeyDown(203) Then sx=sx-5
	If KeyDown(200) Then sy=sy-5
	If KeyDown(208) Then sy=sy+5

	For locates.pos = Each pos
	
		DrawImage imgtile ,sx+locates\x ,sy+locates\y
		If locates\wood = locates\id Then 
		;If ShipX = locates\wood Then ShipY = ShipY + 25 Or  ShipX = ShipX + 15	
		DrawImage woods ,sx+locates\x ,sy+locates\y
		EndIf 
		If  InsideHexagon(mx,my,sx+locates\x+0,sy+locates\y+10,sx+locates\x+10,sy+locates\y+0,sx+locates\x+30,sy+locates\y+0,sx+locates\x+40,sy+locates\y+10,sx+locates\x+30,sy+locates\y+20,sx+locates\x+10,sy+locates\y+20)=1 Then
		 DrawImage imgtile0 ,sx+locates\x ,sy+locates\y
			If MouseDown( 1 )
				LastClickX = locates\x+15
				LastClickY = locates\y+5
			EndIf
				pozx = locates\i 
				pozy = locates\j

		EndIf 
	Next 
	Text sx+10, sy+10," "+pozx+"."+pozy
	Text sx+10, sy+20,"id = "+id;+"."+pozy
	
	If ShipX < LastClickX Then ShipX = ShipX + 5	
	If ShipX > LastClickX Then ShipX = ShipX - 5
	If ShipY < LastClickY Then ShipY = ShipY + 5
	If ShipY > LastClickY Then ShipY = ShipY - 5	
	
	Rect( sx+ShipX ,sy+ ShipY, 10, 10 )		

Flip 


Wend
Delete Each pos
;FreeImage imgtile3
FreeImage woods
FreeImage  imgtile
FreeImage  imgtile0
End
(Offline)
 
Ответить с цитированием