Add width and height based bound checking

crypts-and-corpses.lisp

@@ -3,12 +3,14 @@
 (in-package #:crypts-and-corpses)
 
 (defstruct game-map
-  (width 100 :type fixnum :read-only t)
-  (height 40 :type fixnum :read-only t)
+  (width 250 :type fixnum :read-only t)
+  (height 250 :type fixnum :read-only t)
   (mobiles (make-hash-table) :type hash-table :read-only t))
 
 (defclass entity ()
-  ((location :initarg :location :initform 0 :type fixnum)))
+  ((width :initarg :width :type fixnum :initform 1)
+   (height :initarg :height :type fixnum :initform 1)
+   (location :initarg :location :initform 0 :type fixnum)))
 
 (defclass tile-entity (entity)
   ((codepoint :initarg :codepoint :initform #x3f :type fixnum)))
@@ -57,11 +59,18 @@
 (defgeneric move-up (object map))
 (defgeneric move-down (object map))
 
-(defgeneric update-location (object map old-locaiton new-location))
+(defgeneric update-location (object map old-location new-location))
+
+(defun overrun-p (old-location new-location map)
+  (multiple-value-bind (old-x old-y) (calc-coord old-location map)
+    (multiple-value-bind (new-x new-y) (calc-coord new-location map)
+      (and (< old-y new-y)
+           (> old-x new-x)))))
 
 (defmethod update-location ((object entity) map old-location new-location)
-  (declare (ignore old-location))
-  (unless (out-of-bounds-p new-location map)
+  (unless (or (out-of-bounds-p new-location map)
+              (overrun-p old-location (+ new-location (slot-value object 'width)) map)
+              (out-of-bounds-p (+ new-location (* (slot-value object 'height) (game-map-width map))) map))
     (setf (slot-value object 'location) new-location)))
 
 (defmethod update-location ((object mobile) map old-location new-location)
@@ -125,7 +134,8 @@
     ((= key bearlibterminal-ffi:+tk-w+) (move-up viewport map))
     ((= key bearlibterminal-ffi:+tk-a+) (move-left viewport map))
     ((= key bearlibterminal-ffi:+tk-d+) (move-right viewport map))
-    ((= key bearlibterminal-ffi:+tk-s+) (move-down viewport map))))
+    ((= key bearlibterminal-ffi:+tk-s+) (move-down viewport map))
+    ((= key bearlibterminal-ffi:+tk-space+) (update-location viewport map (slot-value viewport 'location) (slot-value player 'location)))))
 
 (defun create-viewport ()
   (multiple-value-bind (width height) (get-window-size)