# HG changeset patch # User Steve Losh # Date 1483801220 0 # Node ID 5560e722bc5cb676521fb6b5ad4413cd14c3fede # Parent 9a486239bf464b6cc8ff5aed0f70d2f8675ff1a4 Add a player diff -r 9a486239bf46 -r 5560e722bc5c antipodes.asd --- 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"))))) diff -r 9a486239bf46 -r 5560e722bc5c package.lisp --- 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 diff -r 9a486239bf46 -r 5560e722bc5c src/aspects/coordinates.lisp --- 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)) diff -r 9a486239bf46 -r 5560e722bc5c src/aspects/visible.lisp --- /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) diff -r 9a486239bf46 -r 5560e722bc5c src/entities/player.lisp --- 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+)) diff -r 9a486239bf46 -r 5560e722bc5c src/main.lisp --- 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)))))) diff -r 9a486239bf46 -r 5560e722bc5c vendor/make-quickutils.lisp --- 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 diff -r 9a486239bf46 -r 5560e722bc5c vendor/quickutils.lisp --- 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 ;;;;