--- a/antipodes.asd Sat Jan 07 18:46:14 2017 +0000
+++ b/antipodes.asd Sat Jan 07 19:11:35 2017 +0000
@@ -22,8 +22,7 @@
(:module "src" :serial t
:components
((:file "utilities")
- (:module "generation" :serial t
- :components ((:file "world")))
+ (:file "world-generation")
(:module "aspects" :serial t
:components ((:file "coordinates")
(:file "holdable")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/data/animals.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -0,0 +1,135 @@
+(
+ "an aardvark"
+ "an alligator"
+ "an alpaca"
+ "an antelope"
+ "an ape"
+ "an armadillo"
+ "a baboon"
+ "a badger"
+ "a bat"
+ "a bear"
+ "a beaver"
+ "a bison"
+ "a boar"
+ "a buffalo"
+ "a bull"
+ "a camel"
+ "a canary"
+ "a capybara"
+ "a cat"
+ "a chameleon"
+ "a cheetah"
+ "a chimpanzee"
+ "a chinchilla"
+ "a chipmunk"
+ "a cougar"
+ "a cow"
+ "a coyote"
+ "a crocodile"
+ "a crow"
+ "a deer"
+ "a dingo"
+ "a dog"
+ "a donkey"
+ "a dromedary"
+ "an elephant"
+ "an elk"
+ "an ewe"
+ "a ferret"
+ "a finch"
+ "a fish"
+ "a fox"
+ "a frog"
+ "a gazelle"
+ "a gila monster"
+ "a giraffe"
+ "a gnu"
+ "a goat"
+ "a gopher"
+ "a gorilla"
+ "a grizzly bear"
+ "a ground hog"
+ "a guinea pig"
+ "a hamster"
+ "a hedgehog"
+ "a hippopotamus"
+ "a hog"
+ "a horse"
+ "a hyena"
+ "an ibex"
+ "an iguana"
+ "an impala"
+ "a jackal"
+ "a jaguar"
+ "a kangaroo"
+ "a koala"
+ "a lamb"
+ "a lemur"
+ "a leopard"
+ "a lion"
+ "a lizard"
+ "a llama"
+ "a lynx"
+ "a mandrill"
+ "a marmoset"
+ "a mink"
+ "a mole"
+ "a mongoose"
+ "a monkey"
+ "a moose"
+ "a mountain goat"
+ "a mouse"
+ "a mule"
+ "a muskrat"
+ "a mustang"
+ "a mynah bird"
+ "a newt"
+ "an ocelot"
+ "an opossum"
+ "an orangutan"
+ "an otter"
+ "an ox"
+ "a panda"
+ "a panther"
+ "a parakeet"
+ "a parrot"
+ "a pig"
+ "a platypus"
+ "a polar bear"
+ "a porcupine"
+ "a porpoise"
+ "a prairie dog"
+ "a puma"
+ "a rabbit"
+ "a raccoon"
+ "a ram"
+ "a rat"
+ "a reindeer"
+ "a reptile"
+ "a rhinoceros"
+ "a salamander"
+ "a seal"
+ "a sheep"
+ "a shrew"
+ "a silver fox"
+ "a skunk"
+ "a sloth"
+ "a snake"
+ "a squirrel"
+ "a tapir"
+ "a tiger"
+ "a toad"
+ "a turtle"
+ "a walrus"
+ "a warthog"
+ "a weasel"
+ "a whale"
+ "a wildcat"
+ "a wolf"
+ "a wolverine"
+ "a wombat"
+ "a woodchuck"
+ "a yak"
+ "a zebra"
+ )
--- a/package.lisp Sat Jan 07 18:46:14 2017 +0000
+++ b/package.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -29,16 +29,6 @@
:read-file-into-form
))
-(defpackage :ap.generation
- (:use
- :cl
- :iterate
- :cl-arrows
- :losh
- :beast
- :ap.utilities
- :ap.quickutils)
- (:export))
(defpackage :ap.entities
(:use
@@ -84,6 +74,18 @@
:visible/color
))
+(defpackage :ap.flavor
+ (:use
+ :cl
+ :iterate
+ :cl-arrows
+ :losh
+ :ap.utilities
+ :ap.quickutils)
+ (:export
+ :flavorp
+ :random-flavor))
+
(defpackage :ap
(:use
:cl
--- a/src/aspects/coordinates.lisp Sat Jan 07 18:46:14 2017 +0000
+++ b/src/aspects/coordinates.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -1,15 +1,15 @@
(in-package :ap.entities)
(defparameter *world-contents*
- (make-array (list ap.generation::*map-size*
- ap.generation::*map-size*)
+ (make-array (list ap::*map-size*
+ ap::*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*)))
+ (and (in-range-p 0 x ap::*map-size*)
+ (in-range-p 0 y ap::*map-size*)))
(defun coords-insert-entity (e)
(push e (aref *world-contents* (coords/x e) (coords/y e))))
--- a/src/entities/player.lisp Sat Jan 07 18:46:14 2017 +0000
+++ b/src/entities/player.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -27,10 +27,10 @@
(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+))
+ :coords/x (round (* 0.5 ap::*map-size*))
+ :coords/y (round (* 0.9 ap::*map-size*))
+ :visible/glyph "@"
+ :visible/color ap::+black-white+))
(defun tick-player (player)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/flavor.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -0,0 +1,34 @@
+(in-package :ap.flavor)
+
+(defparameter *flavor-chance* 1/250)
+(defparameter *animals* (read-file-into-form "data/animals.lisp"))
+
+(defun flavorp ()
+ (randomp *flavor-chance*))
+
+(defun animal ()
+ (format nil "You see ~A ~A.~2%~A"
+ (random-elt *animals*)
+ (random-elt #("in the distance"
+ "out of the corner of your eye"
+ "running north"))
+ (random-elt #("A fellow traveler."
+ "It eyes you warily."
+ "She seems tired."
+ "He seems tired."
+ "A good omen."
+ "Alone, like you."))))
+
+(defun wind ()
+ (format nil "A ~A ~A the ~A air against your skin."
+ (random-elt #("light breeze"
+ "gentle breeze"
+ "stiff wind"
+ "strong wind"))
+ (random-elt #("moves" "pushes"))
+ (random-elt #("hot" "warm" "sticky" "humid"))))
+
+(defun random-flavor ()
+ (let ((r (random 1.0)))
+ (cond ((< r 0.50) (animal))
+ (t (wind)))))
--- a/src/generation/world.lisp Sat Jan 07 18:46:14 2017 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +0,0 @@
-(in-package :ap.generation)
-
-;;;; Parameters ---------------------------------------------------------------
-(defparameter *map-size* 2000)
-(defparameter *noise-scale* 0.03)
-(defparameter *noise-seed-x* (random 1000.0))
-(defparameter *noise-seed-y* (random 1000.0))
-
-
-;;;; Heightmap ----------------------------------------------------------------
-;;; TODO: Switch to something less samey
-
-(defun make-empty-heightmap ()
- (make-array (list *map-size* *map-size*)
- :element-type 'single-float
- :initial-element 0.0))
-
-(defun noise-heightmap (heightmap)
- (iterate
- (with ox = *noise-seed-x*)
- (with oy = *noise-seed-x*)
- (with scale = *noise-scale*)
- (for (val x y) :in-array heightmap)
- (setf (aref heightmap x y)
- (black-tie:perlin-noise-single-float
- (+ ox (* x scale))
- (+ oy (* y scale))
- 0.0))))
-
-(defun generate-heightmap ()
- (let ((heightmap (make-empty-heightmap)))
- (noise-heightmap heightmap)
- heightmap))
--- a/src/main.lisp Sat Jan 07 18:46:14 2017 +0000
+++ b/src/main.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -106,7 +106,7 @@
(< height 0.05))
(defun generate-terrain ()
- (setf *terrain* (ap.generation::generate-heightmap)
+ (setf *terrain* (generate-heightmap)
*view-x* 0 *view-y* 0))
(defun spawn-player ()
@@ -115,11 +115,11 @@
(defun place-food ()
(iterate
(with remaining = (round (* *food-density*
- ap.generation::*map-size*
- ap.generation::*map-size*)))
+ *map-size*
+ *map-size*)))
(until (zerop remaining))
- (for x = (random ap.generation::*map-size*))
- (for y = (random ap.generation::*map-size*))
+ (for x = (random *map-size*))
+ (for y = (random *map-size*))
(when (not (underwaterp (aref *terrain* x y)))
(make-food x y)
(decf remaining))))
@@ -156,9 +156,9 @@
(charms:clear-window win)
(border win)
(write-lines-left win lines 1 1)
- (write-string-centered win "Press any key" (1- *height*))
+ (write-string-centered win "Press space" (1- *height*))
(redraw)
- (charms:get-char win)))))
+ (iterate (until (eql #\space (charms:get-char win))))))))
;;;; World Map ----------------------------------------------------------------
@@ -171,7 +171,7 @@
(t (values #\# +white-black+)))) ; mountains
(defun clamp-view (coord size)
- (clamp 0 (- ap.generation::*map-size* size 1) coord))
+ (clamp 0 (- *map-size* size 1) coord))
(defun center-view (width height x y)
(setf *view-x* (clamp-view (- x (truncate width 2)) width)
@@ -188,14 +188,18 @@
(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)))))
+ (write-string-left
+ window
+ (format nil "You see ~A here" (holdable/description (first items)))
+ 0 0)
+ (progn
+ (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
@@ -272,10 +276,12 @@
(redraw)
(if-first-time
(popup "Head north!")
- (case (world-map-input bar-win)
- (:tick (tick-player *player*))
- (:quit (return))
- (:help (popup *help*)))))))
+ (if (ap.flavor:flavorp)
+ (popup (ap.flavor:random-flavor))
+ (case (world-map-input bar-win)
+ (:tick (tick-player *player*))
+ (:quit (return))
+ (:help (popup *help*))))))))
nil)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/world-generation.lisp Sat Jan 07 19:11:35 2017 +0000
@@ -0,0 +1,33 @@
+(in-package :ap)
+
+;;;; Parameters ---------------------------------------------------------------
+(defparameter *map-size* 2000)
+(defparameter *noise-scale* 0.03)
+(defparameter *noise-seed-x* (random 1000.0))
+(defparameter *noise-seed-y* (random 1000.0))
+
+
+;;;; Heightmap ----------------------------------------------------------------
+;;; TODO: Switch to something less samey
+
+(defun make-empty-heightmap ()
+ (make-array (list *map-size* *map-size*)
+ :element-type 'single-float
+ :initial-element 0.0))
+
+(defun noise-heightmap (heightmap)
+ (iterate
+ (with ox = *noise-seed-x*)
+ (with oy = *noise-seed-x*)
+ (with scale = *noise-scale*)
+ (for (val x y) :in-array heightmap)
+ (setf (aref heightmap x y)
+ (black-tie:perlin-noise-single-float
+ (+ ox (* x scale))
+ (+ oy (* y scale))
+ 0.0))))
+
+(defun generate-heightmap ()
+ (let ((heightmap (make-empty-heightmap)))
+ (noise-heightmap heightmap)
+ heightmap))