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:
parent
c0d2099ae8
commit
74d713b76d
|
@ -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)'
|
|
@ -295,9 +295,8 @@ The data returned is a list of the box’es 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
|
||||||
|
|
|
@ -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*)))
|
||||||
|
|
|
@ -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-a’s :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 entity’s head. There aren't any Mami Tomoes in this game, dang it!"
|
"Draw an entity’s 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 entity’s legs — a surprisingly in-depth task!"
|
"Draw a bipdel entity’s 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-a’s :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)
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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->PLIST’ed 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 user’s 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))))
|
||||||
|
|
|
@ -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"))
|
|
@ -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>
|
|
@ -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"))
|
Ŝarĝante…
Reference in New Issue