;--------------- функция проверки точки в гексагоне ---------------------------------------------------
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,wall
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 ;количество ячеек 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\x = x
locates\y = y
locates\id = id
locates\i = i
locates\j = j
locates\wall = 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 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 = 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
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+" __ "+ShipX+" __ "+ShipY
Flip
Wend
; высвобождаем память
Delete Each pos
FreeImage wall
FreeImage woods
FreeImage imgtile
FreeImage imgtile0
End