# HG changeset patch # User Steve Losh # Date 1483816295 0 # Node ID 1c92535d2aecaa0e7171a1fa6a317035b8bdbabb # Parent 9dbe31fef037f60229d94aec29b9122236b2d363 I has a flavor diff -r 9dbe31fef037 -r 1c92535d2aec antipodes.asd --- 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") diff -r 9dbe31fef037 -r 1c92535d2aec data/animals.lisp --- /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" + ) diff -r 9dbe31fef037 -r 1c92535d2aec package.lisp --- 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 diff -r 9dbe31fef037 -r 1c92535d2aec src/aspects/coordinates.lisp --- 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)))) diff -r 9dbe31fef037 -r 1c92535d2aec src/entities/player.lisp --- 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) diff -r 9dbe31fef037 -r 1c92535d2aec src/flavor.lisp --- /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))))) diff -r 9dbe31fef037 -r 1c92535d2aec src/generation/world.lisp --- 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)) diff -r 9dbe31fef037 -r 1c92535d2aec src/main.lisp --- 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) diff -r 9dbe31fef037 -r 1c92535d2aec src/world-generation.lisp --- /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))