Type Pos
Field x,y,id
Field i,j
Field wood ,wdx ,wdy
Field wall ,wx ,wy
Field tree
End Type
Graphics 800,600,32 ,2
geroy =LoadAnimImage("images\tip.png",32,32,0,12) :MaskImage geroy,0,0,0
trees =LoadAnimImage("images\trees1.png",40,36,0,6) :MaskImage trees,0,0,0
grass =LoadAnimImage("images\grass1.png",40,40,0,5) :MaskImage grass ,0,0,0
dom =LoadImage("images\dom.png") :MaskImage dom,0,0,0
;grass =LoadImage("images\grass.png") ;: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
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
locates\tree = Rnd(1,5)
Else
locates\x = x
locates\y = y
EndIf
Next
Next
FlushMouse
While Not KeyHit(1)
ClsColor 35,60,60
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 grass ,sx+x ,sy+y,gr = (gr + 1) Mod (3) + (3 * (4) - 3)
Next
Next
; главный цикл перебора
For locates.pos = Each pos
If locates\wall Then ; генерация стен
DrawImage dom ,sx+locates\wx ,(sy+locates\wy)-10
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,sx+ShipX-15 ,sy+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,sx+ShipX-15 ,sy+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,sx+ShipX-15 ,sy+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,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку
Case ShipX< LastClickX And ShipY= LastClickY
ShipX = ShipX + 5 :OldClickX = OldClickX + 5
k2 = (k2 + 1) Mod (3) + (3 * (3) - 3)
DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку
Case ShipX> LastClickX And ShipY= LastClickY
ShipX = ShipX - 5 :OldClickX = OldClickX - 5
k3 = (k3 + 1) Mod (3) + (3 * (2) - 3)
DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k3 ; рисуем картинку
Case ShipY< LastClickY And ShipX= LastClickX
ShipY = ShipY + 5 :OldClickY = OldClickY + 5
k = (k + 1) Mod (3) + (3 * (1) - 3)
DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k ; рисуем картинку
Case ShipY> LastClickY And ShipX= LastClickX
ShipY = ShipY - 5 :OldClickY = OldClickY - 5
k4 = (k4 + 1) Mod (3) + (3 * (4) - 3)
DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k4 ; рисуем картинку
Default
DrawImage geroy,sx+(ShipX-15) ,sy+ShipY ,1 ; рисуем картинку
End Select
EndIf
If locates\wood Then ; генерация стен
DrawImage trees ,sx+locates\x ,(sy+locates\y),locates\tree
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 )
FlushMouse
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
; инфо
Color 50,50,50
Rect 5,15,145,35
Color 255,255,255
Text 10, 10," "+pozx+"."+pozy
Text 10, 20," "+OldClickX+"_"+OldClickY+" "+LastClickX+"_"+LastClickY
Text 10, 30," ShipX = "+ShipX+" | ShipY = "+ShipY
Flip
Wend
; высвобождаем память
Delete Each pos
FreeImage imgtile
FreeImage imgtile0
FreeImage geroy
FreeImage dom
FreeImage grass
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,2,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,2,2,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,2,2,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,2,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,2,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,2,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,2,0,0,0,0,0,0,0,0,1 ,1,0,0,0,0,0,0,0,0,2,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
;________________________________________________________________________