|
ПроЭктировщик
Регистрация: 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
|