|
2D-программирование Вопросы, касающиеся двумерного программирования |
18.06.2012, 14:38
|
#16
|
ПроЭктировщик
Регистрация: 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)
|
|
18.06.2012, 16:03
|
#17
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Появились новые текстуры...
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
;________________________________________________________________________
Распаковать архив в папку с сохранённой программой !( в архиве необходимые текстуры)
|
(Offline)
|
|
Эти 2 пользователя(ей) сказали Спасибо polopok за это полезное сообщение:
|
|
18.06.2012, 20:45
|
#18
|
Нуждающийся
Регистрация: 18.06.2009
Сообщений: 51
Написано одно полезное сообщение
|
Ответ: гексогональная тайловая карта(изометрия)
Спасибо кажется разобрался.Если возникнут вопросы на которые сам не найду решения,задам.Надеюсь поможешь.(это не вопрос а задумка:мне нужно будет знать какие номера саседних гексов будут находится вокруг игрока,что бы узнать проходимый или нет).Если знаешь сразу ответ не откажусь от подсказки.
|
(Offline)
|
|
20.06.2012, 12:58
|
#19
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Так номера вычислить просто . Берём номер ячейки персонажа ,например 2,4 _(i,j) ,тогда номера вокруг персонажа будут ,при моей форме гексов
_____ 2,4-2 _____
2,4-1| 2,4 | 2+1,4-1
2,4+1 ______ 2+1,4+1
_____|2,4+2 |______
|
(Offline)
|
|
21.06.2012, 17:33
|
#20
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Продолжаем ...
Теперь можно добавлять новых героев (нажав на клавиатуре цифру 1
Так же несколько изменён код
Продолжение следует ...
|
(Offline)
|
|
01.07.2012, 13:01
|
#21
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Итак начнём сначала и постепенно будем усложнять .
Здесь : - прорисовка тайлов
- определение тайла по нажатии мыши
- прорисовка только тех гексов ,что находятся в зоне видимости
- зона вывода меню для всякого рода кнопок ,мини карты ,ресурсов и тд.
- вывод инфо
Для просмотра кода нажмите OFFTOP
;_______________________________________________________________________________
Global gex_grass , gex , gex_activ , gex_water , gex_wall , gex_wood
Global tilex , tiley , CamX , CamY , HexagonNumber , N
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#
Const GrWidth = 800 ;ширина экрана
Const GrHeight = 600 ;высота экрана
;_______________________________________________________________________________
Graphics GrWidth , GrHeight , 32 , 2
fntArial=LoadFont("Arial",14) ;загрузка шрифта с указанием размера шрифта
SetFont fntArial ;активация шрифта
; вычисление центра экрана :
CenterMapX = GrWidth/2 ;половина ширины экрана
CenterMapY = GrHeight/2 ;половина высоты экрана
w = 40 ;ширина тайла
h = 20 ;высота тайла
tilex =10 ;кол-во тайлов по горизонтали
tiley = 5 ;кол-во тайлов по вертикали
pw = w/4*3 ;параметр смещения тайлов по горизонтали
h2 = h/2 ;половина высоты тайла
;позиция камеры :
CamX =0
CamY =0
Dim Map( tilex+1 +10, tiley+1 +10)
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
CreateImages() ;создаём или загружаем изображения , анимированые изображения
LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer() ;устанавливаем задний буффер
;__________ Main programm _____________________________________________________________________
While Not KeyHit(1) ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112 ;цвет очистки экрана
Cls ;очистка экрана
mx# = MouseX() : my# = MouseY() ; координаты мыши
DrawMap() ;прорисовываем карту
KeyMouse() ;события мыши , клавиатуры
DrawMenu() ;прорисовка меню в игре
Text mx,my,"^" ;отображает положение курсора
;__________ Info _____________________________________________________________________
Info()
;______________________________________________________________________________
Flip ; Меняем буфер
Wend
FreeFont fntArial ; удаляем шрифт
End
;_______________________________________________________________________________
Function Info()
Text 100 ,525 ,"kx : "+kx+" ky :"+ky+" oldx : "+oldx +" oldy : "+oldy;+" ix : "+ix +" jy : "+jy
Text 100 ,540 ," U : "+sxx+" V :"+syy
Text 100 ,555 ," Mouse X : "+xx+" Mouse Y :"+yy
; Text 100 ,575 ,"Координаты мышы в сетке : UX : "+mx+" VY :"+my
End Function
;_______________________________________________________________________________
Function KeyMouse()
If KeyHit(49) Then N = 1 - N ; (отобразить | скрыть) id ячейки по нажатию клавиши N
If MouseDown(2) Then mouseSelect = False ; сброс выбора ячейки
If MouseDown(1) Then ; выбор ячейки
oldx = kx : oldy = ky ; старые координаты мыши
sx# =Floor# (mx# /(w+0.15) * 4/3 - 0.15) ; вычисление номера ячейки по горизонтали
sy# =Floor# ( my# /h - (sx# Mod 2)/2 ) ; вычисление номера ячейки по вертикали
sxx = Int (sx#) ; округление результата
syy = Int (sy#)
xx = sxx * pw ; вычисление координат ячейки по номеру ячейки
yy = syy * h +(sxx Mod 2)*h2
mouseSelect = True
Else
kx = xx : ky = yy ; новые координаты мыши
EndIf
End Function
;_______________________________________________________________________________
Function DrawMap()
For j=0 To tiley
For i=0 To tilex
x = i * pw ; вычисление координат ячейки по номеру
y = (j * h +(i Mod 2)*h2)
If RectsOverlap (0 , 0 , 600 , 500 , x , y , w , h ) Then ; прорисовывает только то ,что попадает в зону видимости экрана
DrawImage gex, x +CamX , y +CamY ; прорисовывает гексы
If Map(i , j) <= 0
DrawImage gex_grass, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "0"
Else If Map(i , j) = 1
DrawImage gex_wood, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "1"
Else If Map(i , j) = 2
DrawImage gex_wall, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "2"
Else If Map(i , j) = 3
DrawImage gex_water, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "3"
Else If Map(i , j) = 4
;DrawImage gex_water, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "4"
EndIf
If N = 1 Then ; id только в целях отладки ! Так как жутко тормозит
HexagonNumber = i+ j * tilex ; id ячейки
Text x +CamX +10, y +CamY +5 , HexagonNumber ; текст id ячейки
EndIf
If mouseSelect = True Then ;если ячейка выбрана рисовать ...
DrawImage gex_activ , kx +locx , ky +locy
EndIf
End If
Next
Next
End Function
;_______________________________________________________________________________
Function LoadMap(file$)
filein = ReadFile(file$)
mapline = 0
If filein <> 0 Then
While Not Eof(filein)
mapStr$ = ReadLine$(filein)
Wend
CloseFile(filein)
For j=0 To tilex
For i=0 To tilex
mapline = mapline +1
Map(i , j ) = Int( Mid (mapStr$, mapline , 1))
Next
Next
Else
RuntimeError "Такого файла нет"
CloseFile(filein)
Delay 1000
;Exit
End If
End Function
;_______________________________________________________________________________
Function DrawMenu()
Color 0 , 109 , 39
Rect 0 , 0 , 600 , 500 ,0
Color 139 , 134 , 78
Rect 600 , 0 , 200 , 500 ,1
Rect 0 , 500 , 800 , 100 ,1
Color 255,255,255
End Function
;_______________________________________________________________________________
Function CreateImages()
gex = CreateImage(w+1,h+1) ; создаём изображение гекса
SetBuffer ImageBuffer(gex)
Color 238,118,0
Line 0,h/2 ,w/4,0
Line w/4,0 ,pw,0
Line pw,0 ,w,h/2
Line w,h/2 ,pw,h
Line pw,h ,w/4,h
Line w/4,h ,0,h/2
gex_activ = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_activ)
Color 102,5,0
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_grass = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_grass)
Color 50,205,50
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_water = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_water)
Color 0,206,209
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_wall = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_wall)
Color 205,197,191
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_wood = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_wood)
SeedRnd MilliSecs()
Color 0,197,90
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
For q1 = 0 To Rnd(12,46)
Color 5,Rnd(40,180),Rnd(40,180)
Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
Next
Color 255,255,255
End Function
Последний раз редактировалось polopok, 01.07.2012 в 21:00.
|
(Offline)
|
|
01.07.2012, 21:05
|
#22
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Добавил загрузку карты .
Прежде чем запустить этот код создайте карту в редакторе катры (он ниже)
;_______________________________________________________________________________
Global gex_grass , gex , gex_activ , gex_water , gex_wall , gex_wood
Global tilex , tiley , CamX , CamY , HexagonNumber , N
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#
Const GrWidth = 800 ;ширина экрана
Const GrHeight = 600 ;высота экрана
;_______________________________________________________________________________
Graphics GrWidth , GrHeight , 32 , 2
fntArial=LoadFont("Arial",14) ;загрузка шрифта с указанием размера шрифта
SetFont fntArial ;активация шрифта
; вычисление центра экрана :
CenterMapX = GrWidth/2 ;половина ширины экрана
CenterMapY = GrHeight/2 ;половина высоты экрана
w = 40 ;ширина тайла
h = 20 ;высота тайла
tilex =10 ;кол-во тайлов по горизонтали
tiley = 5 ;кол-во тайлов по вертикали
pw = w/4*3 ;параметр смещения тайлов по горизонтали
h2 = h/2 ;половина высоты тайла
;позиция камеры :
CamX =0
CamY =0
Dim Map( tilex+1 +10, tiley+1 +10)
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
CreateImages() ;создаём или загружаем изображения , анимированые изображения
LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer() ;устанавливаем задний буффер
;__________ Main programm _____________________________________________________________________
While Not KeyHit(1) ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112 ;цвет очистки экрана
Cls ;очистка экрана
mx# = MouseX() : my# = MouseY() ; координаты мыши
DrawMap() ;прорисовываем карту
KeyMouse() ;события мыши , клавиатуры
DrawMenu() ;прорисовка меню в игре
Text mx,my,"^" ;отображает положение курсора
;__________ Info _____________________________________________________________________
Info()
;______________________________________________________________________________
Flip ; Меняем буфер
Wend
FreeFont fntArial ; удаляем шрифт
End
;_______________________________________________________________________________
Function Info()
Text 100 ,525 ,"kx : "+kx+" ky :"+ky+" oldx : "+oldx +" oldy : "+oldy;+" ix : "+ix +" jy : "+jy
Text 100 ,540 ," U : "+sxx+" V :"+syy
Text 100 ,555 ," Mouse X : "+xx+" Mouse Y :"+yy
; Text 100 ,575 ,"Координаты мышы в сетке : UX : "+mx+" VY :"+my
End Function
;_______________________________________________________________________________
Function KeyMouse()
If KeyHit(49) Then N = 1 - N ; (отобразить | скрыть) id ячейки по нажатию клавиши N
If MouseDown(2) Then mouseSelect = False ; сброс выбора ячейки
If MouseDown(1) Then ; выбор ячейки
oldx = kx : oldy = ky ; старые координаты мыши
sx# =Floor# (mx# /(w+0.15) * 4/3 - 0.15) ; вычисление номера ячейки по горизонтали
sy# =Floor# ( my# /h - (sx# Mod 2)/2 ) ; вычисление номера ячейки по вертикали
sxx = Int (sx#) ; округление результата
syy = Int (sy#)
xx = sxx * pw ; вычисление координат ячейки по номеру ячейки
yy = syy * h +(sxx Mod 2)*h2
mouseSelect = True
Else
kx = xx : ky = yy ; новые координаты мыши
EndIf
End Function
;_______________________________________________________________________________
Function DrawMap()
For j=0 To tiley
For i=0 To tilex
x = i * pw ; вычисление координат ячейки по номеру
y = (j * h +(i Mod 2)*h2)
If RectsOverlap (0 , 0 , 600 , 500 , x , y , w , h ) Then ; прорисовывает только то ,что попадает в зону видимости экрана
DrawImage gex, x +CamX , y +CamY ; прорисовывает гексы
If Map(i , j) <= 0
DrawImage gex_grass, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "0"
Else If Map(i , j) = 1
DrawImage gex_wood, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "1"
Else If Map(i , j) = 2
DrawImage gex_wall, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "2"
Else If Map(i , j) = 3
DrawImage gex_water, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "3"
Else If Map(i , j) = 4
;DrawImage gex_water, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "4"
EndIf
If N = 1 Then ; id только в целях отладки ! Так как жутко тормозит
HexagonNumber = i+ j * tilex ; id ячейки
Text x +CamX +10, y +CamY +5 , HexagonNumber ; текст id ячейки
EndIf
If mouseSelect = True Then ;если ячейка выбрана рисовать ...
DrawImage gex_activ , kx +locx , ky +locy
EndIf
End If
Next
Next
End Function
;_______________________________________________________________________________
Function LoadMap(file$)
filein = ReadFile(file$)
mapline = 0
If filein <> 0 Then
While Not Eof(filein)
mapStr$ = ReadLine$(filein)
Wend
CloseFile(filein)
For j=0 To tilex
For i=0 To tilex
mapline = mapline +1
Map(i , j ) = Int( Mid (mapStr$, mapline , 1))
Next
Next
Else
RuntimeError "Такого файла нет"
CloseFile(filein)
Delay 1000
;Exit
End If
End Function
;_______________________________________________________________________________
Function DrawMenu()
Color 0 , 109 , 39
Rect 0 , 0 , 600 , 500 ,0
Color 139 , 134 , 78
Rect 600 , 0 , 200 , 500 ,1
Rect 0 , 500 , 800 , 100 ,1
Color 255,255,255
End Function
;_______________________________________________________________________________
Function CreateImages()
gex = CreateImage(w+1,h+1) ; создаём изображение гекса
SetBuffer ImageBuffer(gex)
Color 238,118,0
Line 0,h/2 ,w/4,0
Line w/4,0 ,pw,0
Line pw,0 ,w,h/2
Line w,h/2 ,pw,h
Line pw,h ,w/4,h
Line w/4,h ,0,h/2
gex_activ = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_activ)
Color 102,5,0
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_grass = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_grass)
Color 50,205,50
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_water = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_water)
Color 0,206,209
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_wall = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_wall)
Color 205,197,191
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
gex_wood = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_wood)
SeedRnd MilliSecs()
Color 0,197,90
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
For q1 = 0 To Rnd(12,46)
Color 5,Rnd(40,180),Rnd(40,180)
Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
Next
Color 255,255,255
End Function
Редактор карты :
;_______________________________________________________________________________
Global image0 , gex , gex_activ , image1 , image2 , image3
Global tilex , tiley , CamX , CamY , sel
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#
Const GrWidth = 800 ;ширина экрана
Const GrHeight = 600 ;высота экрана
;_______________________________________________________________________________
Graphics GrWidth , GrHeight , 32 , 2
fntArial=LoadFont("Arial",14) ;загрузка шрифта с указанием размера шрифта
SetFont fntArial ;активация шрифта
; вычисление центра экрана :
CenterMapX = GrWidth/2 ;половина ширины экрана
CenterMapY = GrHeight/2 ;половина высоты экрана
w = 40 ;ширина тайла
h = 20 ;высота тайла
tilex =10 ;кол-во тайлов по горизонтали
tiley = 5 ;кол-во тайлов по вертикали
pw = w/4*3 ;параметр смещения тайлов по горизонтали
h2 = h/2 ;половина высоты тайла
;позиция камеры :
CamX =0
CamY =0
Dim Map( tilex+1 , tiley+1 )
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
CreateImages() ;создаём или загружаем изображения , анимированые изображения
;SaveMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer() ;устанавливаем задний буффер
;__________ Main programm _____________________________________________________________________
While Not KeyHit(1) ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112 ;цвет очистки экрана
Cls ;очистка экрана
mx# = MouseX() : my# = MouseY() ; координаты мыши
DrawMap() ;прорисовываем карту
DrawMenu() ;прорисовка меню в игре
DrawTiles()
KeyMouse() ;события мыши , клавиатуры
Text mx,my,"^" ;отображает положение курсора
;__________ Info _____________________________________________________________________
Info()
;______________________________________________________________________________
Flip ; Меняем буфер
Wend
FreeFont fntArial ; удаляем шрифт
End
;_______________________________________________________________________________
Function DrawTiles()
Color 120,120,122
Rect 620 , 30 ,150 , 240 ,1
Color 0 , 109 , 39
Rect 620 , 30 ,150 , 240 ,0
DrawImage image0,624 , 34
DrawImage image1,624 , 34*2
DrawImage image2,624 , 34*3
DrawImage image3,624 , 34*4
Color 255,255,255
Text 664 , 34," - трава"
Text 664 , 34*2," - дерево"
Text 664 , 34*3," - стена"
Text 664 , 34*4," - вода"
Color 120,120,122
Rect 625 ,175 ,120 , 20 ,1
Color 0 , 109 , 39
Rect 625 , 175 ,120 , 20 ,0
Color 255,255,255
Text 635 , 177," Сохранить карту"
End Function
;_______________________________________________________________________________
Function Info()
Text 100 ,525 ,"kx : "+kx+" ky :"+ky+" oldx : "+oldx +" oldy : "+oldy;+" ix : "+ix +" jy : "+jy
Text 100 ,540 ," U : "+sxx+" V :"+syy
Text 100 ,555 ," Mouse X : "+xx+" Mouse Y :"+yy
Text 100 ,575 ," sel : "+sel;+" VY :"+my
End Function
;_______________________________________________________________________________
Function KeyMouse()
If mx < 600 Then
If MouseDown(2) Then mouseSelect = False : sel = 0 ; сброс выбора ячейки
If MouseDown(1) Then ; выбор ячейки
oldx = kx : oldy = ky ; старые координаты мыши
sx# =Floor# (mx# /(w+0.15) * 4/3 - 0.15) ; вычисление номера ячейки по горизонтали
sy# =Floor# ( my# /h - (sx# Mod 2)/2 ) ; вычисление номера ячейки по вертикали
sxx = Int (sx#) ; округление результата
syy = Int (sy#)
xx = sxx * pw ; вычисление координат ячейки по номеру ячейки
yy = syy * h +(sxx Mod 2)*h2
mouseSelect = True
Else
kx = xx : ky = yy ; новые координаты мыши
EndIf
Else
For qq = 1 To 4
If RectsOverlap ( 624 , 34*qq , w , h , mx , my , 2 , 2) Then
Color 255,69,0
Rect 624 , 34*qq , w , h ,0
Color 255,255,255
If MouseDown(1) Then
mouseSelect = False
sel = qq
EndIf
End If
Next
If RectsOverlap ( 625 , 175 ,120 , 20 , mx , my , 2 , 2) Then
Color 255,69,0
Rect 625 , 175 ,120 , 20 ,0
Color 255,255,255
If MouseDown(1) Then
SaveMap( "D:\vitalii\blitz\гексы\maps2.txt")
EndIf
EndIf
End If
End Function
;_______________________________________________________________________________
Function DrawMap()
For j=0 To tiley
For i=0 To tilex
x = i * pw ; вычисление координат ячейки по номеру
y = (j * h +(i Mod 2)*h2)
If RectsOverlap (0 , 0 , 600 , 500 , x , y , w , h ) Then ; прорисовывает только то ,что попадает в зону видимости экрана
DrawImage gex, x +CamX , y +CamY ; прорисовывает гексы
If Map(i , j) <= 0
DrawImage image0, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "0"
Else If Map(i , j) = 1
DrawImage image1, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "1"
Else If Map(i , j) = 2
DrawImage image2, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "2"
Else If Map(i , j) = 3
DrawImage image3, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "3"
Else If Map(i , j) = 4
;DrawImage gex_water, x +CamX , y +CamY
Text x +CamX +10, y +CamY +5 , "4"
EndIf
Select sel
Case 0
Case 1
DrawImage image0, mx +CamX , my +CamY
Case 2
DrawImage image1, mx +CamX , my +CamY
Case 3
DrawImage image2, mx +CamX , my +CamY
Case 4
DrawImage image3, mx +CamX , my +CamY
End Select
If mouseSelect = True Then ;если ячейка выбрана рисовать ...
If sxx >-1 And sxx< tilex+1 And syy>-1 And syy< tiley+1 Then
Map(sxx , syy) = sel - 1
EndIf
End If
End If
Next
Next
End Function
;_______________________________________________________________________________
Function SaveMap(file$)
fileout = WriteFile(file$)
For j=1 To tiley+1
For i=1 To tilex+1
String$ = String$+ Str (Map(i-1 , j-1))
Text 635 , 200,"Идёт сохранение . . . "
Next
Next
WriteLine( fileout, String$)
Text 635 , 200,"Сохранено !"
CloseFile( fileout )
End Function
;_______________________________________________________________________________
Function DrawMenu()
Color 0 , 109 , 39
Rect 0 , 0 , 600 , 500 ,0
Color 139 , 134 , 78
Rect 600 , 0 , 200 , 500 ,1
Rect 0 , 500 , 800 , 100 ,1
Color 255,255,255
End Function
;_______________________________________________________________________________
Function CreateImages()
gex = CreateImage(w+1,h+1) ; создаём изображение гекса
SetBuffer ImageBuffer(gex)
Color 238,118,0
Line 0,h/2 ,w/4,0
Line w/4,0 ,pw,0
Line pw,0 ,w,h/2
Line w,h/2 ,pw,h
Line pw,h ,w/4,h
Line w/4,h ,0,h/2
gex_activ = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_activ)
Color 102,5,0
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image0 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image0)
Color 50,205,50
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image3 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image3)
Color 0,206,209
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image2 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image2)
Color 205,197,191
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image1 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image1)
SeedRnd MilliSecs()
Color 0,197,90
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
For q1 = 0 To Rnd(12,46)
Color 5,Rnd(40,180),Rnd(40,180)
Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
Next
Color 255,255,255
End Function
|
(Offline)
|
|
01.07.2012, 22:57
|
#23
|
|
Ответ: гексогональная тайловая карта(изометрия)
Аффтар посмотри как это дело реализовано в БМаксовском фрэймворке DW Lab. - там все с открытыми исходниками.
|
|
|
02.07.2012, 06:22
|
#24
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Аффтар посмотри как это дело реализовано в БМаксовском фрэймворке DW Lab. - там все с открытыми исходниками.
|
Так я ж написал что постепенно буду усложнять ,править код ,видоизменять
Кстати , в основной программе нужно поменять путь :
LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")
например на:
LoadMap( "maps2.txt")
А то будет выдавать что файла не существует
|
(Offline)
|
|
02.07.2012, 06:56
|
#25
|
Гигант индустрии
Регистрация: 13.09.2008
Сообщений: 2,893
Написано 1,185 полезных сообщений (для 3,298 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Полный путь не обязательно писать. Можно написать путь из папки игры. Например: "map\maps2.txt"
|
(Offline)
|
|
02.07.2012, 08:04
|
#26
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
А я о чём !
|
(Offline)
|
|
02.07.2012, 13:57
|
#27
|
|
Ответ: гексогональная тайловая карта(изометрия)
Абсолютные пути, конечно не допустимы, как было сказано - используй относительные пути к файлам.
Так вот я и посоветовал, прежде чем что то усложнять - посмотри как это делается возможно появятся новые идеи и мысли по реализации.
|
|
|
02.07.2012, 18:51
|
#28
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Спасибо за совет ,в принципе у меня особой цели или идеи нет ,так баловство. Ну и конечно интересно . А вообще , думаю тем кто начинает или продолжает Блиц игрострой ,тоже интересно. Тем более по гексагонам тема на русском мало освещена , зато по ромбам инфы в достатке.
Так отдельная просьба присмотреться к этой теме может чем поможешь али посоветуешь.
|
(Offline)
|
|
05.07.2012, 08:41
|
#29
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Добавил скроллинг по карте ,мини карту :
Type map
Field i , j , x , y , tile
End Type
Global w , h , w2 , h2 , tilex , tiley , camx , camy , cmapx , cmapy , speed# , cx , cy , posx , posy , positionscrollx , positionscrolly , plx , ply
Global sx# , sy# , sxx , syy , mx# , my# , xx , yy , kx , ky , oldx , oldy , sel , mouseSelect , ssx ,ssy ,f
Global plxx , plyy
Global gex , image1 , image2 , image3 , image4
Const GrWidth = 800 ;ширина экрана
Const GrHeight = 600 ;высота экрана
;_______________________________________________________________________________
Graphics GrWidth , GrHeight , 32 , 2
fntArial=LoadFont("Arial",14) ;загрузка шрифта с указанием размера шрифта
SetFont fntArial ;активация шрифта
w = 40 ;ширина тайла
h = 20 ;высота тайла
tilex = 32 ;21 ;кол-во тайлов по горизонтали
tiley = 32 ;31 ;кол-во тайлов по вертикали
w2 = w/4*3 ;параметр смещения тайлов по горизонтали
h2 = h/2 ;половина высоты тайла
;вычисление центра карты
posx = (tilex * w)/2 -120
posy = (tiley * h)/2 -10
;вычисление центра экрана :
cmapx = GrWidth/2 - 100 ;половина ширины экрана
cmapy = GrHeight/2 ;половина высоты экрана
;позиция камеры :
camx =0
camy =0
;позиция фокуса камеры:
positionscrollx = 510
positionscrolly = 310
CreateImages()
SetBuffer BackBuffer() ;устанавливаем задний буффер
s.map = CreateMap()
MapScroll()
;__________ Main programm _____________________________________________________________________
FlushMouse
MoveMouse 300,300
While Not KeyHit(1) ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112 ;цвет очистки экрана
Cls ;очистка экрана
mx# = MouseX() : my# = MouseY() ; координаты мыши
SaveMap()
LoadMap()
KeyMouse()
MapScroll()
MouseScroll()
MouseSelTile()
DrawMap()
DrawMenu()
DrawMiniMap()
MouseInMiniMap()
MouseSelect()
Info()
Flip ; Меняем буфер
Wend
FreeFont fntArial ; удаляем шрифт
End
;_______________________________________________________________________________
Function LoadMap()
If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ 145, 100 ,25 ) And MouseDown(1) Then
filein = ReadFile("karta.txt")
mapStr$ = ReadLine$(filein)
f=0
For s.map = Each map
Text 606 - camx , (180+ 145) -camy , "Идёт загрузка . . . "
s\tile = Int( Mid (mapStr$, f+1 , 1))
f = f+1
Next
CloseFile( filein)
Text 606 - camx , (180+ 145) -camy , "Загружено !"
EndIf
End Function
;_______________________________________________________________________________
Function SaveMap()
If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ 120, 100 ,25 ) And MouseHit(1) Then
fileout = WriteFile("karta.txt")
For s.map = Each map
Text 606 - camx , (180+ 125) -camy , "Идёт сохранение . . . "
String$ = String$+ Str (s\tile)
Next
WriteLine( fileout, String$)
CloseFile( fileout )
Text 606 - camx , (180+ 125) -camy , "Сохранено !"
EndIf
End Function
;_______________________________________________________________________________
Function MouseSelect()
If sel = 1 Then DrawImage image1, mx -camx , my -camy
If sel = 2 Then DrawImage image2, mx -camx , my -camy
If sel = 3 Then DrawImage image3, mx -camx , my -camy
If sel = 4 Then DrawImage image4, mx -camx , my -camy
End Function
;_______________________________________________________________________________
Function MouseSelTile()
If mx > 600 Then
For qs = 1 To 4
If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ qs*h, w ,h ) Then
If MouseDown(1) Then
sel = 0
sel = qs
EndIf
End If
Next
End If
Plot mx - camx, my -camy
End Function
;_______________________________________________________________________________
Function MouseInMiniMap()
If mx > 600 Then
If RectsOverlap (mx , my , 1 , 1 , 606 , 31 , 148 , 148 ) Then
If MouseHit(1) Then
plx = (mx -606)
ply = (my -31)
plxx = plx *6.6
plyy = ply *4.5
positionscrollx = plxx
positionscrolly = plyy
EndIf
End If
End If
Plot mx - camx, my -camy
End Function
;_______________________________________________________________________________
Function DrawMiniMap()
Color 0 , 0 , 0
Rect 605 - camx , 30 -camy, 150 , 150 ,1
Color 0 , 109 , 39
Rect 605 - camx , 30 -camy, 150 , 150 ,0
Color 0 , 109 , 39
Rect 606 - camx , (180+ 120) -camy , 100 , 25 ,1
Color 0 , 109 , 39
Rect 606 - camx , (180+ 145) -camy , 100 , 25 ,1
Color 255,255,255
Text 606 - camx , (180+ 120) -camy , " Сохранить карту "
Text 606 - camx , (180+ 145) -camy , " Загрузить карту "
Color 255,255,255
End Function
;_______________________________________________________________________________
Function DrawMenu()
Color 0 , 109 , 39
Rect 0 -camx , 0 -camy, 600 , 600 ,0
Color 139 , 134 , 78
Rect 600 - camx , 0 -camy, 200 , 600 ,1
Color 255,255,255
DrawImage image1, 606 -camx , 180+ (h*1) -camy
DrawImage image2, 606 -camx , 180+ (h*2) -camy
DrawImage image3, 606 -camx , 180+ (h*3) -camy
DrawImage image4, 606 -camx , 180+ (h*4) -camy
End Function
;_______________________________________________________________________________
Function MouseScroll()
If mx# > 25 Then positionscrollx = positionscrollx + 5
If positionscrollx > 705 Then positionscrollx = 705 ;positionscrollx = positionscrollx - 20
If mx# < GrWidth - 25 Then positionscrollx = positionscrollx - 5
If positionscrollx < 300 Then positionscrollx = 300 ;positionscrollx = positionscrollx + 20
If my# > 25 Then positionscrolly = positionscrolly + 5
If positionscrolly > 380 Then positionscrolly = 380 ;positionscrolly = positionscrolly - 20
If my# < GrHeight - 25 Then positionscrolly = positionscrolly - 5
If positionscrolly < 295 Then positionscrolly = 295 ;positionscrolly = positionscrolly + 20
Origin camx , camy
End Function
;_______________________________________________________________________________
Function MapScroll()
camx = camx + ((( -(positionscrollx ) + cmapx ) - camx ) * 0.09 )
camy = camy + ((( -(positionscrolly ) + cmapy ) - camy ) * 0.09 )
End Function
;_______________________________________________________________________________
Function DrawMap()
For s.map = Each map
If RectsOverlap (0 - camx , 0 - camy , 600 , 600 , s\x , s\y , w , h ) Then ; прорисовывает только то ,что попадает в зону видимости экрана
DrawImage gex , s\x - cx , s\y - cy
If s\tile <= 1 Then DrawImage image1 , s\x - cx , s\y - cy
If s\tile = 2 Then DrawImage image2 , s\x - cx , s\y - cy
If s\tile = 3 Then DrawImage image3 , s\x - cx , s\y - cy
If s\tile = 4 Then DrawImage image4 , s\x - cx , s\y - cy
; Text s\x - cx + 5 , s\y - cy + 5 , s\i +" "+s\j+" "+s\tile
If mouseSelect = True Then
If s\x = xx And s\y = yy Then
s\tile = sel
EndIf
EndIf
EndIf
Next
Text posx , posy ,"x"
Text cmapx -camx , cmapy -camy ,"+"
End Function
;_______________________________________________________________________________
Function KeyMouse()
If MouseDown(2) Then mouseSelect = False : sel = 0 ; сброс выбора ячейки
If MouseDown(1) Then ; выбор ячейки
If mx# < 600
oldx = kx : oldy = ky ; старые координаты мыши
sx# =Floor# (( mx# -camx ) / (w+0.15) * 4/3 - 0.15 ) ; вычисление номера ячейки по горизонтали
sy# =Floor# (( my# -camy ) / h - (sx# Mod 2)/2 ) ; вычисление номера ячейки по вертикали
sxx = Int (sx#) ; округление результата
syy = Int (sy#)
xx = sxx * w2 ; вычисление координат ячейки по номеру ячейки
yy = syy * h +(sxx Mod 2)*h2
mouseSelect = True
EndIf
Else
kx = xx : ky = yy ; новые координаты мыши
EndIf
End Function
;_______________________________________________________________________________
Function CreateMap.map()
For j=0 To tiley
For i=0 To tilex
x = i * w2 ; вычисление координат ячейки по номеру
y = j * h +(i Mod 2)*h2
Local this.map = New map
this\x = x
this\y = y
this\i = i
this\j = j
this\tile = 0
Next
Next
Return this.map
End Function
;_______________________________________________________________________________
Function CreateImages()
gex = CreateImage(w+1,h+1) ; создаём изображение гекса
SetBuffer ImageBuffer(gex)
Color 238,118,0
Line 0,h2 ,w/4,0
Line w/4,0 ,w2,0
Line w2,0 ,w,h2
Line w,h2 ,w2,h
Line w2,h ,w/4,h
Line w/4,h ,0,h2
gex_activ = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(gex_activ)
Color 102,5,0
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image1 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image1)
Color 50,205,50
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image4 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image4)
Color 0,206,209
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image3 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image3)
Color 205,197,191
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
image2 = CreateImage(w+1,h+1) ; создаём изображение активной ячейки
SetBuffer ImageBuffer(image2)
SeedRnd MilliSecs()
Color 0,197,90
Rect (w/4 +0.15) , 0 , (w/2 +0.15) , h ,1
For q1 = 0 To Rnd(12,46)
Color 5,Rnd(40,180),Rnd(40,180)
Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
Next
Color 255,255,255
End Function
;_______________________________________________________________________________
Function Info()
Text 620 - camx ,525 -camy -40 ," camx : "+camx +" camy :"+camy
Text 620 - camx ,540 -camy -40 ," U : "+sxx+" V :"+syy
Text 620 - camx ,555 -camy -40 ," Mouse X : "+kx+" Mouse Y :"+ky
Text 620 - camx ,575 -camy -40 ," Oldx : "+oldx +" Oldy : "+oldy
Text 620 - camx ,590 -camy -40 ," sel : "+sel+" mouseSelect :"+mouseSelect
; Text 620 - camx ,605 -camy -40 ," plxx : "+plxx +" plyy :"+plyy;
; Text 620 - camx ,510 -camy -40 ," poscrollx : "+positionscrollx +" poscrolly :"+positionscrolly
; Text 620 - camx ,525 -camy -40 ," posx : "+posx +" posy :"+posy
; Text 620 - camx ,540 -camy -40 ," cmapx : "+cmapx +" cmapy :"+cmapy
End Function
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
05.07.2012, 08:52
|
#30
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: гексогональная тайловая карта(изометрия)
Причём по мини карте можно кликнуть . Перемещение карты ,так же осуществляется мышью , достаточно подвести мышь к краям экрана .
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 02:46.
|