Convert TMX maps to a parseable list

This allows embedding the map data directly
into the game system, instead of relying on
external files!
This’ll make distribution easier, for sure. =w=
This commit is contained in:
Jaidyn Ann 2023-06-26 20:25:02 -05:00
parent c0d2099ae8
commit 74d713b76d
12 changed files with 124 additions and 43 deletions

11
Makefile Normal file
View File

@ -0,0 +1,11 @@
LISP ?= ecl
maps:
$(LISP) \
--load "res/maps/tmx→lisp.lisp"
build:
$(LISP) \
--eval '(ql:quickload :flora-search-aurora)' \
--eval '(asdf:make :flora-search-aurora)' \
--eval '(quit)'

View File

@ -295,9 +295,8 @@ The data returned is a list of the boxes top-left coordinate, max-column,
and max-row; for use with RENDER-STRING. Like so: and max-row; for use with RENDER-STRING. Like so:
((:x X :y Y) MAX-COLUMN MAX-ROW)" ((:x X :y Y) MAX-COLUMN MAX-ROW)"
(let* ((speaker-id (dialogue-speaker dialogue)) (let* ((speaker-id (dialogue-speaker dialogue))
(direction (🌍:getf-entity-data map speaker-id :direction))
(playerp (eq speaker-id '🌍:player)) (playerp (eq speaker-id '🌍:player))
(leftp (not (eq direction '🌍:right))) (leftp (not (🌍:getf-entity-data map speaker-id :facing-right)))
(text (getf dialogue :text)) (text (getf dialogue :text))
(coords (🌍:world-coords->screen-coords (🌍:getf-entity-data map speaker-id :coords)))) (coords (🌍:world-coords->screen-coords (🌍:getf-entity-data map speaker-id :coords))))
;; Ideally, place text-box above/below (NPC/player); otherwise, place it behind speaker ;; Ideally, place text-box above/below (NPC/player); otherwise, place it behind speaker

View File

@ -24,7 +24,6 @@
(load "display.lisp") (load "display.lisp")
(load "ui.lisp") (load "ui.lisp")
(load "overworld.util.lisp") (load "overworld.util.lisp")
(load "overworld.tiled.lisp")
(load "overworld.lisp") (load "overworld.lisp")
(load "dialogue.lisp") (load "dialogue.lisp")
(load "engine.lisp") (load "engine.lisp")
@ -39,6 +38,8 @@
(in-package :flora-search-aurora) (in-package :flora-search-aurora)
(defvar *casino-map* nil)
(defvar *outdoors-map* nil)
@ -96,7 +97,10 @@ Should be the `interact` function for takeable items."
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; The Outside World™ ;;; The Outside World™
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
(defparameter *outdoors-map* (overworld.tiled:load-map (format nil "~Ares/map.tmx" (uiop:getcwd)))) (load "res/maps/outdoors.tmx.lisp")
(defun casino-entrance-trigger (&optional map)
(list :map (🌍:merge-maps map *casino-map*)))
@ -179,12 +183,7 @@ Should be the `interact` function for takeable items."
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; Casino! ;;; Casino!
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
(defparameter *casino-map* (overworld.tiled:load-map (format nil "~Ares/casino.tmx" (uiop:getcwd)))) (load "res/maps/casino.tmx.lisp")
(defun casino-entrance-trigger (&optional map)
(list :map (🌍:merge-maps map *casino-map*)))
(defun casino-exit-trigger (&optional map) (defun casino-exit-trigger (&optional map)
(list :map (🌍:merge-maps map *outdoors-map*))) (list :map (🌍:merge-maps map *outdoors-map*)))

View File

@ -20,13 +20,14 @@
(defpackage :flora-search-aurora.overworld (defpackage :flora-search-aurora.overworld
(:nicknames :fsa.o :overworld :🌍) (:nicknames :fsa.o :overworld :🌍)
(:use :cl (:use :cl
:flora-search-aurora.overworld.tiled :flora-search-aurora.overworld.util) :flora-search-aurora.overworld.util)
(:export #:overworld-state #:make-overworld-state #:overworld-state-draw (:export #:overworld-state #:make-overworld-state #:overworld-state-draw
#:merge-maps #:merge-maps
#:world-coords->screen-coords #:world-coords->screen-coords
#:getf-entity #:getf-entity-data #:removef-entity #:getf-entity #:getf-entity-data #:removef-entity
#:aget-item #:getf-act #:getf-know #:aget-item #:getf-act #:getf-know
#:move-entity-to #:move-entity #:move-entity-to #:move-entity
#:plist->map
:left :right :left :right
:player)) :player))
@ -152,6 +153,30 @@ replays of the game."
(return trigger))))) (return trigger)))))
;;; ———————————————————————————————————
;;; Map conversions & manipulations
;;; ———————————————————————————————————
(defun merge-maps (map-a map-b)
"Copy data that should be persistent between maps from map-a to map-b.
Used primarily in moving between different maps in an overworld state."
;; Copy over important game-data from map-a.
(mapcar
(lambda (map-key)
(setf (gethash map-key map-b) (gethash map-key map-a)))
'(:acts :knows :items :seconds :day))
;; Copy specific bits of player data from map-as :ENTITIES.
(mapcar
(lambda (player-key)
(setf (getf-entity-data map-b 'player player-key)
(getf-entity-data map-a 'player player-key)))
'(:face :normal-face :talking-face))
map-b)
;;; ——————————————————————————————————— ;;; ———————————————————————————————————
;;; Overworld logic ;;; Overworld logic
@ -231,9 +256,9 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
(defun move-entity (map entity-id &key (Δx 0) (Δy 0)) (defun move-entity (map entity-id &key (Δx 0) (Δy 0))
"Move an entity relative to its current position." "Move an entity relative to its current position."
(when (< Δx 0) (when (< Δx 0)
(setf (getf-entity-data map entity-id :direction) 'left)) (setf (getf-entity-data map entity-id :facing-right) nil))
(when (> Δx 0) (when (> Δx 0)
(setf (getf-entity-data map entity-id :direction) 'right)) (setf (getf-entity-data map entity-id :facing-right) 't))
(let ((coords (getf-entity-data map entity-id :coords))) (let ((coords (getf-entity-data map entity-id :coords)))
(move-entity-to map entity-id (move-entity-to map entity-id
:x (+ Δx (getf coords :x)) :x (+ Δx (getf coords :x))
@ -331,11 +356,10 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
(defun matrix-write-entity-head (matrix entity-plist) (defun matrix-write-entity-head (matrix entity-plist)
"Draw an entitys head. There aren't any Mami Tomoes in this game, dang it!" "Draw an entitys head. There aren't any Mami Tomoes in this game, dang it!"
(let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords))) (let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords)))
(direction (getf entity-plist :direction))
(face (getf entity-plist :face)) (face (getf entity-plist :face))
(width (+ (length face) 2)) ;; Face + |borders| (width (+ (length face) 2)) ;; Face + |borders|
(y (- (getf screen-coords :y) 1)) (y (- (getf screen-coords :y) 1))
(x (if (eq direction 'right) (x (if (getf entity-plist :facing-right)
(- (getf screen-coords :x) (floor (/ width 2)) 0) (- (getf screen-coords :x) (floor (/ width 2)) 0)
(- (getf screen-coords :x) (floor (/ width 2)) 0)))) (- (getf screen-coords :x) (floor (/ width 2)) 0))))
(📋:render-line matrix face (+ x 1) y) (📋:render-line matrix face (+ x 1) y)
@ -348,9 +372,8 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
"Draw a bipdel entitys legs — a surprisingly in-depth task!" "Draw a bipdel entitys legs — a surprisingly in-depth task!"
(let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords))) (let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords)))
(x (getf screen-coords :x)) (x (getf screen-coords :x))
(y (getf screen-coords :y)) (y (getf screen-coords :y)))
(direction (getf entity-plist :direction))) (cond ((getf entity-plist :facing-right)
(cond ((eq direction 'right)
(ignore-errors (setf (aref matrix y x) #\|)) (ignore-errors (setf (aref matrix y x) #\|))
(ignore-errors (setf (aref matrix y (- x 1)) #\|))) (ignore-errors (setf (aref matrix y (- x 1)) #\|)))
('t ('t
@ -396,19 +419,3 @@ A state-function for use with STATE-LOOP."
(lambda (matrix &key (map map)) (lambda (matrix &key (map map))
(apply #'🌍:overworld-state (apply #'🌍:overworld-state
(list matrix :map map)))) (list matrix :map map))))
(defun merge-maps (map-a map-b)
"Copy data that should be persistent between maps from map-a to map-b."
;; Copy over important game-data from map-a.
(mapcar
(lambda (map-key)
(setf (gethash map-key map-b) (gethash map-key map-a)))
'(:acts :knows :items :seconds :day))
;; Copy specific bits of player data from map-as :ENTITIES.
(mapcar
(lambda (player-key)
(setf (getf-entity-data map-b 'player player-key)
(getf-entity-data map-a 'player player-key)))
'(:face :normal-face :talking-face))
map-b)

View File

@ -19,7 +19,7 @@
(defpackage :flora-search-aurora.overworld.tiled (defpackage :flora-search-aurora.overworld.tiled
(:nicknames :fsa.o.t :overworld.tiled :🌍.🀨) (:nicknames :fsa.o.t :overworld.tiled :🌍.🀨)
(:use :cl :anaphora-basic (:use :cl
:flora-search-aurora.overworld.util) :flora-search-aurora.overworld.util)
(:export #:load-map)) (:export #:load-map))
@ -74,10 +74,7 @@ character-scale world coordinates in plist form."
:face (gethash "normal-face" properties) :face (gethash "normal-face" properties)
:coords (tiled-coords->world-coords (cl-tiled:object-x tiled-obj) :coords (tiled-coords->world-coords (cl-tiled:object-x tiled-obj)
(cl-tiled:object-y tiled-obj) (cl-tiled:object-y tiled-obj)
tiled-map) tiled-map))))))
:direction (if (gethash "facing-right" properties)
'right
'left))))))
(defun tiled-object->trigger (tiled-obj tiled-map) (defun tiled-object->trigger (tiled-obj tiled-map)

View File

@ -17,11 +17,13 @@
;;;; Utility functions used by multiple overworld packages (overworld.tiled & overworld). ;;;; Utility functions used by multiple overworld packages (overworld.tiled & overworld).
(defpackage :flora-search-aurora.overworld.util (defpackage :flora-search-aurora.overworld.util
(:nicknames :fsa.o.u :overworld.util) (:nicknames :fsa.o.u :overworld.util :🌍.)
(:use :cl) (:use :cl)
(:export #:coords->symbol #:symbol->coords (:export #:coords->symbol #:symbol->coords
#:world-coords->screen-coords #:world-coords->screen-coords
#:world-coords-chunk)) #:world-coords-chunk
#:map->plist #:plist->map
#:save-map-to-file))
(in-package :flora-search-aurora.overworld.util) (in-package :flora-search-aurora.overworld.util)
@ -51,3 +53,35 @@ The world is split into screen-sized “chunks” to this end.
(defun world-coords-chunk (coords) (defun world-coords-chunk (coords)
(getf (world-coords->screen-coords coords) :chunk)) (getf (world-coords->screen-coords coords) :chunk))
(defun map->plist (map-hash)
"Convert a map(-HASH) into a friendly, property-list format!
Used by SAVE-MAP-TO-FILE."
(alexandria:hash-table-plist map-hash))
(defun plist->map (plist)
"Convert a map from a MAP->PLISTed PLIST into a normal
map hash-table, as used by the game."
(let ((hash (make-hash-table)))
;; Add the core map-data…
(setf (gethash :tiles hash) (getf plist :tiles))
(setf (gethash :top-tiles hash) (getf plist :top-tiles))
(setf (gethash :bump-map hash) (getf plist :bump-map))
(setf (gethash :entities hash) (getf plist :entities))
(setf (gethash :triggers hash) (getf plist :triggers))
;; And now the users data…
(setf (gethash :seconds hash) (getf plist :seconds))
(setf (gethash :day hash) (getf plist :day))
(setf (gethash :acts hash) (getf plist :acts))
(setf (gethash :knows hash) (getf plist :knows))
(setf (gethash :items hash) (getf plist :items))
hash))
(defun save-map-to-file (path map &optional (package ":FLORA-SEARCH-AURORA") (variable "*map*"))
"Given a map, generate source-code that corresponds to it."
(with-open-file (file-stream path :direction :output :if-exists :supersede)
(format file-stream "(in-package ~A)~%(defparameter ~A~% (🌍.…:plist->map~% (QUOTE ~S)))"
package variable (map->plist map))))

17
res/gen-maps.lisp Normal file
View File

@ -0,0 +1,17 @@
(ql:quickload '(alexandria cl-tiled assoc-utils str uiop))
(load "util.lisp")
(load "overworld.util.lisp")
(load "overworld.tiled.lisp")
(defun local-path (subpath)
(format nil "~A~A" (uiop:getcwd) subpath))
(mapcar
(lambda (map-name)
(🌍.::save-map-to-file
(local-path (format nil "res/maps/~A.tmx.lisp" map-name))
(overworld.tiled:load-map (local-path (format nil "res/maps/~A.tmx" map-name)))
":FLORA-SEARCH-AURORA"
(format nil "*~A-map*" map-name)))
'("casino" "outdoors"))

View File

@ -1,4 +1,4 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<tileset version="1.10" tiledversion="1.10.1" name="font" tilewidth="17" tileheight="17" tilecount="105" columns="15"> <tileset version="1.10" tiledversion="1.10.1" name="font" tilewidth="17" tileheight="17" tilecount="105" columns="15" tilerendersize="grid">
<image source="font.png" width="256" height="128"/> <image source="font.png" width="256" height="128"/>
</tileset> </tileset>

17
res/maps/tmx→lisp.lisp Normal file
View File

@ -0,0 +1,17 @@
(ql:quickload '(alexandria cl-tiled assoc-utils str uiop))
(load "util.lisp")
(load "overworld.util.lisp")
(load "overworld.tiled.lisp")
(defun local-path (subpath)
(format nil "~A~A" (uiop:getcwd) subpath))
(mapcar
(lambda (map-name)
(🌍.::save-map-to-file
(local-path (format nil "res/maps/~A.tmx.lisp" map-name))
(overworld.tiled:load-map (local-path (format nil "res/maps/~A.tmx" map-name)))
":FLORA-SEARCH-AURORA"
(format nil "*~A-map*" map-name)))
'("casino" "outdoors"))