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