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=

Makefile

@@ -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)'

dialogue.lisp

@@ -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:
   ((:x X :y Y) MAX-COLUMN MAX-ROW)"
   (let* ((speaker-id (dialogue-speaker dialogue))
-         (direction (🌍:getf-entity-data map speaker-id :direction))
          (playerp (eq speaker-id '🌍:player))
-         (leftp (not (eq direction '🌍:right)))
+         (leftp (not (🌍:getf-entity-data map speaker-id :facing-right)))
          (text (getf dialogue :text))
          (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

flora-search-aurora.lisp

@@ -24,7 +24,6 @@
 (load "display.lisp")
 (load "ui.lisp")
 (load "overworld.util.lisp")
-(load "overworld.tiled.lisp")
 (load "overworld.lisp")
 (load "dialogue.lisp")
 (load "engine.lisp")
@@ -39,6 +38,8 @@
 
 (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™
 ;;; ———————————————————————————————————
-(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!
 ;;; ———————————————————————————————————
-(defparameter *casino-map* (overworld.tiled:load-map (format nil "~Ares/casino.tmx" (uiop:getcwd))))
-
-
-(defun casino-entrance-trigger (&optional map)
-    (list :map (🌍:merge-maps map *casino-map*)))
-
+(load "res/maps/casino.tmx.lisp")
 
 (defun casino-exit-trigger (&optional map)
   (list :map (🌍:merge-maps map *outdoors-map*)))

overworld.lisp

@@ -20,13 +20,14 @@
 (defpackage :flora-search-aurora.overworld
   (:nicknames :fsa.o :overworld :🌍)
   (: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
            #:merge-maps
            #:world-coords->screen-coords
            #:getf-entity #:getf-entity-data #:removef-entity
            #:aget-item #:getf-act #:getf-know
            #:move-entity-to #:move-entity
+           #:plist->map
            :left :right
            :player))
 
@@ -152,6 +153,30 @@ replays of the game."
                (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
@@ -185,7 +210,7 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
     ;; Go through the day-update procedures!
     (when (not (eq (getf game-datetime :day)
                    (gethash :day map)))
-        (setf (gethash :day map) (getf game-datetime :day)))))
+      (setf (gethash :day map) (getf game-datetime :day)))))
 
 
 (defun process-overworld-input (map)
@@ -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))
   "Move an entity relative to its current position."
   (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)
-    (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)))
     (move-entity-to map entity-id
                     :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)
   "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)))
-         (direction (getf entity-plist :direction))
          (face (getf entity-plist :face))
          (width (+ (length face) 2)) ;; Face + |borders|
          (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))))
     (📋: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!"
   (let* ((screen-coords (world-coords->screen-coords (getf entity-plist :coords)))
          (x (getf screen-coords :x))
-         (y (getf screen-coords :y))
-         (direction (getf entity-plist :direction)))
-    (cond ((eq direction 'right)
+         (y (getf screen-coords :y)))
+    (cond ((getf entity-plist :facing-right)
            (ignore-errors (setf (aref matrix y x) #\|))
            (ignore-errors (setf (aref matrix y (- x 1)) #\|)))
           ('t
@@ -396,19 +419,3 @@ A state-function for use with STATE-LOOP."
   (lambda (matrix &key (map map))
     (apply #'🌍:overworld-state
            (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)

overworld.tiled.lisp

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

overworld.util.lisp

@@ -17,11 +17,13 @@
 ;;;; Utility functions used by multiple overworld packages (overworld.tiled & overworld).
 
 (defpackage :flora-search-aurora.overworld.util
-  (:nicknames :fsa.o.u :overworld.util)
+  (:nicknames :fsa.o.u :overworld.util :🌍.…)
   (:use :cl)
   (:export #:coords->symbol #:symbol->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)
 
@@ -51,3 +53,35 @@ The world is split into screen-sized “chunks” to this end.
 
 (defun world-coords-chunk (coords)
   (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))))

res/gen-maps.lisp

@@ -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"))

res/maps/font.tsx

@@ -1,4 +1,4 @@
 <?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"/>
 </tileset>

res/maps/tmx→lisp.lisp

@@ -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"))