www.boolean.name

www.boolean.name (http://forum.boolean.name/index.php)
-   2D-программирование (http://forum.boolean.name/forumdisplay.php?f=13)
-   -   гексогональная тайловая карта(изометрия) (http://forum.boolean.name/showthread.php?t=16878)

polopok 07.06.2012 16:46

гексогональная тайловая карта(изометрия)
 
Пример шестиугольной изометрии :

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

Код:

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


polopok 07.06.2012 17:20

Ответ: гексогональная тайловая карта(изометрия)
 
Отправной точкой явилась статья http://hale32bit.blogspot.com/

radiobutton 07.06.2012 19:34

Ответ: гексогональная тайловая карта(изометрия)
 
Все это давно известно и можно прочитать В свойствах правильного шестиугольника, например тут xD
http://ru.wikipedia.org/wiki/Правильный_шестиугольник

polopok 08.06.2012 01:30

Ответ: гексогональная тайловая карта(изометрия)
 
Цитата:

Сообщение от radiobutton (Сообщение 229769)
Все это давно известно и можно прочитать В свойствах правильного шестиугольника, например тут xD
http://ru.wikipedia.org/wiki/Правильный_шестиугольник

Как замечательно ,что вам все это давно известно. Ну раз так ,то предложите реализацию попроще, было б интересно взглянуть.

Gector 08.06.2012 07:27

Ответ: гексогональная тайловая карта(изометрия)
 
Цитата:

Сообщение от polopok (Сообщение 229789)
Как замечательно ,что вам все это давно известно. Ну раз так ,то предложите реализацию попроще, было б интересно взглянуть.

А собственно, что тебя не устраивает в этой? Я пока недостатков никаких не нашел. Пашет и пашет себе.

radiobutton 08.06.2012 09:04

Ответ: гексогональная тайловая карта(изометрия)
 
Цитата:

Сообщение от polopok (Сообщение 229789)
Как замечательно ,что вам все это давно известно. Ну раз так ,то предложите реализацию попроще, было б интересно взглянуть.

А что именно нужно сделать?
Закрасить экран шестиугольниками и сделать поиск пути, такой же как на экране?

moka 08.06.2012 10:17

Ответ: гексогональная тайловая карта(изометрия)
 
Не используй стандартное 2D в блице, оно использует DirectDraw - а это старый подход, и не использует аппаратного ускорения, а налегает на CPU.

Лучше всего было бы генерировать геометрию используя вершины и трианглы, и рисовать такое дело в виде одного сюрфейса.
И рендер будет шустрее, и будет возможность нормально затекстурить и т.п.

Либо заюзать FastImage и их возможность рисовать трианглы (DrawPoly вроди).

polopok 08.06.2012 13:54

Ответ: гексогональная тайловая карта(изометрия)
 
Да собственно меня устраивает ,просто думал может есть способ подругому вычислять попадание мыши в шестигранник .
А так ,захотелось попробовать гексо-тайлы .

moka 08.06.2012 14:29

Ответ: гексогональная тайловая карта(изометрия)
 
То как ты делаешь - ужасно, математика умеет это намного лучше:
http://www.playchilla.com/how-to-che...side-a-hexagon

polopok 09.06.2012 01:38

Ответ: гексогональная тайловая карта(изометрия)
 
Вот спасибо попробую ... я так и думал что есть более удобное вычисление.

polopok 15.06.2012 16:34

Ответ: гексогональная тайловая карта(изометрия)
 
Некоторое продолжение ...

Код:

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


polopok 15.06.2012 16:43

Ответ: гексогональная тайловая карта(изометрия)
 
Сразу скажу ,что код нужно оптимизировать . но думаю как концепция какой-нибудь игры пойдёт

Jlemyp 17.06.2012 18:39

Ответ: гексогональная тайловая карта(изометрия)
 
я все равно не понял как это делается.Кто может обьяснить подробнее,или ссылку на хороший и понятный расклад по полочкам.Мне нужно по нажатию мыши по гексу определить, к какой ячейке массива он пренадлежит.Так как карта в массиве,или лучше как у вас в типе ее держать?

polopok 18.06.2012 04:59

Ответ: гексогональная тайловая карта(изометрия)
 
Для меня лучше в типе держать ( гибче) ,хотя можно и в массиве .
так там при запуске выводится номера ячеек (в левом верхнем углу).

polopok 18.06.2012 05:18

Ответ: гексогональная тайловая карта(изометрия)
 
Вот пример с пояснениями

Код:

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



Кстати ,кому может понадобиться изображения тайлов ,качаем здесь : http://rpg-maker.info/gallery/-rpg-m...-xp/animations


Часовой пояс GMT +1, время: 16:22.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Перевод: zCarot