Moving between maps: Doorways! ♥

flora-search-aurora.lisp

@@ -1,4 +1,4 @@
-;;;; Copyright © 2023, Jaidyn Ann <jadedctrl@posteo.at>
+ ;;;; Copyright © 2023, Jaidyn Ann <jadedctrl@posteo.at>
 ;;;;
 ;;;; This program is free software: you can redistribute it and/or
 ;;;; modify it under the terms of the GNU General Public License as
@@ -48,6 +48,13 @@
   `(getf (gethash :knows ,map) ,idea))
 
 
+
+;;; ———————————————————————————————————
+;;; The Outside World™
+;;; ———————————————————————————————————
+(defparameter *outdoors-map* (overworld.tiled:load-map (format nil "~Ares/map.tmx" (uiop:getcwd))))
+
+
 
 ;;; ———————————————————————————————————
 ;;; Childhood friend (Sasha) arc
@@ -126,6 +133,21 @@
   (make-dialogue-state map (childhood-friend-dialogue map)))
 
 
+
+;;; ———————————————————————————————————
+;;; Casino!
+;;; ———————————————————————————————————
+(defparameter *casino-map* (overworld.tiled:load-map (format nil "~Ares/casino.tmx" (uiop:getcwd))))
+
+
+(defun casino-entrance-trigger (&optional map)
+    (list :map *casino-map*))
+
+
+(defun casino-exit-trigger (&optional map)
+  (list :map *outdoors-map*))
+
+
 
 ;;; ———————————————————————————————————
 ;;; Random casino NPCs
@@ -187,8 +209,10 @@
                             :face "=w=~"))))
 
 
-(defun bruh-trigger (&optional map)
+
-  (print "YAAAAAAA"))
+
+
+
 
 
 

overworld.lisp

@@ -100,6 +100,14 @@ rectangle as defined by its TOP-LEFT-CORNER & BOTTOM-RIGHT-CORNER."
                                (list :x x :y y))))
 
 
+(defun trigger-at-coords (map world-coords)
+  (let ((chunk (world-coords-chunk world-coords)))
+    (loop for trigger in (cdr (assoc chunk (gethash :triggers map)))
+           do (when (within-rectangle world-coords
+                                       (getf trigger :coords) (getf trigger :bottom-coords))
+                (return trigger)))))
+
+
 
 ;;; ———————————————————————————————————
 ;;; Overworld logic
@@ -127,40 +135,39 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
 ;;          ((plist = input '(:modifier nil :char #\Esc)))
           ;; Simple up-down-left-right movements
           ((…:plist= input '(:modifier nil :char #\→))
-           (move-entity map 'player :x 1)
+           (move-player map :Δx 1))
-           (list :map map))
           ((…:plist= input '(:modifier nil :char #\←))
-           (move-entity map 'player :x -1)
+           (move-player map :Δx -1))
-           (list :map map))
           ((…:plist= input '(:modifier nil :char #\↑))
-           (move-entity map 'player :y -1)
+           (move-player map :Δy -1))
-           (list :map map))
           ((…:plist= input '(:modifier nil :char #\↓))
-           (move-entity map 'player :y 1)
+           (move-player map :Δy 1))
-           (list :map map))
           ('t
            (list :map map))))
       (list :map map)))
 
 
-(defun move-entity (map entity-id &key (x 0) (y 0))
+(defun move-player (map &key (Δx 0) (Δy 0))
+  (move-entity map 'player :Δx Δx :Δy Δy)
+  (let* ((coords (getf-entity-data map 'player :coords))
+         (trigger (trigger-at-coords map (list :x (getf coords :x) :y (getf coords :y)))))
+    (if (and trigger (getf trigger :function))
+        (apply (intern (string-upcase (getf trigger :function)))
+               (list map))
+        (list :map map))))
+
+
+
+(defun move-entity (map entity-id &key (Δx 0) (Δy 0))
   "Move an entity relative to its current position."
-  (when (< x 0)
+  (when (< Δx 0)
     (setf (getf-entity-data map entity-id :direction) 'left))
-  (when (> x 0)
+  (when (> Δx 0)
     (setf (getf-entity-data map entity-id :direction) 'right))
   (let ((coords (getf-entity-data map entity-id :coords)))
     (move-entity-to map entity-id
-                    :x (+ x (getf coords :x))
+                    :x (+ Δx (getf coords :x))
-                    :y (+ y (getf coords :y)))))
+                    :y (+ Δy (getf coords :y)))))
-
-
-(defun trigger-at-coords (map world-coords)
-  (let ((chunk (world-coords-chunk world-coords)))
-    (loop for trigger in (cdr (assoc chunk (gethash :triggers map)))
-           do (when (within-rectangle world-coords
-                                       (getf trigger :coords) (getf trigger :bottom-coords))
-                (return trigger)))))
 
 
 (defun move-entity-to (map entity &key (x 0) (y 0))
@@ -179,13 +186,7 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
             (cdr (getf-entity map entity)))
       ;; Delete it from the old list…
       (alexandria:deletef (assoc-utils:aget (gethash :entities map) old-chunk) entity
-                          :test (lambda (id alist) (eq id (car alist)))))
+                          :test (lambda (id alist) (eq id (car alist)))))))
-    ;; If moving the player-character, check for triggers! (Traps)
-    (when (eq entity 'player)
-      (let ((trigger (trigger-at-coords map (list :x x :y y))))
-        (if (and trigger (getf trigger :function))
-            (apply (intern (string-upcase (getf trigger :function)))
-                   (list map)))))))
 
 
 

res/casino.tmx

@@ -62,8 +62,8 @@
 93,0,0,0,0,0,0,0,93,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
 93,0,0,0,0,0,0,0,93,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
 93,0,0,0,0,0,0,0,93,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
-93,0,64,64,64,64,64,64,16,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
+93,0,0,0,0,0,0,0,16,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
-93,60,1,1,1,1,1,1,1,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
+93,0,0,0,0,0,0,0,1,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
 93,60,64,64,64,64,64,64,1,0,0,93,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
 93,3,3,3,3,3,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
 93,3,3,3,3,3,3,3,3,3,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,93,
@@ -110,8 +110,8 @@
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,64,64,64,64,64,64,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,60,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
@@ -143,7 +143,7 @@
 </data>
  </layer>
  <objectgroup id="3" name="Entities">
-  <object id="1" name="Player" type="Person" x="266.121" y="187.818">
+  <object id="1" name="Player" type="Person" x="604.788" y="657.818">
    <properties>
     <property name="facing_right" type="bool" value="true"/>
     <property name="id" value="player"/>
@@ -192,7 +192,7 @@
    </properties>
    <point/>
   </object>
-  <object id="6" name="Bartender" type="Person" x="110" y="128.667">
+  <object id="6" name="Bartender" type="Person" x="76" y="214">
    <properties>
     <property name="facing_right" type="bool" value="false"/>
     <property name="id" value="casino-bartender"/>
@@ -201,9 +201,9 @@
    </properties>
    <point/>
   </object>
-  <object id="8" name="BRUH" type="Trigger" x="233.333" y="240" width="78" height="47.3333">
+  <object id="8" name="BRUH" type="Trigger" x="578.776" y="663.718" width="66.8802" height="14.6666">
    <properties>
-    <property name="function" value="bruh-trigger"/>
+    <property name="function" value="casino-exit-trigger"/>
    </properties>
   </object>
  </objectgroup>

res/map.tmx

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<map version="1.10" tiledversion="1.10.1" orientation="orthogonal" renderorder="left-down" width="144" height="40" tilewidth="12" tileheight="17" infinite="0" nextlayerid="14" nextobjectid="10">
+<map version="1.10" tiledversion="1.10.1" orientation="orthogonal" renderorder="left-down" width="144" height="40" tilewidth="12" tileheight="17" infinite="0" nextlayerid="14" nextobjectid="11">
  <tileset firstgid="1" source="font.tsx"/>
  <layer id="1" name="Background" width="144" height="40">
   <properties>
@@ -256,5 +256,10 @@
    </properties>
    <point/>
   </object>
+  <object id="10" name="Exit" type="Trigger" x="576.601" y="340.729" width="22.3792" height="15.3923">
+   <properties>
+    <property name="function" value="casino-entrance-trigger"/>
+   </properties>
+  </object>
  </objectgroup>
 </map>