5560e722bc5c

Add a player
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 07 Jan 2017 15:00:20 +0000
parents 9a486239bf46
children ebd641c91236
branches/tags (none)
files antipodes.asd package.lisp src/aspects/coordinates.lisp src/aspects/visible.lisp src/entities/player.lisp src/main.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/antipodes.asd	Sat Jan 07 14:30:26 2017 +0000
+++ b/antipodes.asd	Sat Jan 07 15:00:20 2017 +0000
@@ -25,7 +25,8 @@
                  (:module "generation" :serial t
                   :components ((:file "world")))
                  (:module "aspects" :serial t
-                  :components ((:file "coordinates")))
+                  :components ((:file "coordinates")
+                               (:file "visible")))
                  (:module "entities" :serial t
                   :components ((:file "player")))
                  (:file "main")))))
--- a/package.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/package.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -47,7 +47,21 @@
     :beast
     :ap.utilities
     :ap.quickutils)
-  (:export))
+  (:export
+    :player
+    :make-player
+
+    :coords
+    :coords/x
+    :coords/y
+    :coords?
+    :coords-lookup
+
+    :visible
+    :visible?
+    :visible/glyph
+    :visible/color
+    ))
 
 (defpackage :ap
   (:use
@@ -56,6 +70,7 @@
     :cl-arrows
     :losh
     :beast
+    :ap.entities
     :ap.utilities
     :ap.quickutils)
   (:export
--- a/src/aspects/coordinates.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/src/aspects/coordinates.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -1,2 +1,43 @@
 (in-package :ap.entities)
 
+(defparameter *world-contents*
+  (make-array (list ap.generation::*map-size*
+                    ap.generation::*map-size*)
+    :initial-element nil))
+
+(define-aspect coords x y)
+
+(defun within-bounds-p (x y)
+  (and (in-range-p 0 x ap.generation::*map-size*)
+       (in-range-p 0 y ap.generation::*map-size*)))
+
+(defun coords-insert-entity (e)
+  (push e (aref *world-contents* (coords/x e) (coords/y e))))
+
+(defun coords-remove-entity (e)
+  (deletef (aref *world-contents* (coords/x e) (coords/y e)) e))
+
+(defun coords-move-entity (e new-x new-y)
+  (when (within-bounds-p new-x new-y)
+    (coords-remove-entity e)
+    (setf (coords/x e) new-x
+          (coords/y e) new-y)
+    (coords-insert-entity e)))
+
+(defun coords-lookup (x y)
+  (when (within-bounds-p x y)
+    (aref *world-contents* x y)))
+
+(defun nearby (entity &optional (radius 1))
+  (remove entity
+          (iterate (with x = (coords/x entity))
+                   (with y = (coords/y entity))
+                   (for (dx dy) :within-radius radius)
+                   (appending (coords-lookup (+ x dx)
+                                             (+ y dy))))))
+
+(defmethod entity-created :after ((entity coords))
+  (coords-insert-entity entity))
+
+(defmethod entity-destroyed :after ((entity coords))
+  (coords-remove-entity entity))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/aspects/visible.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -0,0 +1,4 @@
+(in-package :ap.entities)
+
+
+(define-aspect visible glyph color)
--- a/src/entities/player.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/src/entities/player.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -1,1 +1,11 @@
 (in-package :ap.entities)
+
+
+(define-entity player (coords visible))
+
+(defun make-player ()
+  (create-entity 'player
+                 :coords/x (round (* 0.5 ap.generation::*map-size*))
+                 :coords/y (round (* 0.9 ap.generation::*map-size*))
+                 :visible/glyph "@"
+                 :visible/color ap::+black-white+))
--- a/src/main.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/src/main.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -22,6 +22,7 @@
 (defparameter *view-y* nil)
 
 (defparameter *wat* nil)
+(defparameter *player* nil)
 
 
 ;;;; Colors -------------------------------------------------------------------
@@ -32,6 +33,8 @@
   (+yellow-black+ charms/ll:COLOR_YELLOW  charms/ll:COLOR_BLACK)
   (+green-black+  charms/ll:COLOR_GREEN   charms/ll:COLOR_BLACK)
   (+pink-black+   charms/ll:COLOR_MAGENTA charms/ll:COLOR_BLACK)
+
+  (+black-white+  charms/ll:COLOR_BLACK   charms/ll:COLOR_WHITE)
   )
 
 
@@ -100,7 +103,8 @@
   (setf *terrain* (ap.generation::generate-heightmap))
   (destructuring-bind (map-width map-height) (array-dimensions *terrain*)
     (setf *view-x* (truncate map-width 2)
-          *view-y* (truncate map-height 2))))
+          *view-y* (truncate map-height 2)))
+  (setf *player* (make-player)))
 
 (defun generate-world ()
   (with-dims (20 2)
@@ -123,6 +127,18 @@
         ((< height  0.55) (values #\^ +white-black+)) ; hills
         (t                (values #\# +white-black+)))) ; mountains
 
+(defun clamp-view (coord size)
+  (clamp 0 (- ap.generation::*map-size* size 1) coord))
+
+(defun center-view (width height x y)
+  (setf *view-x* (clamp-view (- x (truncate width 2)) width)
+        *view-y* (clamp-view (- y (truncate height 2)) height)))
+
+(defun center-view-on-player (width height)
+  (center-view width height
+               (coords/x *player*)
+               (coords/y *player*)))
+
 (defun render-map (window)
   (iterate
     (with terrain = *terrain*)
@@ -134,7 +150,11 @@
     (for y = (+ sy vy))
     (for (values glyph color) = (terrain-char (aref terrain x y)))
     (with-color (window color)
-      (charms:write-char-at-point window glyph sx sy))))
+      (charms:write-char-at-point window glyph sx sy))
+    (for entity = (find-if #'visible? (coords-lookup x y)))
+    (when entity
+      (with-color (window (visible/color entity))
+        (charms:write-string-at-point window (visible/glyph entity) sx sy)))))
 
 
 (defun world-map-input (window)
@@ -149,6 +169,7 @@
   (with-dims ((- *screen-width* 2) (- *screen-height* 2))
     (with-panel-and-window (map-pan map-win *width* *height* 0 0)
       (iterate
+        (center-view-on-player *width* *height*)
         (render-map map-win)
         (redraw)
         (until (eql :quit (world-map-input map-win))))))
--- a/vendor/make-quickutils.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/vendor/make-quickutils.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -7,6 +7,7 @@
                :compose
                :curry
                :define-constant
+               :deletef
                :mkstr
                :once-only
                :rcurry
--- a/vendor/quickutils.lisp	Sat Jan 07 14:30:26 2017 +0000
+++ b/vendor/quickutils.lisp	Sat Jan 07 15:00:20 2017 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :MKSTR :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "AP.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :DELETEF :MKSTR :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "AP.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AP.QUICKUTILS")
@@ -15,7 +15,7 @@
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
                                          :COMPOSE :CURRY :DEFINE-CONSTANT
-                                         :MKSTR :ONCE-ONLY :RCURRY
+                                         :DELETEF :MKSTR :ONCE-ONLY :RCURRY
                                          :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
                                          :READ-FILE-INTO-STRING :SYMB
                                          :STRING-DESIGNATOR :WITH-GENSYMS))))
@@ -129,6 +129,16 @@
        ,@(when documentation `(,documentation))))
   
 
+  (declaim (inline delete/swapped-arguments))
+  (defun delete/swapped-arguments (sequence item &rest keyword-arguments)
+    (apply #'delete item sequence keyword-arguments))
+
+  (define-modify-macro deletef (item &rest remove-keywords)
+    delete/swapped-arguments
+    "Modify-macro for `delete`. Sets place designated by the first argument to
+the result of calling `delete` with `item`, place, and the `keyword-arguments`.")
+  
+
   (defun mkstr (&rest args)
     "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
 
@@ -291,7 +301,7 @@
     `(with-gensyms ,names ,@forms))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry define-constant mkstr once-only rcurry
+  (export '(compose curry define-constant deletef mkstr once-only rcurry
             read-file-into-string symb with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;