конструктор лабиринтов на gambas

Конструктор лабиринтов - простая программа на gambas .

Эта статья содержит короткие пояснения по листингу моей программы "Конструктор лабиринтов" и естественно архив с самой программой. Для запуска игры необходимо распаковать проект и открыть его в gambas. Упакованный проект вместе с одним готовым лабиринтом: LabirintConstr.tar.gz.
Загружаем, распаковываем, запускаем проект в gambas-е и видим :

Чтобы наблюдать на своем мониторе точно такую - же картинку нажмите на кнопочку загрузить и выберите файл labirint01 этот лабиринтик я сделал в редакторе за 1 час. Нажимая на кнопочки Симмет.X и Симмет.Y из него легко можно получить еще 3 штуки. Зеленая клеточка- вход в лабиринт , красная выход. Лабиринт представляет собой двумерный массив 40 на 34 и сохраняется на диск в виде бинарного файла. Сначала я думал запихать в одну прогу и редактор и просмотровщик лабиринтов, но потом решил сделать отдельно редактор , а игры можно к нему написать разные : 2D, 3D , лабиринт в темную и т.д. и не обязательно на gambas-е.
Кстати, для тех у кого такое же больное воображение, как у меня подскажу, что этот редактор довольно легко переделывается в редактор уровней простенького шутера вроде Doom ( если это кого-то интересует пишите мне на kostyalamer@yandex.ru , можно будет что-нибудь подобное соорганизовать ). На этом я здесь закончу всю лирику (надеюсь зачем нужен редактор вы уже поняли) и дам несколько пояснений по листингу программы.
Как я уже говорил лабиринт является массивом lab[40, 34] ( соответственно 40 клеток по X и 34 по Y ), причем если lab[x ,y] = 0 поле свободно т.е. проход, если 1 - стенка , 2 - вход , 3 - выход .
Блок в начале Form_Open с координатами и размерами компанентов формы, хоть и дублирует визуальный редактор формы, но необходим для корректной работы программы с разными менеджерами окон (без него вид у работающей проги в кедах и WM-е был бы совершенно разный - , будете программировать обращайте на это внимание !!!)
Процедуры:
Setka - разлиновывает рабочее поле редактора.
Zero - обнуляет массив лабиринта
DrA1_DblClick - основная процедура редактора (двойной клик мышкой на области редактирования) в зависимости от положения флажка переключателя стена / вход / выход (переменная rejim ) записывает в массив нужное значение и отображает на рисунке соответствующий квадратик. Для входа / выхода процедура немного усложнена , она сохраняет текущее значение ячейки (только стена или проход ) в буфер и если вы поставите вход или выход в другом месте лабиринта то по старым координатам из буфера будет востановлена стена или проход (обработчик для параноидального случая с постановкой входа на выход и наоборот я не писал).
Scaner - сканирует массив и результаты отрисовывает на поле редактирования.
Все остальное довольно просто и понятно из коментариев к листингу.
Разные "защиты от дурака" я в программу не вставлял ( единственное исключение проверка на размер файла при загрузке лабиринта ), меня и так все устраивает, но если сильно надо могу дописать .
Из этого листинга можете надергать довольно много готовых процедур для написания игры лабиринт (2D).
Заранее извиняюсь за неоптимизированный код и ламерский стиль программирования !

Для тех кому лень возиться с архивом , но интересно взглянуть на листинг, привожу его ниже:

' Gambas class file
PUBLIC i AS Integer
PUBLIC j AS Integer
PUBLIC xcur AS Integer
PUBLIC ycur AS Integer
lab[40, 34] AS Integer
PUBLIC FileSize AS Integer       ' Bytes
PUBLIC rejim AS Integer = 0 'Режим работы редактора
PUBLIC vhx AS Integer = 0 'координаты входа
PUBLIC vhy AS Integer = 33
PUBLIC vihx AS Integer = 39 'координаты выхода
PUBLIC vihy AS Integer = 0
PUBLIC bufvhod AS Integer = 0  
PUBLIC bufvihod AS Integer = 0
PUBLIC help AS Integer = 1

PUBLIC SUB _new()
 Zero
END

PUBLIC SUB Form_Open()
FMain.Height = 752
FMain.Width = 819
ButNew.Y = 693
ButNew.X = 9
ButLoad.Y = 693
ButLoad.X = 120
ButSimx.X = 230
ButSimx.y = 693
ButSimy.X = 230
ButSimy.y = 723
Lab1.x = 340
Lab1.y = 693
RBut1.y = 692
RBut1.x = 600
RBut2.y = 712
RBut2.x = 600
RBut3.y = 732
RBut3.x = 600
ButSave.X = 712
ButSave.Y = 693
ButHelp.X = 9
ButHelp.Y = 723
ButExit.X = 712
ButExit.Y = 723
DrA1.Height = 681
DrA1.Width = 801
IF help = 1 THEN 
DrA1.Visible = TRUE
TextL1.Visible = FALSE

Setka
Scaner
ELSE 
DrA1.Visible = TRUE
TextL1.Visible = TRUE

ENDIF
END





PUBLIC SUB Setka() 'создает новое игровое поле
  DIM x1, x2, y1, y2, i, j AS Integer
  DrA1.Clear()
  DrA1.Visible = TRUE 
  Draw.Begin(DrA1)
  FOR i = 0 TO 800 STEP 20
   Draw.Line(i, 0, i, 680)
  NEXT 
  FOR j = 0 TO 800 STEP 20
   Draw.Line(0, j, 800, j)
  NEXT
  Draw.End

END

PUBLIC SUB Zero() 'обнуление массива лабиринта
DIM i AS Integer
DIM j AS Integer
  
  FOR i = 0 TO 39
  FOR j = 0 TO 33
  lab[i, j] = 0
  NEXT 
  NEXT 
 
  
END


PUBLIC SUB ButExit_Click()
  ME.Close
END

PUBLIC SUB ButSave_Click()
 
DIM i AS Integer
DIM j AS Integer
DIM hFile AS File
IF Dialog.SaveFile() THEN RETURN 
hFile = OPEN Dialog.Path FOR READ WRITE CREATE WATCH

  FOR i = 0 TO 39
  FOR j = 0 TO 33
    WRITE #hFile, lab[i, j]
  NEXT 
  NEXT 
  
CLOSE #hFile
 
END

PUBLIC SUB ButLoad_Click()
DIM q AS Integer
DIM i AS Integer
DIM j AS Integer
DIM hFile AS File
IF help = 0 THEN RETURN
IF Dialog.OpenFile() THEN RETURN
hFile = OPEN Dialog.Path FOR READ  
    FileSize = Stat(Dialog.Path).Size
  IF FileSize <> 5440 THEN RETURN  'неправильная длина файла
 SEEK #hFile, 0
 
   FOR i = 0 TO 39
   FOR j = 0 TO 33
     READ #hFile, lab[i, j]
   NEXT 
  NEXT 

CLOSE #hFile
Setka
Scaner
END



PUBLIC SUB DrA1_DblClick()

DIM xknew AS Integer
DIM yknew AS Integer
xcur = Mouse.ScreenX
ycur = Mouse.ScreenY 
IF help = 0 THEN RETURN 

xknew = (xcur - DrA1.ScreenX) \ 20 
yknew = (ycur - DrA1.ScreenY) \ 20
Draw.Begin(DrA1) 
SELECT CASE rejim
 CASE 0 '------------------ Стена -------------------
      
     IF lab[xknew, yknew] = 0 THEN
       lab[xknew, yknew] = 1
       Draw.FillColor = Color.DarkGray
       Draw.ForeColor = Color.DarkGray
     ELSE
       lab[xknew, yknew] = 0
       Draw.FillColor = Color.TextBackground
       Draw.ForeColor = Color.TextBackground
     ENDIF  
       
  CASE 2  '------------------ Вход --------------------
  
       lab[vhx, vhy] = bufvhod
       IF bufvhod = 1 THEN
       Draw.FillColor = Color.DarkGray
       Draw.ForeColor = Color.DarkGray
       ELSE 
       Draw.FillColor = Color.TextBackground
       Draw.ForeColor = Color.TextBackground
       ENDIF 
       
       Draw.FillStyle = Fill.Solid
       Draw.Rect(((vhx * 20) + 2), ((vhy * 20) + 2), 17, 17)
       bufvhod = lab[xknew, yknew]
       lab[xknew, yknew] = 2
       Draw.FillColor = Color.DarkGreen
       Draw.ForeColor = Color.DarkGreen
       
       vhx = xknew
       vhy = yknew
  CASE 3  '------------------ Выход ------------------
       lab[vihx, vihy] = bufvihod
       IF bufvihod = 1 THEN
       Draw.FillColor = Color.DarkGray
       Draw.ForeColor = Color.DarkGray
       ELSE 
       Draw.FillColor = Color.TextBackground
       Draw.ForeColor = Color.TextBackground
       ENDIF 
        Draw.FillStyle = Fill.Solid
        Draw.Rect(((vihx * 20) + 2), ((vihy * 20) + 2), 17, 17)
       bufvihod = lab[xknew, yknew]
       lab[xknew, yknew] = 3
       Draw.FillColor = Color.DarkRed
       Draw.ForeColor = Color.DarkRed
       vihx = xknew
       vihy = yknew

END SELECT 
Draw.FillStyle = Fill.Solid
Draw.Rect(((xknew * 20) + 2), ((yknew * 20) + 2), 17, 17)

Draw.End


END

PUBLIC SUB Scaner()  'рисует лабиринт из массива
DIM i AS Integer
DIM j AS Integer
  Draw.Begin(DrA1)
  Draw.FillStyle = Fill.Solid
  FOR i = 0 TO 39
    FOR j = 0 TO 33
  
     SELECT CASE lab[i, j] 
       CASE 1 
        Draw.FillColor = Color.DarkGray
        Draw.ForeColor = Color.DarkGray
       CASE 0
        Draw.FillColor = Color.TextBackground
        Draw.ForeColor = Color.TextBackground
       CASE 2
        Draw.FillColor = Color.DarkGreen
        Draw.ForeColor = Color.DarkGreen 
        vhx = i
        vhy = j
       CASE 3 
        Draw.FillColor = Color.DarkRed
        Draw.ForeColor = Color.DarkRed
        vihx = i
        vihy = j
       END SELECT 

     Draw.Rect(((i * 20) + 2), ((j * 20) + 2), 17, 17)
    NEXT 
  NEXT   
  
Draw.End  
END


PUBLIC SUB ButNew_Click()
 IF help = 0 THEN RETURN
 Zero
 Form_Open
END

PUBLIC SUB RBut1_Click()  'Стена
  rejim = 0
END

PUBLIC SUB RBut2_Click()  'Вход
  rejim = 2
END

PUBLIC SUB RBut3_Click()  'Выход
  rejim = 3
END

PUBLIC SUB ButSimx_Click() 'Отразить по X
DIM buf1 AS Integer
DIM buf2 AS Integer
DIM i AS Integer
DIM j AS Integer
  IF help = 0 THEN RETURN
  FOR i = 0 TO 19
  FOR j = 0 TO 33
  buf1 = lab[i, j]
  buf2 = lab[39 - i, j]
  lab[i, j] = buf2
  lab[39 - i, j] = buf1
  NEXT 
  NEXT 
Setka
Scaner  

END

PUBLIC SUB ButSimy_Click() 'Отразить по Y

DIM buf1 AS Integer
DIM buf2 AS Integer
DIM i AS Integer
DIM j AS Integer
  IF help = 0 THEN RETURN
  FOR i = 0 TO 39
  FOR j = 0 TO 16
  buf1 = lab[i, j]
  buf2 = lab[i, 33 - j]
  lab[i, j] = buf2
  lab[i, 33 - j] = buf1
  NEXT 
  NEXT 
Setka
Scaner  
  

END

PUBLIC SUB ButHelp_Click() 'Справка
 IF help = 0 THEN 
    help = 1
     ELSE 
    help = 0
  ENDIF 
 Form_Open()
END

Успехов Вам братья-пингвины , или как говорит г-н Столмен : " Счастливого хака ! "

kostyalamer 25.04.2009
< [ на главную ]