--- 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 ;;;;