В первой части мы познакомились с архитектурным паттерном Entity-Component-System, часто используемым в разработке игр, и металингвистической парадигмой программирования, заключающейся в построении и использовании собственных языков, наиболее полно и точно описывающих предметную область создаваемой программы. На сей раз мы используем эти приёмы для создания небольшой, но полноценной игры на Common Lisp в жанре dungeon crawler (рус. надмозг. "подземное ползание") с пользовательским интерфейсом и рассмотрим на её примере системный дизайн реального игрового приложения с использованием ECS.

TL;DR: готовую к запуску демонстрацию (бинарники под все распространённые ОС) и её исходный код можно найти на github.

---

Освежив при необходимости знания синтаксиса Common Lisp с помощью краткого руководства Изучите X за Y минут, где X=Common Lisp или более подробного "Практическое использование Common Lisp", и предполагая, что у нас уже настроено рабочее окружение для геймдева на Common Lisp по инструкциям из первой части, обновим локальные версии установленных пакетов, запустив REPL компилятора SBCL командной в терминале sbcl и передав ему на исполнение следующий фрагмент кода:

(ql-util:without-prompting (ql:update-all-dists))

Затем, как и в прошлый раз, начнём с использования cookiecutter-шаблона:

cookiecutter gh:lockie/cookiecutter-lisp-game

Ответим утвердительно на вопрос cookiecutter "Is it okay to delete and re-download it?" для того, чтобы скачать обновлённую версию шаблона игры, и ответим на вопросы о новом проекте следующим образом:

full_name (Your Name): Alyssa P. Hacker
email (your@e.mail): alyssa@domain.tld
project_name (The Game): ECS Tutorial 2
project_slug (ecs-tutorial-2):
project_short_description (A simple game.): cl-fast-ecs framework tutorial.
version (0.0.1):
Select backend
    1 - liballegro
    2 - raylib
    3 - SDL2
    Choose from [1/2/3] (1): 1

Снова добавим ссылку на каталог проекта в наш локальный репозиторий пакетов Quicklisp:

ln -s $(pwd)/ecs-tutorial-2 $HOME/quicklisp/local-projects/  # для UNIX-подобных ОС

mklink /j %USERPROFILE%\quicklisp\local-projects\ecs-tutorial-2 ecs-tutorial-2  # для Windows
mklink /j %USERPROFILE%\portacle\projects\ecs-tutorial-2 ecs-tutorial-2  # для Windows при использовании Portacle

Сразу увеличим в коде размер игрового окна до 1280⨉800, чтобы покрыть бо́льшую площадь подземелья, заменив в начале файла src/main.lisp значения констант +window-width+ и +window-height+ (в Common Lisp принято ставить знак + в начале и конце имён констант, чтобы в коде было сразу понятно, что это не переменная — это совершенно корректно синтаксически):

(define-constant +window-width+ 1280)
(define-constant +window-height+ 800)

И, наконец, убедимся в работоспособности нового проекта, запустив sbcl и передав ему следующий код на выполнение:

(ql:quickload :ecs-tutorial-2)
(ecs-tutorial-2:main)

В результате мы увидим чёрное окно нужного разрешения с одиноким счётчиком FPS:

Подземелья

Чтобы дать возможность игроку ползать по подземельям, первым делом нам понадобится карта подземелья.

Для её создания воспользуемся замечательным опенсорсным редактором карт Tiled, который является не только кроссплатформенным, но и кросс-движковым, так как сохраняет данные карт в тривиальном XML, который поддерживается буквально везде, включая, конечно же, Common Lisp. Более того, существует библиотека cl-tiled, загружающая файлы в формате Tiled в виде Lisp-объектов, которой мы будем пользоваться.

Для быстрого старта можно начать с нехитрой карты подземелья, использующую комплект элементов карты (т.н. тайлсет) Dungeon Tileset II - Extended, которая выглядит в редакторе примерно следующим образом:

Готовые файлы карты (тайлсет и файл для Tiled level1.tmx, содержащий внутри себя XML) можно скачать здесь, однако давайте разберёмся, как получить такой же результат. Сначала нужно подогнать размер тайлсета, так как 16⨉16 пикселей — это мелковато. Увеличим его вдвое, скачав по ссылке архив dungeontiles-extended v1.1.zip (можно задонатить автору тайлсета, если есть возможность, а можно скачать бесплатно, нажав ссылку "No thanks, just take me to the downloads"), распаковав файл dungeontileset-extended.png из архива в каталог Resources нашего проекта и обработав его с помощью ImageMagick следующей командой:

convert dungeontileset-extended.png -filter box -resize 200% dungeontileset-extended2.png

После этого мы можем создать файл карты, запустив Tiled и сначала выбрав пункт меню Файл ? Новый ? Новый проект... и сохранив проект карты в каталоге Resources, например, под именем dungeon.tiled-project, а затем Файл ? Новый ? Новая карта..., выбрав в диалоге создания карты следующие параметры:

После чего можно сохранить карту в том же каталоге Resources под именем, скажем, level1.tmx. Далее, нам нужно дать знать Tiled о нашем замечательном тайлсете, для этого выберем пункт меню Файл ? Новый ? Новый набор тайлов... и в открывшемся диалоге пропишем ширину и высоту тайлов, а также нажмём Обзор в разделе Изображение и выберем файл dungeontileset-extended2.png:

Получившийся тайлсет можно сохранить под предлагаемым именем dungeontileset-extended2.tsx в уже полюбившемся нам каталоге Resources.

После чего мы, наконец, можем выпустить на свободу внутреннего художника и начать переносить тайлы на пустой холст карты, выбирая их в окне Наборы тайлов:

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

После того как мы подготовили файлы карты, её можно загрузить в нашей игре. Для этого нам понадобится ряд подготовительных действий. Перво-наперво добавим в файл определения лисп-системы игры ecs-tutorial-2.asd в корне нашего проекта зависимость от библиотеки cl-tiled:

  ;; ...
  :license "MIT"
  :depends-on (#:alexandria
               #:cl-liballegro
               #:cl-liballegro-nuklear
               #:cl-tiled               ;; модифицируем здесь
               #:livesupport)
  ;; ...

Затем в этом же файле добавим отсылку на новый файл map.lisp, который также создадим в каталоге src нашего проекта:

  ;; ...
  :components ((:module "src"
                :components
                ((:file "package")
                 (:file "map")      ;; здесь
                 (:file "main"))))
  ;; ...

В этом новом файле мы будем писать код, необходимый для загрузки и отображения карты. Далее, в файле src/package.lisp добавим псевдоним для библиотеки cl-tiled, чтобы мы могли к ней обращаться в коде просто как tiled:

(defpackage #:ecs-tutorial-2
  (:use #:cl)
  (:import-from #:alexandria #:define-constant)
  (:local-nicknames (#:tiled #:cl-tiled))        ;; здесь
  (:export #:main))

Наконец, загрузим изменившееся определение нашей системы, передав в REPL следующий фрагмент кода: (ql:quickload :ecs-tutorial-2).

Теперь нас поджидает концептуальная дилемма. Дело в том, что библиотека cl-tiled возвращает результат загрузки карты в качестве объектов на основе CLOS (Common Lisp Object System, набор объектно-ориентированных механизмов языка), которые очень удобно исследовать в REPL, только взгляните на это:

Однако при использовании данных объектов непосредственно в игре мы столкнёмся с проблемой производительности, так как при работе с ними будет часто происходить диспетчеризация времени выполнения, концептуально похожая на вызов виртуальных методов в C++, а таких объектов у нас будет как минимум тысяча (40⨉25 тайлов размером 32⨉32 пикселя, чтобы замостить всё окно размером 1280⨉800). Вы можете на практике убедиться в низкой производительности такого подхода, запустив у себя следующую демонстрацию: на 12-ядерном Ryzen 5 3600 при включении отрисовки карты в функции render FPS проседает с 20000 до 600, что означает, что на неё каждый кадр затрачивается 1/600 - 1/20000 = 0.0016 с, т.е. более полутора миллисекунд, и это для карты с одним слоем размером 40⨉25 тайлов!

Для решения этой проблемы нам, конечно, придёт на помощь паттерн Entity-Component-System, который мы подробно обсуждали в первой части. Мы перенесём данные тайлов карты, любезно загруженные для нас библиотекой cl-tiled, в ECS-хранилище. Таким образом, мы не только повысим производительность за счёт устранения диспетчеризации и грамотной утилизации кэша процессора, но и сможем деконструировать задачи отображения и обработки содержимого карты на небольшие концептуально независимые куски, правильным образом определив интересующие нас данные (компоненты) и обрабатывающий их код (системы).

Начнём с добавления фреймворка cl-fast-ecs в наш проект. Добавим его в список зависимостей в файле системы ecs-tutorial-2.asd:

  ;; ...
  :license "MIT"
  :depends-on (#:alexandria
               #:cl-fast-ecs            ;; здесь
               #:cl-liballegro
               #:cl-liballegro-nuklear
               #:cl-tiled
               #:livesupport)
  ;; ...

...и снова подгрузим изменившееся определение нашей игровой системы вызовом (ql:quickload :ecs-tutorial-2) в REPL.

Теперь в src/main.lisp мы можем модифицировать функцию init, чтобы она инициализировала фреймворк вызовом функции bind-storage, и update, чтобы она запускала зарегистрированные ECS-системы вызовом run-systems:

;; ...

(defun init ()
  (ecs:bind-storage))

;; ...

(defun update (dt)
  (unless (zerop dt)
    (setf *fps* (round 1 dt)))
  (ecs:run-systems :dt (float dt 0.0)))  ;; здесь

Далее, используя вызовы макроса ecs:defcomponent в файле src/map.lisp, добавим компонент-тег (компонент без данных) map, которым мы будем просто помечать сущность самой загруженной карты, и компонент map-tile, отвечающий за единичный тайл на карте, не забыв предварить их "шапкой", активирующей нужный нам пакет ecs-tutoral-2 (все последующие определения функций и переменных будут создаваться именно в этом пакете). Забегая вперёд, некоторые тайлы у нас будут представлять собой непроходимые персонажами препятствия, например, стены, закрытые двери и прочие твёрдые объекты, поэтому в последнем компоненте у нас будет слот булевского типа, сигнализирующий, является ли этот тайл препятствием или нет, со значением по умолчанию nil, т.е. "ложь":

(in-package #:ecs-tutorial-2)


(ecs:defcomponent map)

(ecs:defcomponent map-tile
  (obstacle nil :type boolean))

Также введём компонент parent для того, чтобы подчеркнуть тот факт, что все тайлы — это дочерние объекты сущности карты (здесь и далее мы будем использовать термин "объект" в значении "сущность с некоторыми компонентами", полностью отбрасывая ООП-шные коннотации):

(ecs:defcomponent parent
  (entity -1 :type ecs:entity :index children))

Мы будем добавлять этот компонент во все тайлы и другие объекты, загружаемые из карты, со слотом entity, равным сущности карты. Из соображений более удобного управления памятью мы хотим, чтобы все объекты на карте удалялись одним махом, когда мы удаляем сущность карты. Чтобы реализовать такую функциональность, понадобится возможность получать все дочерние объекты заданной сущности, однако делать это "в лоб" довольно накладно по времени (аж O(n), где n — количество сущностей, а их у нас будет, как мы подсчитывали выше, не менее тысячи). Поэтому мы здесь воспользуемся таким инструментом фреймворка cl-fast-ecs, как индексы, который не совсем типичен для паттерна ECS. Индекс — это любезно генерируемая фреймворком функция с названием, задаваемым аргументом index в описании слота, которая будет при вызове отвечать нам на вопрос "какие сущности имеют конкретное заданное значение в этом слоте?". Функции-индексы строятся поверх хэш-таблиц с открытой адресацией, поэтому отрабатывают за аморт. O(1), однако они не так сильно дружелюбны к кэшу, как базовые механизмы ECS. К тому же, как и в промышленных СУБД, они увеличивают накладные расходы на создание и удаление компонента по причине того, что индекс в этих случаях необходимо обновлять, поэтому не стоит злоупотреблять этим механизмом.

Мы называем функцию-индекс children, и в полном соответствии со своим названием, она будет принимать на вход сущность (напомним, что в cl-fast-ecs, как и во многих других реализациях ECS, сущности представляются целыми числами), а возвращать она будет список с сущностями, у которых слот entity в компоненте parent равен указанной, т.е. список её дочерних объектов.

Теперь для того, чтобы реализовать их автоматическое удаление, расширим вызовом ecs:hook-up в src/map.lisp перехватчик удаления сущности, *entity-deleting-hook* ECS-фреймворка анонимной функцией, которая будет проходить по списку дочерних объектов, используя функцию-индекс children и стандартный макрос dolist, и вызывать для каждого из них ecs:delete-entity:

(ecs:hook-up ecs:*entity-deleting-hook*
             (lambda (entity)
               (dolist (child (children entity))
                 (ecs:delete-entity child))))

Далее, опишем компонент, который будет отвечать за изображения — он будет хранить в себе лишь C-шный указатель на структуру ALLEGRO_BITMAP из используемой нами библиотеки промежуточного уровня liballegro:

(ecs:defcomponent image
  (bitmap (cffi:null-pointer) :type cffi:foreign-pointer))

Мы будем хранить в слоте bitmap этого компонента фрагменты исходного изображения тайлсета размером 32⨉32, созданные вызовами функции al_create_sub_bitmap.

В дальнейшем нас будет поджидать ещё одна концептуальная тонкость: с одной стороны, у нас есть тайл в тайлсете как конкретный фрагмент изображения dungeontileset-extended2.png размером 32⨉32 и опциональными кастомными свойствами (о них подробно далее), с другой стороны, этот тайл может встречаться на самой карте больше одного раза по различным координатам, например, если это повторяющаяся текстура стены или пола подземелья. В каком-то смысле это похоже на ООП: есть классы (тайлы в тайлсете), а есть экземпляры этих классов (тайлы на карте). Чтобы справиться с представлением такого рода данных в хранилище компонентов и избежать повторной загрузки изображений для каждого тайла на карте, введём понятие префаба тайла (от англ. pre-fabricated, "заранее созданный"): при загрузке тайлсета мы создадим сущности с компонентами префаба и изображения, они будут служить исключительно для хранения данных тайлов и не будут отрисовываться. Далее, каждый тайл на карте будет представляться отдельной сущностью с компонентами позиции и изображения, в который мы при загрузке будем попросту копировать данные из компонента image соответствующего тайлу префаба — в Tiled у каждого тайла в тайлсете есть уникальный числовой идентификатор. Можно не волноваться за избыточный компонент image, по сути это всего-навсего один указатель, занимающий лишние 8 байт памяти на тайл. Итак, опишем компонент префаба тайла с уникальным идентификатором:

(ecs:defcomponent map-tile-prefab
  (gid 0 :type fixnum :index map-tile-prefab :unique t))

Так как при загрузке карты нам часто придётся искать сущность префаба по нужному числовому ID, и опять-таки это O(n) по времени, мы снова добавляем здесь функцию-индекс, также называя её map-tile-prefab. Кроме того, мы прописываем для индекса аргумент unique со значением булевской истины, t, чем сообщаем фреймворку, что значения этого слота уникальны и не может быть больше одной сущности с одним конкретным значением ID. Благодаря этому функция-индекс будет возвращать не список, а одну-единственную сущность.

Кроме того, мы взаимодействуем с C-шной библиотекой liballegro для загрузки и отрисовки изображений, а C — язык с ручным управлением памятью, что также накладывает на нас обязательства по корректной утилизации ставших нам ненужными ресурсов изображений, лисповский сборщик мусора тут будет бессилен. Поэтому воспользуемся ещё одним новым механизмом фреймворка cl-fast-ecs, финализатором — это функция, которая автоматически вызывается при удалении конкретного компонента. Модифицируем определение компонента image следующим образом:

(ecs:defcomponent (image :finalize (lambda (entity &key bitmap)            ;; меняем здесь
                                     (when (has-map-tile-prefab-p entity)  ;;
                                       (al:destroy-bitmap bitmap))))       ;;
  (bitmap (cffi:null-pointer) :type cffi:foreign-pointer))

Обратите внимание, что мы удаляем структуру изображения ALLEGRO_BITMAP вызовом функции al_destroy_bitmap только в том случае, если в сущности, у которой удаляется этот компонент, также есть компонент префаба тайла — мы проверяем это вызовом сгенерированного для нас фреймворком предиката has-map-tile-prefab-p и стандартным макросом when. Таким образом мы избегаем старой доброй C-шной ошибки при работе с памятью под названием "двойное освобождение" (англ. double free), так как у нас может быть множество тайлов на карте с одним и тем же указателем на ALLEGRO_BITMAP, скопированным из общего префаба.

Наконец, определим тривиально устроенные компоненты position и size, отвечающие за положение и размер объектов в пикселях:

(ecs:defcomponent position
  (x 0.0 :type single-float)
  (y 0.0 :type single-float))

(ecs:defcomponent size
  (width  0.0 :type single-float)
  (height 0.0 :type single-float))

Обратите внимание, что liballegro, из соображений совместимости с "сырым" OpenGL, представляет экранные координаты в качестве вещественных чисел с одинарной точностью, и мы поступаем так же. Также мы, следуя за liballegro, будем считать позицией изображения координаты его верхнего левого угла.

Задуманная нами архитектура хранения данных будет выглядеть следующим образом (вертикальными прямоугольниками показаны сущности, горизонтальными — компоненты):

Теперь у нас есть все базовые компоненты, и мы можем воспользоваться макросом ecs:defsystem для определения нашей первой системы в проекте под названием render-images, которая будет отрисовывать все нужные изображения:

(ecs:defsystem render-images
  (:components-ro (position image)
   :initially (al:hold-bitmap-drawing t)
   :finally (al:hold-bitmap-drawing nil))
  (al:draw-bitmap image-bitmap position-x position-y 0))

Мы, как и в первой части, пользуемся функцией al_hold_bitmap_drawing для активации встроенной в liballegro пакетной отрисовки спрайтов, чтобы не дёргать видеокарту попусту лишними вызовами, и вызываем al_draw_bitmap для собственно вывода изображения по заданным координатам. Обратите внимание, что в соответствии с нашей задумкой, префабы не будут обрабатываться этой системой, т.к. у них будет отсутствовать компонент position.

Однако для того, чтобы было что отрисовывать, нам нужно реализовать загрузку данных карты в вышеописанные компоненты. Вот функция для этого, load-map, вместе с используемыми в ней вспомогательными функциями:

(defun load-bitmap (filename)
  (al:ensure-loaded #'al:load-bitmap (namestring filename)))

(defun tile->spec (tile bitmap map-entity)
  (let ((width  (tiled:tile-width tile))
        (height (tiled:tile-height tile)))
    (copy-list
     `((:parent :entity ,map-entity)
       (:image :bitmap ,(al:create-sub-bitmap bitmap
                                              (tiled:tile-pixel-x tile)
                                              (tiled:tile-pixel-y tile)
                                              width height))
       (:map-tile-prefab :gid ,(tiled:tile-gid tile))
       (:size :width ,(float width)
              :height ,(float height))))))

(defun load-tile-prefab (tile bitmap map-entity)
  (unless (ecs:entity-valid-p
           (map-tile-prefab (tiled:tile-gid tile) :missing-error-p nil))
    (let* ((internal-tile-spec (tile->spec tile bitmap map-entity))
           (tile-spec (ecs:spec-adjoin internal-tile-spec '(:map-tile)))
           (tile (ecs:make-object tile-spec)))
      tile)))

(defun load-tile (entity tile x y)
  (let ((prefab (map-tile-prefab (tiled:tile-gid tile))))
    (ecs:copy-entity prefab
                     :destination entity
                     :except '(:map-tile-prefab))
    (make-position entity :x (float x)
                          :y (float y))))

(defun load-map (filename)
  (let ((map (tiled:load-map filename))
        (map-entity (ecs:make-object '((:map)))))
    (dolist (tileset (tiled:map-tilesets map))
      (let ((bitmap (load-bitmap
                     (tiled:image-source (tiled:tileset-image tileset)))))
        (dolist (tile (tiled:tileset-tiles tileset))
          (load-tile-prefab tile bitmap map-entity))))
    (dolist (layer (tiled:map-layers map))
      (typecase layer
        (tiled:tile-layer
         (dolist (cell (tiled:layer-cells layer))
           (load-tile (ecs:make-entity) (tiled:cell-tile cell)
                      (tiled:cell-x cell) (tiled:cell-y cell))))))
    map-entity))

Если вы будете получать ошибки о ненайденных символах copy-entity или spec-adjoin, скорее всего, вы используете устаревшую версию cl-fast-ecs из основного репозитория Quicklisp; самую последнюю версию со всеми нужными нам фичами можно получить, установив репозиторий Lucky Lambda по инструкциям на его сайте.

Рассмотрим их код чуть подробнее.

Функция load-bitmap служит обёрткой над функцией загрузки изображения из liballegro al_load_bitmap, которая полноразмерно обрабатывает ошибки в её работе с помощью вспомогательной функции al:ensure-loaded, в том числе предоставляя возможность попробовать загрузить файл с другим именем с помощью механизма Common Lisp под названием "условия" (conditions). Про этот механизм сравнительно недавно вышла подробнейшая книга одного из видных участников сообщества лисперов «The Common Lisp Condition System» by Michał "phoe" Herda.

Функция tile->spec создаёт для заданного тайла из тайлсета список со спецификацией объекта для дальнейшей передачи в функцию make-object ECS-фреймворка. Список копируется вызовом стандартной функции copy-list, т.к. мы будем его модифицировать в дальнейшем и не хотим испортить оригинал. Мы указываем в спецификации следующие данные:

• сущность карты, переданную в функцию параметром map-entity, в качестве родительской сущности в компоненте parent;

• нужный фрагмент изображения тайлсета, полученный вызовом al_create_sub_bitmap, в качестве слота bitmap компонента image;

• в компоненте map-tile-prefab мы сохраняем глобальный ID тайла, полученный вызовом функции tile-gid из cl-tiled;

• наконец, мы указываем размер тайла в компоненте size (обратите внимание, мы могли бы захардкодить размеры тайлов, но мы делаем этот параметр динамическим, следуя духу Lisp).

Функция load-tile-prefab служит для загрузки префаба тайла. Она проверяет, не существует ли уже префаб с глобальным ID, возвращаемым функцией tiled:tile-gid, используя для этого стандартный макрос unless, созданный нами индекс map-tile-prefab (помните, поиск за O(1)) и функцию entity-valid-p. Последняя в текущей версии cl-fast-ecs просто проверяет, является ли её аргумент неотрицательным, но этого достаточно, т.к. протокол работы функций-индексов таков, что с аргументом missing-error-p, равным nil, вместо возбуждения исключительной ситуации они попросту возвращают -1. В случае, если префаб не был создан ранее, мы создаём его спецификацию вызовом ранее рассмотренной tile->spec и добавляем к ней компонент map-tile вызовом функции spec-adjoin ECS-фреймворка. Добавленная в версии 0.6.0 spec-adjoin модифицирует заданную спецификацию объекта, добавляя новый компонент, если он отсутствовал в ней до этого. Наконец, мы передаём сформированную спецификацию в функцию make-object.

Функция load-tile инициализирует объект-тайл, используя префаб как образец. Первым делом она находит по глобальному ID, возвращаемому tiled:tile-gid, соответствующий тайлу префаб вызовом уже знакомой нам функции-индекса map-tile-prefab, затем копирует все компоненты префаба, кроме собственно map-tile-prefab, в сущность тайла с помощью функции copy-entity, и, наконец, создаёт для неё компонент position с координатами тайла на карте (помните, тайлы отличаются от префабов наличием позиции).

Сама функция load-map сразу же вызывает свою тёзку, центральную функцию библиотеки cl-tiled — tiled:load-map, которая возвращает тот самый красивый подробный CLOS-объект с уже виденного нами скриншота. Затем она создаёт вызовом make-object сущность, которая будет представлять карту, кладёт её в переменную map-entity и потрошит полученный из tiled:load-map CLOS-объект, доставая из него нужные данные: во-первых, она проходит макросом dolist по списку всех тайлсетов карты, возвращаемому tiled:map-tilesets (их может быть больше одного), для каждого из них вызывая вспомогательную функцию load-bitmap для загрузки изображения тайлсета и проходя тем же dolist по его списку тайлов, загружая каждый в качестве префаба вызовом load-tile-prefab (вспомним, что тайлы в тайлсете — это не конкретные тайлы на карте, а лишь образцы таковых). Во-вторых, load-map проходится по списку слоёв тайлов (CLOS-объектам типа tiled:tile-layer, возвращённым вызовом tiled:map-layers), в каждом из которых она проходит по списку тайлов, tiled:layer-cells. Для каждого тайла на карте мы создаём свою сущность вызовом make-entity, и инициализируем все нужные в ней компоненты вызовом рассмотренной выше функции load-tile. В конечном итоге load-map возвращает сущность карты, которая будет родительской сущностью для всех тайлов и их префабов.

В том, как мы загружаем карту, есть тонкость, связанная с неявным порядком тайлов. Дело в том, что в карте Tiled может быть множество слоёв, а на этом множестве задан порядок отношения — тайлы со слоёв, которые находятся "выше", должны рисоваться поверх и закрывать собой тайлы из слоёв "ниже":

Мы выполняем это требование за счёт двух обстоятельств. Во-первых, слои в списке, возвращаемом функцией tiled:map-layers, идут ровно в том же порядке, в котором они расположены в редакторе. Во-вторых, использованная нами для создания тайлов функция make-entity из ECS-фреймворка всегда гарантированно возвращает новые сущности в возрастающем порядке (вспомним, что в концепции ECS они по сути являются обычными целыми числами, индексирующими некоторые внутренние массивы), а системы обрабатывают сущности в том же самом порядке, от самых старых до недавно созданных. Таким образом, мы будем рисовать отдельные тайлы в системе render-images в корректном порядке, совпадающем с тем, как они отображаются в редакторе.

Отметим, что реализованный нами способ работы с информацией карты, конечно, не является единственно верным, более того, многие апологеты архитектуры ECS не рекомендуют хранить каждый тайл в качестве отдельной сущности. Мы могли бы, например, при загрузке отрисовать все статичные тайлы карты в правильном порядке в буфер в памяти и просто выводить его одним махом, но это усложнило бы код и привело к новым проблемам, а для этого руководства мы выбираем самый простой из рабочих способов.

Теперь, подробно изучив функцию load-map, мы можем добавить её вызов с подходящим аргументом в функцию init в файле src/main.lisp:

(defun init ()
  (ecs:bind-storage)
  (load-map "level1.tmx"))  ;; здесь

Загрузив после этого все накопившиеся изменения в системе вызовом (ql:quickload :ecs-tutorial-2) в REPL и запустив нашу игру вызовом (ecs-tutorial-2:main), мы увидим нашу карту из редактора:

Анимации

Помимо статических изображений, Tiled также умеет хранить анимированные тайлы, с помощью которых можно немного оживить наше виртуальное подземелье, например, добавив горящие факелы или фонтаны с различными магическими субстанциями:

Чтобы добавить анимированный тайл, необходимо открыть редактор тайлсета (кнопочкой с шестерёнкой Редактировать набор тайлов в окне Наборы тайлов), выделить тайл, который будет начальным кадром анимации, и открыть редактор анимаций, нажав кнопочку с видеокамерой в тулбаре. В появившемся окне можно перетащить любые тайлы, которые должны быть частью анимации, в область слева и указать для каждого из них (или для всех разом) длительность в миллисекундах:

Однако для того, чтобы анимации отображались у нас в игре, понадобится расширить и отрефакторить её код. Начнём с того, что добавим два новых файла, common.lisp и animation.lisp в каталог src, и пропишем их в ecs-tutorial-2.asd:

  ;; ...
  :components ((:module "src"
                :components
                ((:file "package")
                 (:file "common")     ;; здесь
                 (:file "animation")  ;;
                 (:file "map")
                 (:file "main"))))
  ;; ...

В первом мы будем описывать общие для всех систем компоненты, функции и константы (отдельно предлагается оценить иронию в названии этого файла), а во втором — компоненты и системы, необходимые для функционирования анимаций.

Начнём рефакторинг с того, что перетащим из src/main.lisp в src/common.lisp константы размеров окна, не забыв начать файл со стандартной "шапки" с выбором пакета:

(in-package #:ecs-tutorial-2)


(define-constant +window-width+ 1280)  ;; не забудьте удалить из main.lisp
(define-constant +window-height+ 800)  ;;

Кроме того, переместим из src/map.lisp в src/common.lisp определения компонентов parent, position и size, а также расширение перехватчика удаления сущности *entity-deleting-hook* для удаления дочерних объектов:

;; ...

;; не забудьте удалить из map.lisp

(ecs:defcomponent parent
  (entity -1 :type ecs:entity :index children))

(ecs:hook-up ecs:*entity-deleting-hook*
             (lambda (entity)
               (dolist (child (children entity))
                 (ecs:delete-entity child))))

(ecs:defcomponent position
  (x 0.0 :type single-float)
  (y 0.0 :type single-float))

(ecs:defcomponent size
  (width  0.0 :type single-float)
  (height 0.0 :type single-float))

Теперь перетащим из src/map.lisp определение компонента image, системы render-images и функции load-bitmap в новый файл src/animation.lisp, не забыв добавить "шапку":

(in-package #:ecs-tutorial-2)


;; не забудьте удалить из map.lisp
(ecs:defcomponent (image :finalize (lambda (entity &key bitmap)
                                     (when (has-map-tile-prefab-p entity)
                                       (al:destroy-bitmap bitmap))))
  (bitmap (cffi:null-pointer) :type cffi:foreign-pointer))

(ecs:defsystem render-images
  (:components-ro (position image)
   :initially (al:hold-bitmap-drawing t)
   :finally (al:hold-bitmap-drawing nil))
  (al:draw-bitmap image-bitmap position-x position-y 0))

(defun load-bitmap (filename)
  (al:ensure-loaded #'al:load-bitmap (namestring filename)))

Закончив с рефакторингом, как водится, мы можем начать добавлять новую функциональность. На всякий случай проверив работоспособность кода, вызвав в REPL (ql:quickload :ecs-tutorial-2) и (ecs-tutorial-2:main), первым делом добавим в src/animation.lisp описание компонента animation-frame, соответствующего одному кадру анимации:

(ecs:defcomponent animation-frame
  (sequence :|| :type keyword :index sequence-frames)
  (duration 0.0 :type single-float))

Помимо слота duration с длительностью кадра в секундах, мы добавляем в компонент слот sequence, при помощи которого будем отличать разные анимации друг от друга, с функцией-индексом sequence-frames, которая будет возвращать список всех кадров в данной анимации. Это поможет нам находить следующий кадр анимации при переключении кадров без полного перебора. Кроме того, удобно будет в дальнейшем использовать человекочитаемые названия при переключении анимаций у персонажей, например, при смене анимации бездействия на анимацию бега. Обратите внимание, тип слота sequence — keyword, это вид символов, а для символов происходит interning, т.е. переиспользование уже созданных одинаковых символов вместо создания новых, таким образом, два символа с одинаковым строковым содержимым — это всегда буквально один и тот же объект, что позволяет эффективно сравнивать символы (и кейворды), попросту сравнивая указатели на числовое равенство; поэтому мы и используем их для идентификации анимаций.

Компонент animation-frame будет добавляться к префабам тайлов, т.к. он по сути является образцом, создаваемым в единственном экземпляре для каждого кадра каждой анимации. Чтобы отличать конкретные анимированные тайлы на карте друг от друга, нам понадобится компонент с текущим состоянием анимации, назовём его animation-state:

(ecs:defcomponent animation-state
  (sequence :|| :type keyword)
  (frame 0 :type fixnum)
  (duration 0.0 :type single-float)
  (elapsed 0.0 :type single-float))

В нём мы также храним название текущей анимации в слоте sequence. Кроме того, в нём есть слот frame с номером текущего кадра анимации. Далее, мы будем копировать в слот duration длительность текущего кадра из одноименного слота компонента animation-frame, чтобы не делать лишних доступов к памяти на каждой итерации игрового цикла. Наконец, в слоте elapsed будем хранить длительность в секундах, в течение которой текущий кадр отображался на экране.

Таким образом, архитектура хранения данных для анимаций будет выглядеть так (очень кривыми вертикальными прямоугольниками снова показаны сущности, горизонтальными — компоненты):

Теперь добавим в файл ecs-tutorial-2.asd зависимость от библиотеки let-plus, она предоставляет синтаксический сахар, который позволит нам чуть изящнее написать код для смены кадров анимаций:

  ;; ...
  :license "MIT"
  :depends-on (#:alexandria
               #:cl-fast-ecs
               #:cl-liballegro
               #:cl-liballegro-nuklear
               #:cl-tiled
               #:let-plus               ;; здесь
               #:livesupport)
  ;; ...

...и добавим отсылку на эту библиотеку в файл src/package.lisp; кроме того, пока мы там, добавим импорт функции make-keyword из библиотеки alexandria, она понадобится нам далее:

(defpackage #:ecs-tutorial-2
  (:use #:cl #:let-plus)                                        ;; здесь
  (:import-from #:alexandria #:define-constant #:make-keyword)  ;; и здесь
  (:local-nicknames (#:tiled #:cl-tiled))
  (:export #:main))

Теперь ничто не мешает нам определить в src/animation.lisp систему update-animations, которая будет переключать кадры анимации в нужные моменты времени:

(ecs:defsystem update-animations
  (:components-rw (animation-state image)
   :arguments ((dt single-float)))
  (incf animation-state-elapsed dt)
  (when (> animation-state-elapsed animation-state-duration)
    (let+ (((&values nframes rest-time) (floor animation-state-elapsed
                                               animation-state-duration))
           (sequence-frames (sequence-frames animation-state-sequence))
           ((&values &ign nframe) (truncate (+ animation-state-frame nframes)
                                            (length sequence-frames)))
           (frame (nth nframe sequence-frames)))
      (setf animation-state-elapsed rest-time
            animation-state-frame nframe
            animation-state-duration (animation-frame-duration frame)
            image-bitmap (image-bitmap frame)))))

Эта система будет перебирать все анимированные тайлы, не трогая префабы, т.к. у них не будет компонента animation-state. В системе мы макросом incf прибавляем к слоту elapsed компонента animation-state количество реального физического времени dt, прошедшее с предыдущей итерации главного игрового цикла. Затем, если elapsed становится больше, чем duration, начинается самое интересное, потому что в этом случае нужно переключаться на следующий кадр анимации. Для этого мы делим нацело с помощью функции floor elapsed на duration, целочисленное частное кладём в переменную nframes, а оставшийся "хвостик" с плавающей запятой — в переменную rest-time. Смысл в том, что из-за каких-нибудь лагов dt может оказаться даже больше, чем duration, таким образом, за прошедшее с предыдущей отрисовки время нам нужно было сменить больше одного кадра анимации, так вот это конкретное число кадров и есть nframes; впрочем, в большинстве случаев там будет попросту единица. В то же время rest-time — это число, меньшее duration, в течение которого уже должен был отображаться следующий кадр. Далее, мы помещаем в переменную sequence-frames список всех кадров данной анимации вызовом одноименной индексной функции sequence-frames. После чего получаем номер следующего кадра, прибавив к номеру текущего, animation-state-frame, высчитанное нами ранее nframes (помните, в большинстве случаев единица), и функцией truncate делим с остатком на длину списка sequence-frames, чтобы не вылезти за его пределы в тех случаях, когда мы в данный момент проигрываем последний кадр анимации, и нужно снова вернуться на её начало. Собственно, в переменную nframe мы кладём остаток от деления, а это и будет нужный нам номер следующего кадра. Далее, мы достаём из списка кадров с помощью функции nth и кладём в переменную frame сущность префаба следующего кадра. Наконец, мы присваиваем с помощью setf новые значения:

• в elapsed — rest-time, "хвостик" от предыдущего кадра, в течение которого уже должен был проигрываться новый текущий кадр;

• в frame — подсчитанный нами новый номер кадра nframe;

• в duration копируем длительность из слота duration компонента animation-frame объекта-образца frame, получаемую вызовом аксессора animation-frame-duration;

• в слот bitmap компонента image мы копируем данные из того же объекта-образца frame, собственно меняя отображаемую картинку.

Теперь нам нужно модифицировать загрузку карты таким образом, чтобы добавлять в префабы компонент animation-frame, когда это необходимо, а также добавлять компонент animation-state в анимированные тайлы на карте. Для этого нам понадобится ряд вспомогательных функций; добавим в src/animation.lisp следующее:

(defun animation->spec (frame sequence)
  (copy-list
   `((:animation-frame :sequence ,sequence
                       :duration ,(* 0.001 (tiled:frame-duration frame))))))

(defun instantiate-animation (entity prefab)
  (let ((duration (animation-frame-duration prefab)))
    (make-animation-state entity
                          :sequence (animation-frame-sequence prefab)
                          :duration duration
                          :elapsed (random duration))))

Функция animation->spec будет возвращать нам фрагмент спецификации объекта для функции make-object с данными компонента animation-frame, в частности, с правильно подсчитанным duration — в Tiled длительности анимаций хранятся в миллисекундах.

Функция instantiate-animation будет вызываться при создании анимированных тайлов на карте для того, чтобы добавить в них компонент animation-state с правильными начальными значениями: в слот sequence мы копируем название анимации из префаба, в слот duration — его длительность, а в слот elapsed кладём случайное число от 0 до duration, чтобы однотипные анимации на карте отображались вразнобой, а не с идеальной синхронностью, что выглядело бы довольно странно.

Теперь модифицируем функцию load-tile-prefab в src/map.lisp следующим образом:

(defun load-tile-prefab (tile bitmap map-entity &optional extra-specs)        ;; здесь
  (unless (ecs:entity-valid-p
           (map-tile-prefab (tiled:tile-gid tile) :missing-error-p nil))
    (let* ((internal-tile-spec (tile->spec tile bitmap map-entity))
           (properties (when (typep tile 'tiled:properties-mixin)                ;; здесь
                         (tiled:properties tile)))                               ;;
           sequence frames                                                       ;;
           (animation-spec                                                       ;;
             (when (typep tile 'tiled:animated-tile)                             ;;
               (setf sequence (make-keyword                                      ;;
                               (string-upcase (gethash "sequence" properties)))  ;;
                     frames (tiled:tile-frames tile))                            ;;
               (animation->spec (first frames) sequence)))                       ;;
           (tile-spec (ecs:spec-adjoin                                           ;;
                       (nconc internal-tile-spec animation-spec extra-specs)     ;;
                       '(:map-tile)))                                            ;;
           (tile (ecs:make-object tile-spec)))
      (dolist (frame (rest frames))                                              ;; и здесь
        (load-tile-prefab (tiled:frame-tile frame) bitmap map-entity             ;;
                          (animation->spec frame sequence)))                     ;;
      tile)))

Объект анимированного тайла, возвращаемый библиотекой cl-tiled, tiled:animated-tile, устроен таким чудны́м образом, что в нём слот tile-frames содержит список всех кадров анимации, причём самым первым кадром идёт сам объект animated-tile. Мы учитываем эту особенность, выставляя в переменную animation-spec получаемую с помощью animation->spec спецификацию, а также название анимации в переменную sequence и список с её кадрами в переменную frames; в случае, если переданный в параметре tile тайл не является анимированным, все эти переменные будут иметь значение nil. Мы добавляем animation-spec к спецификации, соответствующей имманентным компонентам тайла (вроде image и size) и хранящейся в переменной internal-tile-spec, вызовом функции nconc (она модифицирует переданные ей списки, поэтому работает чуть быстрее, чем её иммутабельная версия append). Кроме того, мы подгружаем все кадры анимации рекурсивным вызовом load-tile-prefab, передавая результат вызова animation->spec для каждого кадра в качестве нового необязательного параметра extra-specs, который также передаётся функции nconc для формирования итоговой спецификации объекта-префаба.

Здесь мы снова закладываемся на неявный порядок создаваемых сущностей; кадры, возвращаемые из tiled:tile-frames, идут в том же порядке, в котором они расположены в редакторе анимаций, а сущности, возвращаемые из индексных функций ECS-фреймворком, всегда отсортированы по номеру сущности, поэтому мы будем всегда получать кадры анимации из индекса в правильном порядке.

Обратите внимание, мы получаем название анимации из свойства тайла по имени "sequence", поэтому нам понадобится добавить его в редакторе тайлсета, вызвав контекстное меню в редакторе свойств и выбрав пункт Добавить свойство, а в появившемся диалоге вписать sequence в качестве имени и string в качестве типа, например, для горящего пламени с названием анимации flame-idle:

Если мы пропустим этот важный шаг, то будем получать в дальнейшем ошибки вида The value NIL is not of type FIXNUM или аналогичные. Это будет происходить потому, что анимации будут загружаться под именем NIL, возвращаемым gethash для пустой хэш-таблицы, и мы не будем находить их по именам, по которым ожидаем.

Наконец, мы модифицируем функцию load-tile с тем, чтобы инициализировать анимации из префабов, когда это необходимо, т.е. когда в них есть данные анимаций:

(defun load-tile (entity tile x y)
  (let ((prefab (map-tile-prefab (tiled:tile-gid tile))))
    (ecs:copy-entity prefab
                     :destination entity
                     :except '(:map-tile-prefab :animation-frame))  ;; здесь
    (when (has-animation-frame-p prefab)                            ;;
      (instantiate-animation entity prefab))                        ;;
    (make-position entity :x (float x)
                          :y (float y))))

Мы указываем компонент animation-frame в списке исключений функции copy-entity (кейворд-аргумент except) при копировании данных префаба. Далее, в случае, когда у нас не просто префаб, а префаб с анимацией (мы проверяем это вызовом сгенерированного ECS-фреймворком предиката has-animation-frame-p), мы вызываем нашу вспомогательную функцию instantiate-animation для правильного создания компонента анимации в сущности тайла.

Наконец, мы можем перезагрузить все накопившиеся изменения в системе вызовом (ql:quickload :ecs-tutorial-2) и запустить (ecs-tutorial-2:main) для того, чтобы насладиться видом ожившего подземелья:

Персонаж

Теперь самое время добавить в игру виртуальное альтер-эго игрока, персонажа, который будет управляться с клавиатуры. Добавим в наш проект файл src/character.lisp, а отсылку на этот файл — в ecs-tutorial-2.asd:

  ;; ...
  :components ((:module "src"
              :components
              ((:file "package")
               (:file "common")
               (:file "animation")
               (:file "map")
               (:file "character")  ;; здесь
               (:file "main"))))
  ;; ...

Также добавим в файл src/package.lisp инструкцию :import-from для импорта некоторых символов из библиотеки float-features, они понадобятся нам через мгновение (float-features входит в список зависимостей используемых нами библиотек, поэтому её не требуется добавлять явно в :depends-on):

(defpackage #:ecs-tutorial-2
  (:use #:cl #:let-plus)
  (:import-from #:alexandria #:define-constant #:make-keyword)
  (:import-from #:float-features #:single-float-nan #:float-nan-p)  ;; здесь
  (:local-nicknames (#:tiled #:cl-tiled))
  (:export #:main))

Загрузим структурные изменения в нашем проекте, отдав команду (ql:quickload :ecs-tutorial-2) в нашем REPL. Затем в сам файл src/character.lisp добавим "шапку" с активацией пакета нашего проекта и описание компонента персонажа:

(in-package #:ecs-tutorial-2)


(ecs:defcomponent character
  (speed 0.0 :type single-float)
  (target-x single-float-nan :type single-float)
  (target-y single-float-nan :type single-float))

Основное отличие персонажей от прочих объектов, отображаемых нами на экране, состоит в том, что они способны перемещаться, поэтому важными данными для них является скорость (в пикселях в секунду) и точка, в которую в данный момент направляется персонаж. В качестве начального значения для целевой точки мы используем single-float-nan из библиотеки float-features, по сути это встречающееся в других языках специальное значение числа с плавающей запятой в формате IEEE-754 NaN, "не число" — таким образом мы сигнализируем, что изначально персонаж никуда не направляется. Если бы мы использовали в качестве этих значений ноль, получилось бы, что все новосозданные персонажи ни с того ни с сего бодро начинали бы бежать к верхнему левому углу карты.

Далее, один из персонажей будет специальным, т.к. им будет управлять игрок с клавиатуры, сделаем для него отдельный компонент-тег:

(ecs:defcomponent player
  (player 1 :type bit :index player-entity :unique t))

Здесь мы идём на хитрость и добавляем в изначально пустой компонент-тег player одноимённый слот player типа bit (т.е. целое число, которое может принимать только два значения, 0 и 1) с уникальным индексом по имени player-entity для того, чтобы срезать угол и не хранить сущность игрока в некрасивой глобальной переменной, а получать её за те же O(1) через вызов (player-entity 1). Однако за эту красоту, немного подпорченную не совсем уместной единицей, нам придётся пусть и немного, но всё же заплатить быстродействием — вместо одного-двух доступов к памяти для получения глобальной переменной такой вызов будет занимать не менее шести.

Также обратите внимание, что за счёт гибкости архитектуры ECS мы можем в любой момент времени динамически передать игроку управление над любым персонажем, попросту удалив компонент player с текущего персонажа и добавив его к нужному, таким образом получая возможность реализовать в игре постмодернистский сюжет ?

Нашим главным персонажем будет вот такой очаровательный зубастенький орк из тайлсета:

Вырежем фрагмент изображения, на котором он изображён, запустив в каталоге Resources команду

convert dungeontileset-extended2.png -crop 32x32+736+64 player.png

...и запишем в src/character.lisp функцию load-player для его загрузки и создания объекта персонажа игрока с помощью ecs:make-object:

(defun load-player ()
  (ecs:make-object `((:image :bitmap ,(load-bitmap "player.png"))
                     (:position :x 64.0 :y 64.0)
                     (:size :width 32.0 :height 32.0)
                     (:character :speed 100.0)
                     (:player))))

...а так же вызовем её в функции init из src/main.lisp после вызова load-map, чтобы в силу обсуждавшегося выше неявного порядка изображение персонажа отрисовывалось поверх тайлов карты, где бы он ни находился:

(defun init ()
  (ecs:bind-storage)
  (load-map "level1.tmx")  ;;
  (load-player))           ;; здесь

Отправим определения компонентов character и player, а также функций load-player и init в запущенный Lisp-процесс, поочерёдно поставив на них курсор и нажав клавиши Ctrl-C, Ctlr-C, или C-c C-c на жаргоне Emacs (либо используя пункты контекстного меню "Inline eval", "Evaluate This S-expression", "Evaluate form at cursor", или аналогичные в вашей IDE). Мы могли бы целиком перезагрузить систему, снова вызвав (ql:quickload :ecs-tutorial-2) в REPL, однако загрузка пары функций и пары определений компонентов произойдёт гораздо быстрее, чем полная перезагрузка проекта, а интерактивность разработки и быстрота цикла "изменения ? результат" очень важны при создании игр. Запустив после этого в REPL (ecs-tutorial-2:main), мы увидим нашего персонажа:

Однако мы пока не реализовали управление этим персонажем. Давайте исправим это упущение, первым делом добавив в файл src/character.lisp систему move-characters, которая будет помогать персонажам двигаться и достигать поставленных ими целей, хранимых нами в слотах target-x и target-y:

(defun approx-equal (a b &optional (epsilon 0.5))
  (< (abs (- a b)) epsilon))

(ecs:defsystem move-characters
  (:components-rw (position character)
   :components-ro (size)
   :arguments ((dt single-float)))
  (when (or (float-nan-p character-target-x)
            (float-nan-p character-target-y))
    (setf character-target-x position-x
          character-target-y position-y))
  (unless (and (approx-equal position-x character-target-x)
               (approx-equal position-y character-target-y))
    (let* ((angle (atan (- character-target-y position-y)
                        (- character-target-x position-x)))
           (dx (* character-speed dt (cos angle)))
           (dy (* character-speed dt (sin angle)))
           (new-x (+ position-x dx))
           (new-y (+ position-y dy)))
      (setf position-x new-x
            position-y new-y))))

Первым делом мы реализуем вспомогательную функцию для сравнения координат, approx-equal, т.к. сравнивать числа с плавающей запятой "в лоб" — большой грех. В самой move-characters мы проверяем, является ли персонаж свежесозданным, т.е. с taget-x и target-y, равными NaN, с помощью функции float-nan-p из float-features. Если это так, мы просто выставляем target-x и target-y в текущие координаты персонажа, таким образом, его целью становится место, в котором он уже находится, что напоминает какой-нибудь дзен-буддистский коан ? Далее мы с помощью approx-equal проверяем, достиг ли персонаж своей целевой точки или нет, и если это не так, мы подсчитываем новые координаты персонажа, new-x и new-y, исходя из текущих координат, координат цели, скорости передвижения персонажа, прошедшего с прошлого кадра времени dt и нехитрых геометрических соображений:

...а затем выставляем текущие координаты персонажа, position-x и position-y, в рассчитанные.

Теперь напишем систему, занимающуюся опросом клавиатуры и передвижением персонажа игрока в соответствии с нажатыми клавишами. Для этого сначала добавим в файл src/package.lisp импорт функции clamp из библиотеки alexandria, она понадобится нам в расчётах:

(defpackage #:ecs-tutorial-2
  (:use #:cl #:let-plus)
  (:import-from #:alexandria #:clamp #:define-constant #:make-keyword)  ;; здесь
  (:import-from #:float-features #:single-float-nan #:float-nan-p)
  (:local-nicknames (#:tiled #:cl-tiled))
  (:export #:main))

Затем добавим в файл src/character.lisp определение системы control-player после определения move-characters:

(ecs:defsystem control-player
  (:components-ro (player position size)
   :components-rw (character)
   :after (move-characters))
  (al:with-current-keyboard-state keyboard-state
    (let ((dx 0) (dy 0))
      (when (al:key-down keyboard-state :W) (setf dy -1))
      (when (al:key-down keyboard-state :A) (setf dx -1))
      (when (al:key-down keyboard-state :S) (setf dy +1))
      (when (al:key-down keyboard-state :D) (setf dx +1))

      (setf
       character-target-x
       (clamp (+ position-x dx) size-width (- +window-width+ size-width))
       character-target-y
       (clamp (+ position-y dy) size-height (- +window-height+ size-height))))))

С помощью параметра :after (move-characters) мы указываем, что эта система должна запускаться после системы move-characters, чтобы не запнуться об значения NaN в слотах character-target-x и character-target-y. В самой системе мы используем макрос из cl-liballegro, with-current-keyboard-state, который заводит на стеке сишную структуру ALLEGRO_KEYBOARD_STATE, записывает в неё текущее состояние нажатых на клавиатуре клавиш вызовом al_get_keyboard_state и позволяет работать с указателем на неё, что мы и используем, вызывая функцию al_key_down для клавиш W, A, S и D и меняя переменные dx и dy соответствующим образом. Затем мы прибавляем эти переменные к текущим координатам, position-x и position-y, и выставляем через setf, не забыв использовать функцию clamp, чтобы не вылезти за границы экрана, а именно:

• чтобы новая координата x не стала меньше size-width или больше ширины экрана за вычетом size-width,

• и чтобы новая координата y не стала больше size-height или больше высоты экрана за вычетом size-height.

Отправив в запущенный Lisp-процесс форму defpackage из файла src/package.lisp, а также определение функции approx-equal и новых систем move-characters и control-player нажатием клавиш C-c C-c (или аналогичными средствами вашей IDE), и даже не перезапуская main, мы увидим, что управление работает ?

Правда, мы тут же наблюдаем недосмотр — наш персонаж свободно пробегает сквозь объекты, аки терминатор T-1000 через тюремные решётки.

Это происходит потому, что сейчас стены — это обычные картиночки-тайлы, ничем не отличающиеся от тайлов пола. Тут-то и приходит время считывать из Tiled нечто большее, чем просто картинки.

Интерьер

Редактор Tiled является настолько мощным и гибким, что позволяет хранить в файле карты произвольные объекты со свойствами различных типов. Мы, конечно же, не пройдём мимо этой гибкости и проэксплуатируем её для того, чтобы подгружать ECS-объекты прямо из Tiled, что приблизит нас к полноразмерным игровым движкам со встроенными редакторами, вроде Unreal или Godot. Да и не придётся хардкодить параметры игрового персонажа, как мы сделали это в функции load-player, можно будет создать его прямо в редакторе и поставить куда нужно, наряду с другими персонажами.

Начнём с решения проблемы свободного прохождения персонажем сквозь стены. У нас уже есть слот булевского типа obstacle в компоненте map-tile, который призван отличать препятствия от прочего декора, но пока он нами никак не используется. Нам нужно сделать две вещи: во-первых, загружать ECS-компоненты, включая map-tile, из файла карты, а во-вторых, как-то использовать загруженные значения слота obstacle.

Давайте начнём с того, что добавим компоненты в карту, чтобы было что загружать. Перво-наперво создадим кастомный тип Tiled, соответствующий нашему компоненту map-tile; для этого выберем в нём пункт меню Вид ? Редактор пользовательских типов, нажмём в открывшемся диалоге кнопку Добавить класс и назовём его map-tile, а также нажмём кнопку Добавить поле, выберем для него тип bool и название obstacle:

Штука в том, что теперь мы можем использовать этот тип в качестве типа свойств у тайлов: открыв редактор тайлсета (по кнопочке с шестерёнкой Редактировать набор тайлов в окне Наборы тайлов) и выбрав тайл стены, нажмём в окне Свойства правой кнопкой мыши и выберем пункт меню Добавить свойство, а затем выберем из списка наш новый тип map-tile, и назовём новое свойство тем же именем, map-tile (это важно и для нас, чтобы не путаться, и для корректной загрузки свойства нашим кодом). Также прожмём галочку obstacle, так как стена, несомненно, является препятствием. Это будет выглядеть следующим образом:

Теперь нам необходимо загрузить кастомные свойства тайлов в качестве компонентов. Для этого для начала в файле src/map.lisp добавим новую вспомогательную функцию, properties->spec, и модифицируем функцию load-tile-prefab следующим образом:

(defun properties->spec (properties)
  (when properties
    (loop :for component :being :the :hash-key
          :using (hash-value slots) :of properties
          :when (typep slots 'hash-table)
          :collect (list* (make-keyword (string-upcase component))
                          (loop :for name :being :the :hash-key
                                :using (hash-value value) :of slots
                                :nconcing (list
                                           (make-keyword (string-upcase name))
                                           value))))))

(defun load-tile-prefab (tile bitmap map-entity &optional extra-specs)
  (unless (ecs:entity-valid-p
           (map-tile-prefab (tiled:tile-gid tile) :missing-error-p nil))
    (let* ((internal-tile-spec (tile->spec tile bitmap map-entity))
           (properties (when (typep tile 'tiled:properties-mixin)
                         (tiled:properties tile)))
           (external-tile-spec (properties->spec properties))                 ;; здесь
           sequence frames
           (animation-spec
             (when (typep tile 'tiled:animated-tile)
               (setf sequence (make-keyword
                               (string-upcase (gethash "sequence" properties)))
                     frames (tiled:tile-frames tile))
               (animation->spec (first frames) sequence)))
           (tile-spec (ecs:spec-adjoin
                       (nconc internal-tile-spec external-tile-spec           ;; здесь
                              animation-spec extra-specs)                     ;;
                       '(:map-tile)))
           (tile (ecs:make-object tile-spec)))
      (dolist (frame (rest frames))
        (load-tile-prefab (tiled:frame-tile frame) bitmap map-entity
                          (animation->spec frame sequence)))
      tile)))

Функция properties->spec принимает на вход хэш-таблицу, которой cl-tiled представляет свойства объектов, и возвращает соответствующую ей список-спецификацию для функции make-object. При этом пользовательские классы, определённые нами в Tiled, будут считаться компонентами, а их поля — слотами компонентов. Например, для добавленного нами к тайлу стены свойства map-tile эта функция вернёт список вида ((:map-tile :obstacle t)) — как раз то, что нужно.

Функция load-tile-prefab теперь вызывает вспомогательную функцию properties->spec для свойств тайлов, получаемых вызовом функции tiled:properties. Если тайл не является наследником CLOS-класса tiled:properties-mixin (т.е. у тайла нет никаких свойств, что будет довольно частой ситуацией), в переменной properties окажется значение nil (так устроен стандартный макрос when), и propertiles->spec также вернёт пустой список в качестве спецификации. Кроме того, загруженная спецификация свойств тайлов, которую мы храним в переменной external-tile-spec, теперь добавляется к итоговой спецификации префаба, собираемой из запчастей уже известной нам функцией nconc. Кроме того, в вызове spec-adjoin теперь гораздо больше смысла: если в свойствах тайла в тайлсете нет свойства по имени map-tile (а это более частый случай), к спецификации префаба будет добавлен компонент map-tile с дефолтным значением слота obstacle, равным nil (нет препятствия), если же он был загружен из свойств в переменную external-tile-spec, то spec-adjoin оставит спецификацию нетронутой.

Отправив в Lisp-процесс определения функций properties->spec и load-tile-prefab средствами вашей IDE и запустив в REPL (ecs-tutorial-2:main), вы можете задаться вопросом, как проверить работоспособность того механизма, который мы реализовали, помимо очевидного отсутствия ошибок при запуске. Для этого нам будет достаточно тех инструментов, которые у нас уже есть в руках:

1. компонент map-tile-prefab включает в себя одноименный индекс;

2. в состав ECS-фреймворка входит функция print-entity, отображающая наличествующие в переданной ей сущности компоненты в том же формате спецификации, в котором мы скармливаем их внутрь make-object.

Запомнив значение ID тайла с предыдущего скриншота Tiled (это тот самый уникальный численный идентификатор тайла), используем его, чтобы полюбоваться на загруженный из него префаб, передав в REPL прямо во время работы программы фрагмент кода вида (ecs:print-entity (ecs-tutorial-2::map-tile-prefab (1+ 65))), где 65 — значение ID тайла. В результате мы увидим что-то в духе

((:MAP-TILE :OBSTACLE T) (:PARENT :ENTITY 0)
 (:IMAGE :BITMAP #.(SB-SYS:INT-SAP #X5605DA7690A0)) (:MAP-TILE-PREFAB :GID 66)
 (:SIZE :WIDTH 32.0 :HEIGHT 32.0))

...то есть помимо компонента map-tile-prefab и необходимых для тайла компонентов parent, image и size, в префабе теперь есть компонент map-tile со слотом obstacle, равным t, и мы точно знаем, что он будет скопирован при загрузке из префаба во все соответствующие ему экземпляры тайла на карте вызовом ecs:copy-entity ?

Теперь, после того, как мы загружаем в игру данные об интерьере подземелья, давайте используем их для того, чтобы отучить нашего игрового персонажа от терминаторских повадок, отобрав у него возможность двигаться сквозь стены. Для этого мы пойдём самым простым путём и модифицируем систему control-player таким образом, чтобы попытки такого движения пресекались на корню. Однако для этого нам понадобится некий механизм, позволяющий получить все объекты, расположенные в заданном тайле, чтобы, обнаружив среди них тайл-препятствие, запретить перемещение на него. На эту роль снова напрашивается предоставляемый cl-fast-ecs индекс по слоту (чтобы опять-таки не перебирать все объекты на карте за O(n)), однако какой это должен быть слот и в каком компоненте? Ясно, что раз в задаче фигурирует расположение объекта, проще всего будет не отходя далеко от кассы использовать компонент position. Новым индексированным слотом в нём логично сделать некий хэш от координат, который можно упихать, скажем, в одно целое число, и при этом гарантировать, что разные тайлы в разных узлах сетки 32⨉32 будут иметь разные хэши. Учитывая, что координаты у нас, хоть и хранятся в качестве чисел с плавающей запятой, являются целочисленными, т.к. представляют собой координаты пикселей, и не выходят за пределы диапазонов [0; 1280] по x и [0; 800] по y, мы можем изобразить нехитрую хэш-функцию, которая будет конвертировать координаты в целые числа путём отбрасывания дробной части и упихивать два целых числа, каждое из которых гарантированно меньше 2³², в одно 64-битное. Добавим в файл src/common.lisp новую вспомогательную функцию tile-hash и новый индексированный слот в компонент position:

(defun tile-hash (x y)
   (let ((x* (truncate x))
         (y* (truncate y)))
     (logior (ash x* 32) y*)))

(ecs:defcomponent position
  (x 0.0 :type single-float)
  (y 0.0 :type single-float)
  (tile-hash (tile-hash x y) :type fixnum :index tiles))  ;; здесь

Новый слот называется tile-hash и имеет значение по умолчанию, равное вызову функции tile-hash с аргументами x и y, которые ссылаются на значения соответствующих слотов при создании компонента, и индексную функцию под названием tiles. Таким образом, вызвав tile-hash с координатами начала (т.е. верхнего левого угла) тайла и передав полученный хэш в функцию tiles, мы получим список со всеми сущностями, у которых координаты равны началу этого же тайла. Это и будут тайлы карты со всех слоёв в интересующем нас узле сетки.

Теперь внесём изменения в систему control-player в src/character.lisp, используя три новые вспомогательные функции:

(defun tile-start (x y width height)
  (values (* width (the fixnum (floor x width)))
          (* height (the fixnum (floor y height)))))

(defun tile-obstacle-p (x y)
  (loop :for entity :of-type ecs:entity :in (tiles (tile-hash x y))
        :thereis (and (has-map-tile-p entity)
                      (map-tile-obstacle entity))))

(defun obstaclep (x y size-width size-height)
  (multiple-value-call #'tile-obstacle-p
    (tile-start x y size-width size-height)))

(ecs:defsystem control-player
  (:components-ro (player position size)
   :components-rw (character)
   :after (move-characters))
  (al:with-current-keyboard-state keyboard-state
    (let ((dx 0) (dy 0))
      (when (al:key-down keyboard-state :W) (setf dy -1))
      (when (al:key-down keyboard-state :A) (setf dx -1))
      (when (al:key-down keyboard-state :S) (setf dy +1))
      (when (al:key-down keyboard-state :D) (setf dx +1))

      (setf
       character-target-x
       (clamp (+ position-x dx) size-width (- +window-width+ size-width))
       character-target-y
       (clamp (+ position-y dy) size-height (- +window-height+ size-height)))

       (when (or (and (or (minusp dx) (minusp dy))                             ;; здесь
                     (obstaclep character-target-x                             ;;
                                character-target-y                             ;;
                                size-width size-height))                       ;;
                (and (or (minusp dx) (plusp dy))                               ;;
                     (obstaclep character-target-x                             ;;
                                (+ character-target-y size-height)             ;;
                                size-width size-height))                       ;;
                (and (or (plusp dx) (minusp dy))                               ;;
                     (obstaclep (+ character-target-x size-width)              ;;
                                character-target-y                             ;;
                                size-width size-height))                       ;;
                (and (or (plusp dx) (plusp dy))                                ;;
                     (obstaclep (+ character-target-x size-width)              ;;
                                (+ character-target-y size-height)             ;;
                                size-width size-height)))                      ;;
        (setf character-target-x position-x                                    ;;
              character-target-y position-y)))))                               ;;

Функция tile-start для заданных координат любой точки и размеров тайлов в сетке возвращает координаты начала (верхнего левого угла) тайла, в котором находится эта точка, попросту деля каждую из координат нацело с помощью floor на размер и затем умножая получившееся целое число типа fixnum, обратно:

(символом // на иллюстрации обозначено деление нацело). tile-start возвращает результаты, используя механизм Lisp multiple values, который даёт возможность вернуть из функции более одного значения, при этом не занимая дополнительную память на куче, как это происходит, например, в Python при использовании распаковки кортежей.

Функция tile-obstacle-p, для заданных координат начала тайла возвращает булевское значение, указывающее, есть ли по этим координатам хотя бы один тайл-препятствие. Для этого она обходит стандартным циклом loop все сущности, у которых tile-hash совпадает с хэшем заданных координат x и y — список таких сущностей она получает вызовом индексной функции tiles. Как только она находит сущность, для которой верно условие (and (has-map-tile-p entity) (map-tile-obstacle entity)), т.е. у которой есть компонент map-tile и значение его слота obstacle истинно, тут же возвращает t, используя конструкцию thereis макроса loop; если цикл доходит до конца, не найдя ни одной такой сущности, автоматически возвращается ложь, nil. Такой не совсем тривиальный код, не говоря уж об отдельном индексе по координатам, для, казалось бы, такой тривиальной задачи, как обнаружение препятствий, нужен потому, что в карте может быть несколько слоёв, и несколько разных тайлов могут находиться в одном узле сетки, поэтому нам нужно проверять их все.

Функция obstaclep комбинирует две предыдущих: она позволяет понять, является ли тайл препятствием по произвольной координате (x, y), а не только находящейся точно в узлах сетки, вызывая tile-obstaclep с результатами вызова функции tile-start посредством особой формы multiple-value-call.

Наконец, в системе control-player после получения направления, в котором игрок хочет передвинуть своего персонажа, в переменных dx и dy, мы добавляем ещё один блок кода. Новый код удостоверятся в том, может ли персонаж передвинуться в координаты, куда стремится игрок, проверяя, являются ли проходимыми соответствующие тайлы, опять-таки в соответствии с немудрёными геометрическими соображениями:

Мы проверяем заштрихованные на картинке тайлы при движении в каждом из четырёх направлений на предмет того, являются ли они препятствиями — именно это и закодировано в громоздком условии в форме when в новом коде.

Отправив в Lisp-процесс функцию tile-hash и новое определение компонента position, а также функции tile-start, tile-obstacle-p и obstaclep вместе с новым определением системы control-player, мы видим, что персонаж игрока теперь ведёт себя с препятствиями так, как положено любому порядочному персонажу, а именно — почтительно останавливается перед стенами и не пытается пройти их насквозь ?

Отметим, что реализованный нами способ учёта препятствий не идеален — он довольно громоздок и будет приводить к мелким странностям в дальнейшем при реализации поведения других персонажей. Более правильным подходом будет считать координатой персонажа координаты центра его тайла, что упростит математику и код в control-player, но для этого придётся внести изменения в функцию load-map и реализовать отдельную систему вдобавок к render-images для отрисовки тайлов персонажей по правильным координатам. Мы не пойдём по такому пути, чтобы не усложнять это руководство, но у вас есть возможность научиться на этой ошибке и реализовать более корректный учёт препятствий в своих творениях.

Анимация персонажа

Теперь используем возможность загрузки компонентов из файла карты, реализованную в предыдущем разделе, для того, чтобы не хардкодить параметры игрока, а задавать их прямо в редакторе. Для этого нам понадобятся новые кастомные классы в Tiled, соответствующие компонентам персонажа и игрока; добавим их, вызвав редактор пользовательских типов соответствующим пунктом меню Вид:

В класс character мы добавляем единственное поле типа float, speed. Мы опускаем слоты target-x и target-y, таким образом, они всегда будут проинициализированы своими дефолтными значениями при загрузке с карты.

В класс player мы добавляем одноименное поле типа int и прописываем там дефолтное значение 1.

Теперь мы можем добавить объект персонажа игрока на карту. Для этого сначала в окне Слои создадим новый слой объектов пунктом контекстного меню Новый?Слой объектов и выберем его. Затем на панели инструментов включим инструмент Вставить тайл (или можно просто нажать на клавиатуре латинскую T), и в окне Наборы тайлов выберем тайл, соответствующий нашему персонажу. Теперь можно щёлкнуть по произвольному месту карты, и в это место на слое объектов будет добавлен особенный объект — с одной стороны, он может иметь свойства кастомных типов, которые будут подгружаться как ECS-компоненты нашим кодом, с другой стороны, он будет являться тайлом и отрисовываться как таковой; нужно только убедиться, что слой с объектами у нас находится выше всех остальных слоёв, чтобы этот и другие объекты не затирались при отрисовке тайлами карты. В общем случае слой с объектами может и перекрываться другими, если того требует художественная задумка, но в нашем простом примере он всегда поверх.

Добавим этому объекту в окне Свойства интересующие нас компоненты, character и player (помните, важно, чтобы имена кастомных свойств совпадали с названиями компонентов):

Теперь для того, чтобы этот особенный объект загружался нашим кодом, модифицируем функцию load-map в src/map.lisp:

(defun load-map (filename)
  (let ((map (tiled:load-map filename))
        (map-entity (ecs:make-object '((:map)))))
    (dolist (tileset (tiled:map-tilesets map))
      (let ((bitmap (load-bitmap
                     (tiled:image-source (tiled:tileset-image tileset)))))
        (dolist (tile (tiled:tileset-tiles tileset))
          (load-tile-prefab tile bitmap map-entity))))
    (dolist (layer (tiled:map-layers map))
      (typecase layer
        (tiled:tile-layer
         (dolist (cell (tiled:layer-cells layer))
           (load-tile (ecs:make-entity) (tiled:cell-tile cell)
                      (tiled:cell-x cell) (tiled:cell-y cell))))
        (tiled:object-layer                                                       ;; здесь
         (dolist (object (tiled:object-group-objects layer))                      ;;
           (let ((object-entity (ecs:make-object                                  ;;
                                 (properties->spec (tiled:properties object)))))  ;;
             (typecase object                                                     ;;
               (tiled:tile-object                                                 ;;
                 (load-tile object-entity (tiled:object-tile object)              ;;
                            (tiled:object-x object)                               ;;
                            (- (tiled:object-y object)                            ;;
                               (tiled:object-height object))))))))))              ;;
    map-entity))

В новом фрагменте кода, запускаемом для слоёв типа tiled:object-layer, т.е. слоёв объектов, мы проходимся по их содержимому — списку объектов, получаемому вызовом tiled:object-group-objects. Для каждого объекта мы создаём ECS-сущность вызовом make-object, передавая в качестве спецификации результат вызова нашей вспомогательной функции properties->spec, которая учитывает компоненты, добавленные нами в свойства объекта в Tiled в качестве кастомных классов. Затем мы смотрим на тип объекта — пока нас интересует только tiled:tile-object, объект-тайл. Для такого объекта мы вызываем нашу старую знакомую — функцию load-tile, которая копирует данные тайла из префаба в новую сущность, включая анимацию, если она там есть, и выставляет указанную нами позицию. Дополнительные вычисления для y нужны потому, что в Tiled по какой-то странной причине координатой объекта считается координата его левого нижнего угла, а не верхнего, как у тайла.

Теперь уберём вызов load-player из init в src/main.lisp:

(defun init ()
  (ecs:bind-storage)
  (load-map "level1.tmx"))  ;; здесь

...и удалим за ненадобностью саму функцию load-player из src/character.lisp. Это всё, что нам требуется сделать — мы удачно переиспользуем функцию properties->spec, ранее загружавшую данные компонентов из свойств тайлов в тайлсете в префабы, для загрузки их из свойств объектов, непосредственно добавляемых на соответствующий слой в Tiled, поэтому после отправки в Lisp-процесс новых определений функций init и load-map и запуска (ecs-tutorial-2:main) мы увидим нашего персонажа ровно там, куда мы его добавили на карте ?

Таким образом, благодаря использованию ECS для хранения информации об объектах на карте, мы приближаемся к архитектуре программирования, управляемого данными (англ. Data-Driven Design) — это целая парадигма со своими плюсами и особенностями, часто используемая при создании AAA-игр; есть замечательное выступление широко известного в узких кругах разработчика таковых игр, Майка Эктона, с подробным обзором этой парадигмы: CppCon 2014: Mike Acton "Data-Oriented Design and C++".

Добавим ещё немножко красоты, создав анимации для нашего персонажа. Наш тайлсет организован таким образом, что для большинства персонажей первые четыре кадра анимации — это анимация бездействия, а следующие четыре — анимация бега. Откроем редактор набора тайлов в Tiled и внесём соответствующие изменения, не забыв про строковое свойство sequence в первом кадре каждой из анимаций (назовём их orc-idle и orc-run):

Теперь добавим в файл src/animation.lisp вспомогательную функцию, которая поможет нам переключать анимации у объектов:

(defun change-animation-sequence (entity new-sequence)
  (unless (eq (animation-state-sequence entity) new-sequence)
    (let ((first-frame (first (sequence-frames new-sequence :count 1))))
      (with-animation-state () entity
        (setf sequence new-sequence
              frame 0
              duration (animation-frame-duration first-frame)
              elapsed 0.0
              (image-bitmap entity) (image-bitmap first-frame))))))

В ней мы сначала проверяем, не включена ли уже на заданной сущности entity затребованная анимация new-sequence. Для этого мы сравниваем её с текущей анимацией в слоте sequence компонента animation-state функцией eq, буквально проверяющей, совпадают ли у переданных ей объектов адреса в памяти. Так как мы храним названия анимаций в качестве кейвордов, для которых происходит интернинг, нам это подойдёт. Если анимация new-sequence действительно новая и на неё нужно переключаться, мы получаем первый кадр новой анимации, вызвав индексную функцию sequence-frames с кейворд-аргументом count, равным 1, чтобы не тратить лишнюю память и время на получение всех остальных кадров, и first на её результате. Затем мы выставляем слоты компонента animation-state заданной сущности, используя сгенерированный ECS-фреймворком макрос with-animation-state и стандартный макрос setf:

• слот sequence выставляем в заданную новую анимацию, new-sequence;

• слот frame с текущим номером кадра будет равен 0;

• слот duration выставляем в длительность первого кадра first-frame, получаемую аксессором animation-frame-duration;

• слот elapsed со временем, в течение которого уже проигрывалась анимация, также будет равен 0;

• кроме того, слот bitmap компонента image заданной сущности выставляем в такой же слот из сущности первого кадра.

Используем эту функцию в системе move-characters следующим образом:

(ecs:defsystem move-characters
  (:components-rw (position character)
   :components-ro (size)
   :arguments ((dt single-float)))
  (when (or (float-nan-p character-target-x)
            (float-nan-p character-target-y))
    (setf character-target-x position-x
          character-target-y position-y))
  (if (and (approx-equal position-x character-target-x)        ;; здесь
           (approx-equal position-y character-target-y))       ;;
      (change-animation-sequence entity :orc-idle)             ;;
      (let* ((angle (atan (- character-target-y position-y)
                          (- character-target-x position-x)))
             (dx (* character-speed dt (cos angle)))
             (dy (* character-speed dt (sin angle)))
             (new-x (+ position-x dx))
             (new-y (+ position-y dy)))
        (setf position-x new-x
              position-y new-y)
        (change-animation-sequence entity :orc-run))))         ;; и здесь

В случае, когда персонаж стоит на месте, вы вызываем change-animation-sequence с тем, чтобы сменить анимацию на :orc-idle, если же персонаж двигается, мы меняем её на :orc-run. Отправив в Lisp-процесс определение функции change-animation-sequence и системы move-characters, мы увидим, что наш персонаж теперь действительно анимирован:

Факт того, что мы добавили нашему персонажу новую функциональность со сравнительной лёгкостью, опять-таки указывает на гибкость подхода ECS и стройность выбранного нами дизайна компонентов и систем.

Обитатели

В качестве последнего шага в деле наполнения нашего подземелья контентом займёмся его обитателями. Добавим в файл src/character.lisp компонент enemy, который мы будем добавлять к сущностям врагов, загружаемых из файла карты:

(ecs:defcomponent enemy
  (vision-range 0.0 :type single-float)
  (attack-range 0.0 :type single-float))

В этом компоненте мы заводим два важных слота, описывающих поведение персонажей врагов:

• vision-range — в нём мы будем хранить дистанцию в пикселях, в пределах которой враг будет "видеть" персонажа игрока и начинать на него как-то реагировать;

• attack-range — в нём будет храниться дистанция (тоже в пикселях), в пределах которой враг будет атаковать.

Далее, из соображений простоты мы пойдём по стопам Миядзаки и Souls-like игр и сделаем врагов невероятно сложными — попадание в их дистанцию атаки будет означать мгновенную гибель персонажа игрока и окончание игры, а значит, нам понадобится механизм завершения игры. Для этого добавим в src/common.lisp глобальную переменную, указывающую, нужно ли завершить игру:

(defvar *should-quit*)

Затем добавим в функцию main в src/main.lisp код, инициализирующий эту переменную и проверяющий её на каждой итерации главного цикла:

               ;; ...
               :with dt :of-type double-float := 0d0
               :with *should-quit* := nil                                  ;; здесь
               :while (loop
                        :named event-loop
                        :while (al:get-next-event event-queue event)
                        :for type := (cffi:foreign-slot-value
                                      event '(:union al:event) 'al::type)
                        :always (not (eq type :display-close))
                        :never *should-quit*)                               ;; и здесь
               ;; ...

Теперь всё готово, чтобы реализовать в src/character.lisp систему, которая будет управлять поведением персонажей врагов:

(ecs:defsystem handle-enemies
  (:components-ro (position enemy)
   :components-rw (character)
   :with ((player-x player-y) := (with-position () (player-entity 1)
                                   (values x y))))
  (when (and (approx-equal position-x player-x enemy-vision-range)
             (approx-equal position-y player-y enemy-vision-range))
    (setf character-target-x player-x
          character-target-y player-y))
  (when (and (approx-equal position-x player-x enemy-attack-range)
             (approx-equal position-y player-y enemy-attack-range))
    (setf *should-quit* t)
    (al:show-native-message-box (cffi:null-pointer)
                                "ECS Tutorial 2" "" "You died"
                                (cffi:null-pointer) :warn)))

В ней мы с помощью аргумента with заводим локальные переменные player-x и player-y, которые ещё до обработки первой сущности с заданными компонентами будут проинициализированы координатами игрока, получаемыми с помощью сгенерированного ECS-фреймворком макроса with-position. Сама система содержит две формы when, первая из которых проверяет с помощью approx-equal, находится ли персонаж игрока в области видимости врага и, если это так, выставляет слоты компонента character с координатами цели в позицию игрока, таким образом, "увидев" игрока, враги будут начинать его преследовать (однако, если их скорость меньше, игрок сможет от них убежать, покинув их область видимости). Вторая форма when проверяет, находится ли персонаж игрока в области атаки врага, и в случае, если это так, мы устанавливаем флажок выхода из программы *should-quit* в булевскую истину, t, и выводим сообщение, слишком хорошо знакомое всем фанатам Souls-like игр, используя функцию al_show_native_message_box из liballegro, которая показывает нативный для ОС диалог с сообщением:

Кроме того, нам придётся модифицировать систему move-characters для учёта анимаций персонажей врагов. Мы будем использовать в качестве врагов очаровательных красненьких демонов с анимациями с названиями demon-idle и demon-run, но только в том случае, если на персонаже нет компонента player, что можно проверить вызовом сгенерированного ECS-фреймворком предиката has-player-p:

(ecs:defsystem move-characters
  (:components-rw (position character)
   :components-ro (size)
   :arguments ((dt single-float)))
  (when (or (float-nan-p character-target-x)
            (float-nan-p character-target-y))
    (setf character-target-x position-x
          character-target-y position-y))
  (if (and (approx-equal position-x character-target-x)
           (approx-equal position-y character-target-y))
      (change-animation-sequence                               ;; здесь
       entity                                                  ;;
       (if (has-player-p entity) :orc-idle :demon-idle))       ;;
      (let* ((angle (atan (- character-target-y position-y)
                          (- character-target-x position-x)))
             (dx (* character-speed dt (cos angle)))
             (dy (* character-speed dt (sin angle)))
             (new-x (+ position-x dx))
             (new-y (+ position-y dy)))
        (setf position-x new-x
              position-y new-y)
        (change-animation-sequence                             ;; и здесь
         entity                                                ;;
         (if (has-player-p entity) :orc-run :demon-run)))))    ;;

Наконец, добавим анимации demon-idle и demon-run, на которые мы сослались в коде, в редакторе тайлсета Tiled:

...и расставим по карте несколько врагов:

Загрузив одним махом все накопившиеся изменения вызовом (ql:quickload :ecs-tutorial-2) и запустив наше приложение вызовом (ecs-tutorial-2:main), мы понимаем, что его уже не стыдно назвать игрой, ведь игроку необходимо героически преодолевать препятствия для достижения цели!

Однако можно легко заметить, что враги тоже имеют терминаторские повадки и легко пробегают сквозь стены, а это слишком негуманно даже для Souls-like игр. Впрочем, для того, чтобы дать персонажам врагов что-то вроде искусственного интеллекта в области движения по пересечённой местности подземелья, нам понадобится некий алгоритм поиска пути в графе. Традиционно для игр выбирают алгоритм A*, т.к. он достаточно гибок и эффективен. Забавный факт: этот алгоритм был разработан в рамках проекта по созданию робота, способного рассуждать о своих действиях, под названием Шейки, и был реализован на LISP — таким образом, используя этот алгоритм, мы заставляем историю сделать полный круг ?

Мы могли бы реализовать A* вручную — он не особо сложен, но последующая отладка и оптимизация кода могла бы занять весьма много времени. К счастью, ваш покорный слуга уже проделал этот труд и оформил результат в виде библиотеки под названием cl-astar. Эта библиотека также опирается на парадигму металингвистической абстракции, предоставляя набор макросов для создания предельно оптимизированной функции поиска пути в графе в соответствии с особенностями стоящей перед нами задачи.

Что ж, подключим библиотеку к нашему проекту, внеся изменения в файл ecs-tutorial-2.asd:

  ;; ...
  :depends-on (#:alexandria
               #:cl-astar               ;; здесь
               #:cl-fast-ecs
               #:cl-liballegro
               #:cl-liballegro-nuklear
               #:cl-tiled
               #:let-plus
               #:livesupport)
  ;; ...

...и добавим в src/package.lisp импорт макроса if-let из alexandria, он понадобится нам, чтобы написать чуть более элегантный код:

(defpackage #:ecs-tutorial-2
  (:use #:cl #:let-plus)
  (:import-from #:alexandria #:clamp #:define-constant #:if-let #:make-keyword)  ;; здесь
  (:import-from #:float-features #:single-float-nan #:float-nan-p)
  (:local-nicknames (#:tiled #:cl-tiled))
  (:export #:main))

Теперь нам нужно определить компоненты, в которых будет храниться информация о построенном пути. Тут может возникнуть вопрос, в каком виде хранить эти данные, ведь по сути они являются массивом точек, но если мы сделаем массив слотом компонента, это будет идти вразрез с методологией ECS, о чём нас любезно предупредит фреймворк warning'ом вида values will be boxed; consider using separate entities instead. Суть в том, что слоты компонентов сами по себе являются элементами больших массивов, в которых целочисленные сущности являются индексами, а массив с массивами ~это как пакет с пакетами~ довольно недружелюбен к кэшу процессора. Поэтому типичное решение такой проблемы — представлять элементы массива в виде отдельных сущностей с новым компонентом, хранящим необходимые данные. Что ж, определим в src/character.lisp нужные нам компоненты:

(ecs:defcomponent path-point
  (x 0.0 :type single-float)
  (y 0.0 :type single-float)
  (traveller -1 :type ecs:entity :index path-points))

(ecs:defcomponent path
  (destination-x 0.0 :type single-float)
  (destination-y 0.0 :type single-float))

Первый, path-point, будучи добавленным к отдельной сущности, будет представлять собой тот самый элемент массива точек пути. Помимо очевидных слотов x и y, мы определяем в нём индексированный слот по имени traveller с сущностью, которая следует по пути с этой точкой. Благодаря индексу на этом слоте мы сможем получить полный путь для любого заданного персонажа, а за счёт того, что индекс возвращает сущности в строго возрастающем порядке, точки всегда будут в правильной последовательности — в той, в которой они были изначально созданы.

Также мы определяем компонент path, который сигнализирует, что персонаж в данный момент следует по некоторому пути, и хранит информацию о его конечной точке. Обратите внимание, мы оставляем нетронутыми похожие по смыслу слоты в компоненте character: они будут указывать ближайшую точку пути, в которую движется персонаж, а в компоненте path будет храниться координата его конечной цели.

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

(ecs:defsystem follow-path
  (:components-ro (enemy path position)
   :components-rw (character))
  "Follows path previously calculated by A* algorithm."
  (if-let (first-point (first (path-points entity :count 1)))
    (with-path-point (point-x point-y) first-point
      (if (and (approx-equal position-x point-x)
               (approx-equal position-y point-y))
          (ecs:delete-entity first-point)
          (setf character-target-x point-x
                character-target-y point-y)))
    (delete-path entity)))

В ней мы с помощью макроса if-let кладём в переменную first-point и сразу проверяем на nil первую точку пути, полученную вызовом first на списке, возвращённом индексной функцией path-points. Если в пути есть хоть одна точка, т.е. first-point не равно nil, выполняется код внутри макроса with-path-point, заводящего для нас переменные point-x и point-y, в которые попадают значения слотов x и y из компонента path-point сущности first-point. Этот код проверяет вызовами нашей функции approx-equal, находится ли координата персонажа, position-x/position-y, рядом с координатой точки, и если это так, значит, точка достигнута, и она удаляется вызовом ecs:delete-entity — при этом точка будет автоматически удалена из индекса path-points. В противном случае у персонажа выставляются координаты target-x и target-y в компоненте character, чтобы он двигался по направлению к первой точке пути. Наконец, если в пути нет ни одной точки, то в переменной first-point оказывается nil, выполняется вторая ветка макроса if-let, которая удаляет у персонажа компонент path вызовом сгенерированной функции delete-path, таким образом, он прекращает движение и больше не будет обрабатываться данной системой.

Теперь реализуем с помощью библиотеки cl-astar функцию для поиска пути:

(a*:define-path-finder find-path (entity tile-width tile-height)
    (:variables ((world-width  (floor +window-width+  tile-width))
                 (world-height (floor +window-height+ tile-height)))
     :world-size (* world-width world-height)
     :indexer (a*:make-row-major-indexer
               world-width
               :node-width tile-width :node-height tile-height)
     :goal-reached-p (lambda (x1 y1 x2 y2)
                       (and (= (floor x1 tile-width)  (floor x2 tile-width))
                            (= (floor y1 tile-height) (floor y2 tile-height))))
     :neighbour-enumerator (lambda (x y f)
                             (let+ (((&values sx sy)
                                     (tile-start x y tile-width tile-height)))
                               (funcall (a*:make-8-directions-enumerator
                                         :node-width tile-width
                                         :node-height tile-height
                                         :max-x +window-width+
                                         :max-y +window-height+)
                                        sx sy f)))
     :exact-cost (lambda (x1 y1 x2 y2)
                   (if (or (obstaclep x2 y2 tile-width tile-height)
                           (and (/= x1 x2)
                                (/= y1 y2)
                                (or (obstaclep x1 y2 tile-width tile-height)
                                    (obstaclep x2 y1 tile-width tile-height))))
                       most-positive-single-float
                       0.0))
     :heuristic-cost (a*:make-octile-distance-heuristic)
     :path-initiator (lambda (length)
                       (declare (ignorable length))
                       (when (has-path-p entity)
                         (dolist (point (path-points entity))
                           (ecs:delete-entity point)))
                       (assign-path entity :destination-x goal-x
                                           :destination-y goal-y))
     :path-processor (lambda (x y)
                       (ecs:make-object
                        `((:path-point :x ,x :y ,y :traveller ,entity)
                          (:parent :entity ,entity))))))

Мы вызываем ключевой макрос библиотеки, define-path-finder, в который передаём аргументы и фрагменты кода, подстраивающие поиск пути под наши конкретные условия. Прежде всего, мы указываем имя определяемой функции, find-path, и дополнительные кейворд-аргументы для неё — entity (сущность персонажа), tile-width и tile-height, размеры тайлов (мы решили задавать их динамически, поэтому нам придётся до победного конца прокидывать их во все функции). Далее мы указываем в параметре variables локальные переменные, которые понадобятся нам в наших фрагментах кода — это world-width и world-height, размеры экрана в тайлах. Мы также указываем параметром world-size размер всего нашего игрового мира в тайлах, рассчитывая его как произведение world-width на world-height. Далее мы прописываем параметры-функции (это могут быть lambda-формы или функции/макросы, возвращающие другие функции), которые станут составными частями создаваемой функции поиска пути find-path:

• indexer — функция от координат, возвращающая целочисленный индекс соответствующего им тайла в массиве длиной world-size. Мы передаём в этот параметр результат работы макроса из cl-astar, make-row-major-indexer, который создаёт функцию, возвращающую индексы тайлов в построчном порядке (англ. row-major order), предполагая, что размеры тайлов переданы в параметрах node-width и node-height — мы передаём туда tile-width и tile-height соответственно.

• goal-reached-p — функция-предикат от пары координат, возвращающая булевскую истину, если персонаж, находясь в первых координатах, считается достигшим своей цели, находящейся во вторых. Здесь мы просто сравниваем номера тайлов, деля координаты нацело на их размеры с помощью floor.

• neighbour-enumerator — функция, принимающая координаты и другую функцию, которую она обязана вызвать для каждого соседа тайла с указанными координатами. Здесь мы надстраиваемся над макросом make-8-directions-enumerator, предоставляемым библиотекой для окрестности с 8 соседями (два вертикальных направления, два горизонтальных и четыре диагональных): мы вызываем нашу функцию tile-start и передаём внутрь сгенерированной макросом функции через funcall не абы что, а координаты начала тайла.

• exact-cost — функция, принимающая координаты двух тайлов и возвращающая точную стоимость перемещения из одного в другой, подразумевая, что тайлы являются соседними. Здесь мы используем старую знакомую, функцию obstaclep, вызывая её для координат точки назначения x2/y2, а также при диагональном передвижении, когда x1 не равно x2 и y1 не равно y2, для промежуточных перпендикулярных тайлов, пересекаемых персонажем. Если хоть в одном месте персонаж задевает непроходимый тайл, мы возвращаем из функции most-positive-single-float — максимальное число типа single-float, которое по совместительству сигнализирует создаваемой функции поиска пути, что заданное перемещение невозможно.

• heuristic-cost — функция, возвращающая эвристическую оценку стоимости пути из одной произвольной точки в другую. Для случаев окрестности из 8 соседей, а это как раз наш случай, хорошо подходит манхэттенская метрика с учётом диагональных перемещений, т.н. октильное расстояние (англ. octile distance). Хороший обзор разных метрик можно найти на замечательном ресурсе, посвящённом алгоритму A*, Amit’s A* Pages. Мы используем готовую октильную метрику из библиотеки, вызывая макрос make-octile-distance-heuristic.

• path-initiator — первая из двух функций, обрабатывающих найденный путь. Если путь был найден, первым делом вызывается она с его длиной. Длина нас не интересует, мы её игнорируем декларацией ignorable. В самой функции мы проверяем предикатом has-path-p, есть ли уже у сущности персонажа путь, и если он есть, проходимся по всем его точкам, полученным вызовом индексной функции path-points с помощью dolist, и удаляем их вызовом ecs:delete-entity. Затем мы присваиваем слотам destination-x и destination-y компонента path значения goal-x и goal-y сгенерированной ECS-фреймворком функцией assign-path (при этом если компонент path до этого у сущности персонажа отсутствовал, он будет автоматически создан). Переменные goal-x и goal-y являются параметрами создаваемой функции find-path.

• path-processor — ключевая функция обработки результата. Она вызывается с координатами каждой точки найденного пути, включая начальную и конечную. В этой функции мы для каждой координаты создаём сущность с компонентом path-point с соответствующими координатами и parent из соображений правильного управления памятью — если перемещающийся по пути персонаж будет удалён, все точки пути также должны быть за ненадобностью удалены.

Наконец, внесём изменения в систему handle-enemies, чтобы враги не просто устремлялись по прямой сквозь твёрдые предметы к персонажу игрока, а использовали определённую нами функцию поиска пути:

(ecs:defsystem handle-enemies
  (:components-ro (position size enemy)                                          ;; здесь
   :components-rw (character)
   :after (render-images)
   :with ((player-x player-y) := (with-position () (player-entity 1)
                                   (values x y))))
  (when (and (approx-equal position-x player-x enemy-vision-range)
             (approx-equal position-y player-y enemy-vision-range)               ;; и здесь
             (not (and (has-path-p entity)                                       ;;
                       (approx-equal                                             ;;
                        (path-destination-x entity) player-x size-width)         ;;
                       (approx-equal                                             ;;
                        (path-destination-y entity) player-y size-height))))     ;;
    (find-path position-x position-y player-x player-y                           ;;
               :entity entity :tile-width size-width :tile-height size-height))  ;;
  (when (and (approx-equal position-x player-x enemy-attack-range)
             (approx-equal position-y player-y enemy-attack-range)
             (not *should-quit*))
    (setf *should-quit* t)
    (al:show-native-message-box (cffi:null-pointer)
                                "ECS Tutorial 2" "" "You died"
                                (cffi:null-pointer) :warn)))

Теперь мы при проверке области видимости врага также проверяем, есть ли у него путь, по которому он преследует игрока, и совпадает ли конечная точка пути с координатами игрока с точностью до размеров тайла. Если хотя бы одно из этих условий ложно, мы вызываем определённую выше функцию find-path с координатами начала пути (текущие координаты position-x и position-y), координатами его конца (координаты игрока player-x и player-y) и необходимыми ей кейворд-аргументами.

Перезагрузим определение системы вызовом (ql:quickload :ecs-tutorial-2) — ничего не попишешь, мы добавили новую библиотеку в список зависимостей проекта. Мы увидим, что расставленные нами на карте враги действительно бегают за игроком, при этом вежливо оббегая препятствия:

Почему-то при виде такого в голове сразу начинает играть Yakety Sax ?

Интерфейсы

Закончив с подземным окружением, в котором будет действовать игрок, нам может захотеться добавить в игру некоторый нарративный элемент. Для этого нам понадобится пользовательский интерфейс, но для его реализации не подойдут классические используемые в деле создания GUI библиотеки вроде Qt или GTK, так как наши элементы управления будут отрисовываться не на обычном окне ОС, а на графическом контексте, создаваемом liballegro для передачи в него у себя под капотом команд OpenGL. На помощь нам придут специализированные библиотеки, созданные именно для добавления пользовательских интерфейсов в видеоигры. Существует немало таких библиотек, для наших целей мы выберем написанную на чистом C библиотеку Nuklear, так как есть биндинг к Common Lisp для использования её вместе с liballegro, поддерживаемый вашим покорным слугой. Помимо возможности вызова функций из библиотеки, этот биндинг также предоставляет симпатичный DSL для создания интерфейсов, в полном соответствии с парадигмой металингвистической абстракции. Пока декларативный интерфейс включает в себя необходимый минимум инструментов, но в целом библиотека представляет собой полноценный биндинг.

Для начала добавим библиотеку к зависимостям нашего проекта в файле ecs-tutorial-2.asd. На самом деле, она уже прописана в шаблоне, но нужно отдельно прописать зависимость от декларативного интерфейса, вынесенного в отдельный пакет:

  ;; ...
  :license "MIT"
  :depends-on (#:alexandria
               #:cl-fast-ecs
               #:cl-liballegro
               #:cl-liballegro-nuklear
               #:cl-liballegro-nuklear/declarative  ;; здесь
               #:cl-tiled
               #:let-plus
               #:livesupport)
  ;; ...

Пока мы здесь, добавим отсылку на новый файл src/narrative.lisp, который мы также добавим в проект:

  ;; ...
  :components ((:module "src"
              :components
              ((:file "package")
               (:file "common")
               (:file "animation")
               (:file "map")
               (:file "narrative")  ;; здесь
               (:file "character")
               (:file "main"))))
  ;; ...

Также в файле src/package.lisp добавим псевдоним для библиотеки, чтобы вместо длинного cl-liballegro-nuklear/declarative:something можно было писать просто ui:something:

(defpackage #:ecs-tutorial-2
  (:use #:cl #:let-plus)
  (:import-from #:alexandria #:clamp #:define-constant #:make-keyword)
  (:import-from #:float-features #:single-float-nan #:float-nan-p)
  (:local-nicknames (#:tiled #:cl-tiled)
                    (#:ui #:cl-liballegro-nuklear/declarative))         ;; здесь
  (:export #:main))

Закинем в каталог Resources шрифт Alegreya, который мы будем использовать для интерфейса — его можно скачать с Google Fonts, не забыв переименовать файл AlegreyaSC-Regular.ttf в alegreya-sc.ttf (так мы будем ссылаться на него в коде из эстетических соображений).

В новом файле src/narrative.lisp добавим обязательную шапку с активацией пакета нашего проекта и определение окна, в котором мы будем отображать наши нарративы:

(in-package #:ecs-tutorial-2)


(ui:defwindow narrative (&key text)
    (:x (truncate +window-width+ 4) :y (truncate +window-height+ 4)
     :w (truncate +window-width+ 2) :h (truncate +window-height+ 2))
  (ui:layout-space (:height (truncate +window-height+ 4) :format :dynamic)
    (ui:layout-space-push :x 0.05 :y 0.15 :w 0.9 :h 1.2)
    (ui:label-wrap text)
    (ui:layout-space-push :x 0.5 :y 1.4 :w 0.4 :h 0.35)
    (ui:button-label "Ok"
      t)))

Вызов макроса ui:defwindow определяет функцию с заданным именем (narrative) и кейворд-аргументами (text, в нём мы ожидаем текст для отображения), которая будет отображать интерфейсное окно в нашей игре с заданными далее параметрами, в частности, координатами расположения на экране, x и y, шириной w и высотой h. В коде самой функции мы используем вспомогательный макрос ui:layout-space и функцию ui:layout-space-push для задания расположения виджетов на окне; более подробно об этих механизмах можно прочитать в (довольно сухой) документации Nuklear, однако практика показывает, что гораздо легче при создании интерфейсов пользоваться методом тыка, благо, Lisp позволяет нам снова и снова менять определение функции narrative прямо во время работы программы, нажимая волшебные клавиши Ctrl-C Ctrl-C (или другие, в зависимости от используемой вами IDE):

На самом окне мы выводим два виджета — текстовую метку, создаваемую вызовом ui:label-wrap ("wrap" означает, что текст будет автоматически переноситься на новую строку) и кнопку с надписью Ok, создаваемую макросом ui:button-label. Последний макрос устроен интересным образом: в нём после текста на кнопке прописывается код, который будет выполнен, когда кнопка будет нажата пользователем. В нашем случае мы при этом просто возвращаем из функции narrative значение булевской истины, t; в случае, когда кнопка будет отрисована, но не нажата, этот макрос будет автоматически возвращать булевскую ложь, nil. Такое устройство диктуется тем, что Nuklear является библиотекой так называемого прямого режима (англ. immediate mode) — в нём, в отличие от классического подхода, называемого режимом с сохранением состояния (англ. retained mode), виджеты не сохраняются отдельными объектами в памяти, а отрисовываются и обрабатываются заново на каждом кадре — это имеет смысл для игр с их главным игровым циклом, на каждой итерации которого новый кадр и так рисуется заново с нуля. Таким образом, мы не можем прописать обработку нажатия на кнопку в каком-нибудь методе или привязать к какой-нибудь функции обратного вызова, всё, что мы можем — запускать такой код каждый раз, проверяя, наступило ли конкретное событие, например, нажатие на кнопку.

Теперь для того, чтобы вся эта красота заработала, нужно внести изменения в src/main.lisp для корректной инициализации, работы и финализации UI-библиотеки cl-liballegro-nuklear:

(define-constant +font-path+ "inconsolata.ttf" :test #'string=)
(define-constant +font-size+ 24)
(define-constant +ui-font-path+ "alegreya-sc.ttf" :test #'string=)  ;; здесь
(define-constant +ui-font-size+ 28)                                 ;;

;; ...

(defun update (dt ui-context)                                       ;; здесь
  (unless (zerop dt)
    (setf *fps* (round 1 dt)))
  (ecs:run-systems :dt (float dt 0.0) :ui-context ui-context))      ;; и здесь

(defvar *font*)

(defun render ()
  (nk:allegro-render)                                               ;; здесь
  (al:draw-text *font* (al:map-rgba 255 255 255 0) 0 0 0
                (format nil "~d FPS" *fps*)))

;; ...

             (loop
               :named main-game-loop
               :with *font* := (al:ensure-loaded #'al:load-ttf-font
                                                 +font-path+
                                                 (- +font-size+) 0)
               :with ui-font := (al:ensure-loaded                          ;; здесь
                                 #'nk:allegro-font-create-from-file        ;;
                                 +ui-font-path+ (- +ui-font-size+) 0)      ;;
               :with ui-context := (nk:allegro-init ui-font display        ;;
                                                    +window-width+         ;;
                                                    +window-height+)       ;;
               :with ticks :of-type double-float := (al:get-time)
               :with last-repl-update :of-type double-float := ticks
               :with dt :of-type double-float := 0d0
               :while (loop
                        :named event-loop
                        :initially (nk:input-begin ui-context)             ;;
                        :while (al:get-next-event event-queue event)
                        :for type := (cffi:foreign-slot-value
                                      event '(:union al:event) 'al::type)
                        :do (nk:allegro-handle-event event)                ;;
                        :always (not (eq type :display-close))
                        :never *should-quit*
                        :finally (nk:input-end ui-context))                ;;

               ;; ...

                   (livesupport:continuable
                     (update dt ui-context)                                ;;
                     (narrative ui-context :text "Hello")                  ;;
                     (render))
                   (al:flip-display)
               :finally (nk:allegro-shutdown)                              ;;
                        (nk:allegro-font-del ui-font)                      ;;
                        (al:destroy-font *font*)))

Загрузив накопившиеся изменения в системе вызовом (ql:quickload :ecs-tutorial-2) и запустив (ecs-tutorial-2:main), мы увидим определённое нами нарративное окно:

Из коробки окно выглядит довольно невзрачно, только шрифт красивый. Давайте это исправим, воспользовавшись широкими возможностями кастомизации стиля Nuklear (см., например, галерею на Github проекта). Для этого первым делом скачаем по ссылке архив kenney_fantasy-ui-borders.zip с оформлением элементов интерфейса (если есть возможность, можно задонатить автору, а можно нажать ссылку "Continue without donating...", чтобы скачать бесплатно) и распакуем из него файлы panel-000.png, panel-001.png и panel-031.png из подкаталога /PNG/Double/Panel, либо другие на ваш вкус, в наш каталог Resources. Затем обработаем последние два файла с тем, чтобы добавить в них прозрачность следующими командами ImageMagick, запущенными в том же Resources:

convert panel-031.png -matte -channel A +level 40% +channel panel-031.png
cp panel-001.png panel-0011.png
convert panel-001.png -matte -channel A +level 40% +channel panel-001.png

Теперь в файле src/narrative.lisp определим для простоты глобальные переменные, в которых будем хранить загруженные изображения:

(defvar *window-background*)
(defvar *button-normal-background*)
(defvar *button-hover-background*)
(defvar *button-active-background*)

Кроме того, определим две функции — для собственно загрузки и выгрузки этих изображений:

(defun load-ui ()
  (flet ((load-ui-image (name)
           (al:ensure-loaded #'nk:allegro-create-image name)))
    (setf *window-background*        (load-ui-image "panel-031.png")
          *button-normal-background* (load-ui-image "panel-001.png")
          *button-active-background* (load-ui-image "panel-000.png")
          *button-hover-background*  (load-ui-image "panel-0011.png"))))

(defun unload-ui ()
  (nk:allegro-del-image *window-background*)
  (nk:allegro-del-image *button-normal-background*)
  (nk:allegro-del-image *button-active-background*)
  (nk:allegro-del-image *button-hover-background*))

В функции load-ui мы определяем с помощью flet локальную функцию load-ui-image, которая вызывает функцию из cl-liballegro-nuklear, nk:allegro-create-image, для загрузки изображения в понятном библиотеке формате, и al:ensure-loaded для обработки потенциальных ошибок в ней. Далее мы используем load-ui-image для загрузки нужных нам изображений из каталога ресурсов.

Функция unload-ui освобождает загруженные изображения вызовом nk:allegro-del-image, так как они создаются на стороне C-шного кода и, опять-таки, лисповский сборщик мусора над ними бессилен.

Добавим вызовы этих функций в файл src/main.lisp, в функции init и main:

(defun init ()
  (ecs:bind-storage)
  (load-ui)                 ;; здесь
  (load-map "level1.tmx"))

;; ...

                   (al:flip-display)
               :finally (unload-ui)                    ;; и здесь
                        (nk:allegro-shutdown)
                        (nk:allegro-font-del ui-font)
                        (al:destroy-font *font*)))

Теперь мы можем использовать эти изображения в нашей функции narrative в одноимённом файле src/narrative.lisp с помощью кейворд-аргумента styles макроса ui:defwindow:

(ui:defwindow narrative (&key text)
    (:x (truncate +window-width+ 4) :y (truncate +window-height+ 4)
     :w (truncate +window-width+ 2) :h (truncate +window-height+ 2)
     :styles ((:item-9slice :window-fixed-background *window-background*)   ;; здесь
              (:item-9slice :button-normal *button-normal-background*)      ;;
              (:item-9slice :button-hover *button-hover-background*)        ;;
              (:item-9slice :button-active *button-active-background*)      ;;
              (:color :text-color :r 0 :g 0 :b 0)                           ;;
              (:color :button-text-normal :r 0 :g 0 :b 0)                   ;;
              (:color :button-text-hover :r 0 :g 0 :b 0)                    ;;
              (:color :button-text-active :r 0 :g 0 :b 0)))                 ;;
  (ui:layout-space (:height (truncate +window-height+ 4) :format :dynamic)
    (ui:layout-space-push :x 0.05 :y 0.15 :w 0.9 :h 1.2)
    (ui:label-wrap text)
    (ui:layout-space-push :x 0.5 :y 1.4 :w 0.4 :h 0.35)
    (ui:button-label "Ok"
      t)))

Отправив в Lisp-процесс все новые и изменившиеся формы (defvar картинок, narrative, load-ui, unload-ui, init и main) и перезапустив ecs-tutorial-2:main, мы увидим гораздо более эстетично оформленное окно:

Наконец, с помощью этого окна реализуем повествование через окружение (англ. environmental storytelling), сделав объекты, при приближении к которым персонажа игрока будет выводиться соответствующий им текст. Определим для них следующий компонент в src/narrative.lisp:

(ecs:defcomponent narrative
  (text "" :type string)
  (shown nil :type boolean)
  (active nil :type boolean :index active-narratives))

В нём, помимо самого текста в слоте text, мы будем хранить булевский флажок shown, отвечающий за то, было ли уже показано игроку окно с этим текстом — мы ведь не хотим надоедать игроку и показывать текст каждый раз, когда он проходит мимо какого-то объекта; пускай во все разы, кроме первого, игрок явно нажимает какую-нибудь клавишу, например, E, чтобы заново прочитать текст. Кроме того, мы определяем в компоненте ещё один слот булевского типа, active, который будет указывать на то, отображается ли в данный момент окно нарратива на экране. Мы также определяем индекс на этом слоте, active-narratives, с тем, чтобы можно было понять, отображается ли в данный момент времени на экране хотя бы одно нарративное окно — мы будем при этом ставить все активные процессы, такие как передвижение персонажей, на паузу, чтобы у игрока была возможность спокойно прочитать текст.

Теперь уберём из функции main в src/main.lisp демонстрационный вызов (narrative ui-context :text "Hello") и определим систему для отображения объектов с нарративом:

(defconstant +interact-distance-factor+ 1.2)

(ecs:defsystem show-narrative
  (:components-ro (position)
   :components-rw (narrative)
   :arguments ((ui-context cffi:foreign-pointer))
   :with ((player-x player-y dx dy) :=
          (let ((player (player-entity 1)))
            (values
             (position-x player)
             (position-y player)
             (* +interact-distance-factor+ (size-width player))
             (* +interact-distance-factor+ (size-height player))))))
  (al:with-current-keyboard-state keyboard-state
    (when (and (approx-equal position-x player-x dx)
               (approx-equal position-y player-y dy)
               (or narrative-active
                   (not narrative-shown)
                   (al:key-down keyboard-state :E)))
      (setf narrative-shown t
            narrative-active t)
      (when (or (narrative ui-context :text narrative-text)
                (al:key-down keyboard-state :escape)
                (al:key-down keyboard-state :space)
                (al:key-down keyboard-state :enter))
        (setf narrative-active nil)))))

Сначала мы определяем константу +interact-distance-factor+ — это тщательно подобранный экспериментальным образом множитель размера тайла для подсчёта расстояния от объекта с нарративом, на котором будет срабатывать открытие его окна. В системе с помощью аргумента with мы получаем координаты персонажа игрока в переменные player-x и player-y, а также размеры тайла персонажа, домноженные на константу +interact-distance-factor+, в переменные dx и dy. Далее, весь код системы завёрнут в уже знакомый нам макрос with-current-keyboard-state из библиотеки cl-liballegro, который заводит на стеке C-шную структуру ALLEGRO_KEYBOARD_STATE, заполняет её текущим состоянием клавиш на клавиатуре и кладёт в указатель, который мы называем keyboard-state, её адрес.

Затем в коде для каждого нарративного объекта мы проверяем, находится ли он в пределах нужного расстояния, вызовом нашей старой знакомой, функции approx-equal. Кроме того, проверяется ещё три условия:

1. окно с нарративом активно на данный момент,

2. окно не было показано ранее,

3. нажата клавиша взаимодействия с объектом, E на клавиатуре (с помощью вызова al_key_down)

— должно быть истинно хотя бы одно из этих условий для отображения окна с текстом. Когда мы убедились, что нужно показывать окно, мы выставляем флаги shown и active объекта-нарратива в булевскую истину t и запускаем функцию narrative с аргументом ui-context, любезно переданным нам из функции update, и текстом из слота text компонента narrative. Мы тут же проверяем возвращаемое функцией значение (напомним, она возвращает истинное значение, если была нажата кнопка Ok, и ложное в противном случае), а также факт нажатия на клавиатуре одной из кнопок Esc, пробел или Enter, и если хотя бы одно из этих условий истинно, мы закрываем окно, выставляя слот active в ложь, nil, таким образом, на следующей итерации игрового цикла окно уже не будет отображаться.

Теперь нам остаётся только добавить кастомный тип narrative в редакторе пользовательских типов Tiled с полем text типа string:

...и добавить это свойство под тем же названием, narrative, к объектам на слое с объектами. Здесь есть тонкость, связанная с нашим механизмом определения препятствий: если мы хотим, чтобы объект был при этом также непроходимым для персонажей, необходимо, чтобы его координаты были кратны размерам тайла — в этом можно убедиться, выставив вручную свойства X и Y в редакторе свойств объекта:

Отправив в Lisp-процесс определения константы +interact-distance-factor+, компонента narrative и системы show-narrative, а также изменённую функцию main, после перезапуска последней мы увидим наше повествование через окружение в действии:

Однако можно заметить, что при отображении окна подземелье продолжает жить своей жизнью — враги продолжают погоню за игроком, а сам игрок может перемещаться в пространстве. Дадим возможность игроку насладиться спокойным чтением текста, модифицировав системы move-characters и control-player следующим образом:

(ecs:defsystem move-characters
  (:components-rw (position character)
   :components-ro (size)
   :when (null (active-narratives t))   ;; здесь
   :arguments ((dt single-float)))
   ;; ...

(ecs:defsystem control-player
  (:components-ro (player position size)
   :components-rw (character)
   :after (move-characters)
   :when (null (active-narratives t)))  ;; здесь
   ;; ...

С помощью аргумента when мы разрешаем выполнение этих систем только в том случае, когда индексная функция active-narratives возвращает nil, будучи вызванной с аргументом t, т.е. когда ни одно окно с нарративом не активно.

Наконец, в качестве финального штриха добавим в нашу игру условие победы, раз уж условия поражения уже есть. Для этого добавим в src/narrative.lisp ещё один компонент-тег, win:

(ecs:defcomponent win)

Будем считать, что он сопутствует компоненту narrative, в котором будет отображаться текст, поздравляющий игрока с победой, и что после нажатия Ok в таком нарративном окне игра должна завершаться. Внесём соответствующие изменения в систему show-narrative:

(ecs:defsystem show-narrative
  (:components-ro (position)
   :components-rw (narrative)
   :arguments ((ui-context cffi:foreign-pointer))
   :with ((player-x player-y dx dy) :=
          (let ((player (player-entity 1)))
            (values
             (position-x player)
             (position-y player)
             (* +interact-distance-factor+ (size-width player))
             (* +interact-distance-factor+ (size-height player))))))
  (al:with-current-keyboard-state keyboard-state
    (when (and (approx-equal position-x player-x dx)
               (approx-equal position-y player-y dy)
               (or narrative-active
                   (not narrative-shown)
                   (al:key-down keyboard-state :E)))
      (setf narrative-shown t
            narrative-active t)
      (when (or (narrative ui-context :text narrative-text)
                (al:key-down keyboard-state :escape)
                (al:key-down keyboard-state :space)
                (al:key-down keyboard-state :enter))
        (setf narrative-active nil)
        (when (has-win-p entity)                                      ;; здесь
          (setf *should-quit* t))))))                                 ;;

Также добавим новый компонент в редакторе пользовательских типов Tiled:

На данный момент игра приобретает свой финальный вид — преодолевая сложные препятствия, игрок, знакомясь с окружающим миром, достигает победы ?

Заключение

Оглядываясь на немалый пройденный путь, мы ещё раз посмотрели на возможности ECS-фреймворка на Common Lisp cl-fast-ecs, а также познакомились с новыми библиотеками cl-tiled, cl-astar и cl-liballegro-nuklear. В итоге мы реализовали Souls-like dungeon crawler с повествованием через окружение, ИИ врагов, и графическим интерфейсом в полтысячи строк кода, что свидетельствует о преимуществах металингвистической абстракции и архитектуры Entity-Component-System (и data-driven подхода в целом). Безусловно, приведённый дизайн компонентов и систем игры не является единственно верным и лишь скромно предлагается нами в качестве отправной точки для вашего творчества. Напомним, что полный код нашего dungeon crawler'а можно найти на github; помимо рассмотренного в руководстве кода, он также содержит необязательные декларации типов с помощью макроса declaim, помогающие компилятору сгенерировать чуть более эффективный код для нашей игры и выжать из него несколько тысяч FPS ?

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

Если вы хотите попробовать свои силы в создании игр на Lisp и получить фидбек от сообщества, приглашаю вас на онлайн-ивент по разработке игр Autumn Lisp Game Jam 2024, который пройдёт на платформе для инди-разработчиков itch.io уже на следующей неделе, 25 октября 2024 (не огорчайтесь, если вы читаете статью в далёком будущем и уже пропустили этот ивент, он регулярно проходит два раза в год, в апреле и в октябре). На этом геймджеме вы в течение 10 дней создаёте игру с использованием любого диалекта Lisp (я, конечно, рекомендую к использованию Common Lisp), а затем голосуете за работы коллег и получаете от них обратную связь по своей. В частности, эта часть руководства была написана по мотивам игры Thoughtbound, созданной для Spring Lisp Game Jam 2023.

В следующей части руководства мы добавим масштабности, а также хитроумия ИИ и попробуем свои силы в жанре стратегии реального времени. Подпишитесь на мой telegram-канал о разработке видеоигр на лиспе, чтобы не пропустить следующую часть.

Английская версия статьи

Ссылка на перевод статьи на английский

Благодарности

Хотелось бы поблагодарить моего товарища Сергея @ViruScD за поддержку и помощь в написании статьи, а так же Григория и liltechdude за помощь с вычиткой текста.