fa45164eab85

Add random food
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 07 Jan 2017 17:48:08 +0000
parents f17271ef79b7
children 9dbe31fef037
branches/tags (none)
files .lispwords antipodes.asd data/vegetables.lisp package.lisp src/entities/food.lisp src/main.lisp src/utilities.lisp

Changes

--- a/.lispwords	Sat Jan 07 17:08:58 2017 +0000
+++ b/.lispwords	Sat Jan 07 17:48:08 2017 +0000
@@ -1,1 +1,2 @@
 (1 with-panel-and-window with-panels-and-windows)
+(1 create-entity)
--- a/antipodes.asd	Sat Jan 07 17:08:58 2017 +0000
+++ b/antipodes.asd	Sat Jan 07 17:48:08 2017 +0000
@@ -29,5 +29,6 @@
                                (:file "holdable")
                                (:file "visible")))
                  (:module "entities" :serial t
-                  :components ((:file "player")))
+                  :components ((:file "food")
+                               (:file "player")))
                  (:file "main")))))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/data/vegetables.lisp	Sat Jan 07 17:48:08 2017 +0000
@@ -0,0 +1,86 @@
+#("acorn squash"
+  "alfalfa sprouts"
+  "artichokes"
+  "arugula"
+  "asparagus"
+  "aubergine"
+  "azuki beans"
+  "banana squash"
+  "basil"
+  "bean sprouts"
+  "beets"
+  "black beans"
+  "black-eyed peas"
+  "bok choy"
+  "borlotti beans"
+  "broad beans"
+  "broccoli"
+  "brussels sprouts"
+  "butternut squash"
+  "cabbage"
+  "carrots"
+  "cauliflower"
+  "celery"
+  "chard"
+  "chickpeas"
+  "chives"
+  "cilantro"
+  "collard greens"
+  "corn"
+  "cucumber"
+  "dill"
+  "eggplant"
+  "garlic"
+  "ginger"
+  "green beans"
+  "green peppers"
+  "horseradish"
+  "hubbard squash"
+  "pickled jalapenos"
+  "kale"
+  "kidney bean"
+  "kohlrabi"
+  "lavender"
+  "leeks"
+  "lemon grass"
+  "lentils"
+  "lettuce"
+  "lima bean"
+  "marjoram"
+  "mung beans"
+  "mushrooms"
+  "mustard greens"
+  "navy beans"
+  "nettles"
+  "okra"
+  "onion"
+  "oregano"
+  "parsley"
+  "parsnips"
+  "peas"
+  "pinto beans"
+  "potatos"
+  "pumpkin"
+  "radishes"
+  "rhubarb"
+  "rosemary"
+  "runner beans"
+  "rutabagas"
+  "sage"
+  "scallions"
+  "shallots"
+  "snap peas"
+  "soy beans"
+  "spaghetti squash"
+  "spinach"
+  "squash"
+  "sweet potatos"
+  "thyme"
+  "tomatos"
+  "tubers"
+  "turnips"
+  "wasabi"
+  "watercress"
+  "white radishes"
+  "yams"
+  "zucchini")
--- a/package.lisp	Sat Jan 07 17:08:58 2017 +0000
+++ b/package.lisp	Sat Jan 07 17:48:08 2017 +0000
@@ -22,9 +22,11 @@
     :write-lines-left
     :write-lines-centered
     :with-dims
+    :with-window-dims
     :defcolors
     :with-color
     :init-colors
+    :read-file-into-form
     ))
 
 (defpackage :ap.generation
@@ -61,6 +63,10 @@
     :player-get
     :player-drop
 
+    :food
+    :make-food
+    :food/energy
+
     :coords
     :coords/x
     :coords/y
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/entities/food.lisp	Sat Jan 07 17:48:08 2017 +0000
@@ -0,0 +1,26 @@
+(in-package :ap.entities)
+
+(defparameter *vegetables*
+  (read-file-into-form "data/vegetables.lisp"))
+
+
+(define-entity food (visible coords holdable)
+  (energy :accessor food/energy :initarg :food/energy))
+
+(defun random-food-energy ()
+  (random-range 30.0 80.0))
+
+(defun random-food-description ()
+  (format nil "a ~A of ~A"
+          (random-elt #("can" "tin" "package"))
+          (random-elt *vegetables*)))
+
+(defun make-food (x y)
+  (create-entity 'food
+    :coords/x x
+    :coords/y y
+    :visible/glyph "%"
+    :visible/color ap::+yellow-black+
+    :holdable/description (random-food-description)
+    :food/energy (random-food-energy)))
+
--- a/src/main.lisp	Sat Jan 07 17:08:58 2017 +0000
+++ b/src/main.lisp	Sat Jan 07 17:48:08 2017 +0000
@@ -24,14 +24,7 @@
 (defparameter *wat* nil)
 (defparameter *player* nil)
 (defparameter *sidebar-width* 30)
-
-
-;;;; More Utils Lol
-(defmacro with-window-dims (window &body body)
-  (with-gensyms (w h)
-    `(multiple-value-bind (,w ,h) (charms:window-dimensions ,window)
-       (with-dims (,w ,h)
-         ,@body))))
+(defparameter *food-density* 1/6000)
 
 
 ;;;; Colors -------------------------------------------------------------------
@@ -108,23 +101,45 @@
 
 
 ;;;; World Generation ---------------------------------------------------------
+(defun underwaterp (height)
+  (< height 0.05))
+
+(defun generate-terrain ()
+  (setf *terrain* (ap.generation::generate-heightmap)
+        *view-x* 0 *view-y* 0))
+
+(defun spawn-player ()
+  (setf *player* (make-player)))
+
+(defun place-food ()
+  (iterate
+    (with remaining = (round (* *food-density*
+                                ap.generation::*map-size*
+                                ap.generation::*map-size*)))
+    (until (zerop remaining))
+    (for x = (random ap.generation::*map-size*))
+    (for y = (random ap.generation::*map-size*))
+    (when (not (underwaterp (aref *terrain* x y)))
+      (make-food x y)
+      (decf remaining))))
+
 (defun generate-world ()
   (clear-entities)
-  (with-dims (30 (+ 2 2))
+  (with-dims (30 (+ 2 3))
     (with-panel-and-window
         (pan win *width* *height*
              (center *width* *screen-width*)
              (center *height* *screen-height*))
       (border win)
-      (progn
-        (write-string-left win "Generating terrain..." 1 1)
-        (redraw)
-        (setf *terrain* (ap.generation::generate-heightmap)
-              *view-x* 0 *view-y* 0))
-      (progn
-        (write-string-left win "Spawning player..." 1 2)
-        (redraw)
-        (setf *player* (make-player)))))
+      (progn (write-string-left win "Generating terrain..." 1 1)
+             (redraw)
+             (generate-terrain))
+      (progn (write-string-left win "Placing food..." 1 2)
+             (redraw)
+             (place-food))
+      (progn (write-string-left win "Spawning player..." 1 3)
+             (redraw)
+             (spawn-player))))
   (world-map))
 
 
@@ -149,6 +164,21 @@
                (coords/x *player*)
                (coords/y *player*)))
 
+(defun render-items (window)
+  (let ((items (-<> (coords-lookup (coords/x *player*)
+                                   (coords/y *player*))
+                 (remove-if-not #'holdable? <>))))
+    (when items
+      (if (= (length items) 1)
+        (write-string-left window "The following thing is here:" 0 0)
+        (write-string-left window "The following things are here:" 0 0))
+      (iterate
+        (for item :in items)
+        (for y :from 1)
+        (write-string-left window
+                           (format nil "  ~A" (holdable/description item))
+                           0 1)))))
+
 (defun render-map (window)
   (iterate
     (with terrain = *terrain*)
@@ -161,7 +191,10 @@
     (for (values glyph color) = (terrain-char (aref terrain x y)))
     (with-color (window color)
       (charms:write-char-at-point window glyph sx sy))
-    (for entity = (find-if #'visible? (coords-lookup x y)))
+    (for entities = (coords-lookup x y))
+    (for entity = (if (member *player* entities)
+                    *player*
+                    (find-if #'visible? entities)))
     (when entity
       (with-color (window (visible/color entity))
         (charms:write-string-at-point window (visible/glyph entity) sx sy)))))
@@ -214,7 +247,8 @@
           (render-sidebar bar-win))
         (with-window-dims map-win
           (center-view-on-player *width* *height*)
-          (render-map map-win))
+          (render-map map-win)
+          (render-items map-win))
         (redraw)
         (case (world-map-input bar-win)
           (:tick (tick-player *player*))
--- a/src/utilities.lisp	Sat Jan 07 17:08:58 2017 +0000
+++ b/src/utilities.lisp	Sat Jan 07 17:48:08 2017 +0000
@@ -72,11 +72,17 @@
            (for y :from start-y)
            (write-string-centered window line y)))
 
+
 (defmacro with-dims ((width height) &body body)
   `(let ((ap::*width* ,width)
          (ap::*height* ,height))
      ,@body))
 
+(defmacro with-window-dims (window &body body)
+  (with-gensyms (w h)
+    `(multiple-value-bind (,w ,h) (charms:window-dimensions ,window)
+       (with-dims (,w ,h)
+         ,@body))))
 
 (defmacro defcolors (&rest colors)
   `(progn
@@ -102,3 +108,9 @@
 ;;;; Maths --------------------------------------------------------------------
 (defun center (size max)
   (truncate (- max size) 2))
+
+
+;;;; File I/O -----------------------------------------------------------------
+(defun read-file-into-form (filename)
+  (with-open-file (s filename)
+    (read s)))