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

Улучшенное перемещение , некоторые изменения в коде.

Type Pos
Field x,y,id
Field i,j 
Field wood ,wdx ,wdy
Field wall ,wx ,wy
End Type 


Graphics 800,600,32 ,2

geroy=LoadAnimImage("tip.png",32,32,0,12) :MaskImage geroy,0,0,0
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 5,0,255
	Rect  10,0,20,20,0
	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
wall=CreateImage(41,31) 
SetBuffer ImageBuffer(wall) ;картинка стены
L1= 11 :L2= 30
L3= 11 :L4= 20
	Color 111,78,78
	
	For w= 1 To 10
		Line w,L3,w,L4
		L3= L3-1 :L4= L4+1
	Next 
	For w= 30 To 40
		Line w,L3,w,L4
		L3= L3+1 :L4= L4-1
	Next 
	Color 141,141,141
	For w= 1 To 10
		Line L1,w,L2,w
		L1= L1-1 :L2= L2+1
	Next 
	For w= 11 To 20
		Line L1,w,L2,w
		L1= L1+1 :L2= L2-1
	Next 
	Color 121,99,99
	Rect 10,20,21,10,1
SetBuffer BackBuffer() 


Restore map_data

d =40  :dd =(d/2) : ddd =(dd/2)
tilex=13  : tiley=58 ;количество ячеек 13*58
sx=  0 : sy=10
pozx = 3
pozy = 3
ShipX = 165 : LastClickX = 165 : OldClickX = 165
ShipY = 30   : LastClickY = 30  : OldClickY = 30
For j=0 To tiley-1
	For i=0 To tilex-1
		
		If (j Mod 2)  Then
			x =  i*(d+dd)
		Else
			x =  i*(d+dd)+( dd+ddd)
		EndIf
			
			y = j*10
			
			id = id +1
			Read c
			
			locates.pos = New pos

			locates\id = id
			locates\i  = i
			locates\j  = j
			If c = 1 Then 
			locates\wall  = c
			locates\wx  = x
			locates\wy  = y			
			Else If c = 2 Then 
			locates\wood  = c
			locates\x  = x
			locates\y  = y	
			Else
			locates\x  = x
			locates\y  = y			
			EndIf 

        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 j=0 To tiley-1
	For i=0 To tilex-1
		
		If (j Mod 2)  Then
			x =  i*(d+dd)
		Else
			x =  i*(d+dd)+( dd+ddd)
		EndIf	
			y = j*10
			
		DrawImage imgtile ,sx+x ,sy+y
        Next
	Next
	
	; главный цикл перебора
	For locates.pos = Each pos

		If locates\wall Then ; генерация стен
			DrawImage wall ,sx+locates\wx ,(sy+locates\wy)-10
		EndIf

		If locates\wood Then ; генерация стен
			DrawImage woods ,sx+locates\x+Rnd(7,12) ,(sy+locates\y)-Rnd(11,15)
		EndIf
		
			If locates\i = pozx And locates\j=pozy Then ; проверка положения героя (сырой вариант)
			
				;вычиление положения героя и напрвления движения
					
				Select True  	
					Case ShipX< LastClickX And ShipY< LastClickY
						ShipX = ShipX + 5	:OldClickX = OldClickX + 5	
						ShipY = ShipY + 5   :OldClickY = OldClickY + 5
						k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку	
						
					Case ShipX< LastClickX And ShipY> LastClickY
						ShipX = ShipX + 5	:OldClickX = OldClickX + 5	
						ShipY = ShipY - 5   :OldClickY = OldClickY - 5
						k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку	
						
					Case ShipX> LastClickX And ShipY< LastClickY
						ShipX = ShipX - 5	:OldClickX = OldClickX - 5	
						ShipY = ShipY + 5   :OldClickY = OldClickY + 5
						k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку	
						
					Case ShipX> LastClickX And ShipY> LastClickY
						ShipX = ShipX - 5	:OldClickX = OldClickX - 5	
						ShipY = ShipY - 5   :OldClickY = OldClickY - 5
						k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку	
												
					Case ShipX< LastClickX And ShipY= LastClickY
						ShipX = ShipX + 5	:OldClickX = OldClickX + 5
						k2 = (k2 + 1) Mod (3) + (3 * (3) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку	
										
					Case ShipX> LastClickX And ShipY= LastClickY
						ShipX = ShipX - 5     :OldClickX = OldClickX - 5
						k3 = (k3 + 1) Mod (3) + (3 * (2) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k3 ; рисуем картинку	
										
					Case ShipY< LastClickY And ShipX= LastClickX
						ShipY = ShipY + 5   :OldClickY = OldClickY + 5
				k = (k + 1) Mod (3) + (3 * (1) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k ; рисуем картинку
											
					Case ShipY> LastClickY And ShipX= LastClickX
						ShipY = ShipY - 5	:OldClickY = OldClickY - 5
						k4 = (k4 + 1) Mod (3) + (3 * (4) - 3)
						DrawImage geroy,ShipX-15 ,ShipY ,k4 ; рисуем картинку		
									
					Default
						DrawImage geroy,(ShipX-15) ,ShipY ,1 ; рисуем картинку
				End Select 		 			
				
				If sx+ShipX = locates\wx And sy+ShipY = locates\wy
				
				EndIf 


			EndIf 	
		;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 MouseHit( 1 )
				OldClickX = LastClickX  ; старые координаты мыши после клика мыши
				OldClickY = LastClickY				
				LastClickX = locates\x+15 ; новые координаты мыши после клика мыши
				LastClickY = locates\y-10
				
				pozx = locates\i ; номера ячеек после клика мыши
				pozy = locates\j
			Else 
				Text 10, 0," "+locates\i+"."+locates\j ;выводит номера ячеек под мышью
			EndIf
		EndIf 

	Next 

	; инфо
	Text 10, 10," "+pozx+"."+pozy
	Text 10, 30,"  "+OldClickX+"_"+OldClickY+"  "+LastClickX+"_"+LastClickY
	Text 10, 40," ShipX =  "+ShipX+" | ShipY = "+ShipY
		
Flip 
Wend
; высвобождаем память
Delete Each pos
FreeImage wall
FreeImage woods
FreeImage  imgtile
FreeImage  imgtile0
End 



; данные карты 
.map_data
Data 1,1,1,1,1,1,1,1,1,1,1,1,1		,1,1,1,1,1,1,1,1,1,1,1,1,1		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,2,0,0,0,0,0,0,0,1		,1,0,0,0,2,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,2,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,1,1,0,0,0,0,1		,1,0,0,0,0,1,1,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,1,0,0,0,0,0,0,1		,1,0,0,0,0,1,0,0,0,0,0,0,0		,0,0,0,0,1,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,1,0,0,0,0,0,0,0,1		,1,0,0,0,1,0,0,0,0,1,0,0,0		,0,0,0,1,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0		,0,0,0,0,0,0,0,0,0,0,0,0,1		,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1		,1,1,1,1,1,1,1,1,1,1,1,1,1		;,1,1,1,1,1,1,1,1,1,1,1,1,1		,1,1,1,1,1,1,1,1,1,1,1,1,1

;--------------- функция проверки точки в гексагоне ---------------------------------------------------
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
;________________________________________________________________________


картинка во вложении
Изображения
 
(Offline)
 
Ответить с цитированием