[polopok]

Некоторое продолжение ...

Dim r_map(27,29)	;<- for the in game map

Dim a_map(27,29,5)	;<- for the A* pathfinder



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
Field geroy$ ,gx ,gy
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 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() 

.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,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,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

Restore map_data

d =40  :dd =(d/2) : ddd =(dd/2)
tilex=13  : tiley=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\x  = x
			locates\y  = y
			locates\id = id
			locates\i  = i
			locates\j  = j
			locates\wood  = c

        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
	Next 

	For locates.pos = Each pos
	;If RectsOverlap (sx+locates\x, sx+locates\y, sx+40, 20, sx+0, sy+0, sx+800, sy+600)
		If locates\wood = 1 Then 
			DrawImage wall ,sx+locates\x ,(sy+locates\y)-10
		EndIf 
			If locates\i = pozx And locates\j=pozy Then 
			
	If OldClickX < LastClickX Then ShipX = ShipX + 5	:OldClickX = OldClickX + 5
	If OldClickX > LastClickX Then ShipX = ShipX - 5     :OldClickX = OldClickX - 5
	If OldClickY < LastClickY Then ShipY = ShipY + 5   :OldClickY = OldClickY + 5
	If OldClickY > LastClickY Then ShipY = ShipY - 5	:OldClickY = OldClickY - 5			
				Color 1,222,222
				Rect(sx+ ShipX ,(sy+5)+ShipY , 10, 20 )	
				Color 255,255,255
			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
			
			;Text sx+10, sy+20," "+sx+locates\x+"."+sx+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 
		;EndIf
	Next 

	
	Text 10, 10," "+pozx+"."+pozy
	;Text sx+10, sy+20,"id = "+id;+"."+pozy
	Text 10, 30,"  "+OldClickX+"_"+OldClickY+"  "+LastClickX+"_"+LastClickY+" __ "+ShipX+" __ "+ShipY
	
		

Flip 


Wend
Delete Each pos
FreeImage wall
FreeImage woods
FreeImage  imgtile
FreeImage  imgtile0
End