552921869758

Basic heightmap gen
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 07 Jan 2017 13:17:51 +0000
parents 91b6c62b6f75
children d0c6e89468c2
branches/tags (none)
files antipodes.asd src/gen/world.lisp src/main.lisp

Changes

--- a/antipodes.asd	Sat Jan 07 12:54:06 2017 +0000
+++ b/antipodes.asd	Sat Jan 07 13:17:51 2017 +0000
@@ -7,6 +7,7 @@
   :version "1.0.0"
 
   :depends-on (:beast
+               :black-tie
                :cl-arrows
                :cl-charms
                :cl-strings
--- a/src/gen/world.lisp	Sat Jan 07 12:54:06 2017 +0000
+++ b/src/gen/world.lisp	Sat Jan 07 13:17:51 2017 +0000
@@ -8,5 +8,16 @@
     :element-type 'single-float
     :initial-element 0.0))
 
+(defun noise-heightmap (heightmap)
+  (iterate
+    (for (val x y) :in-array heightmap)
+    (setf (aref heightmap x y)
+          (black-tie:perlin-noise-single-float
+            (* x 0.1)
+            (* y 0.1)
+            0.0))))
+
 (defun generate-heightmap ()
-  (make-empty-heightmap))
+  (let ((heightmap (make-empty-heightmap)))
+    (noise-heightmap heightmap)
+    heightmap))
--- a/src/main.lisp	Sat Jan 07 12:54:06 2017 +0000
+++ b/src/main.lisp	Sat Jan 07 13:17:51 2017 +0000
@@ -16,6 +16,7 @@
 (defparameter *width* nil)
 (defparameter *height* nil)
 
+(defparameter *terrain* nil)
 
 ;;;; Intro --------------------------------------------------------------------
 (defmacro dialog (&body body)
@@ -59,7 +60,7 @@
 (defun intro6 ()
   (if (eq :left (dialog (write-lines-left win *intro6* 1 1)))
     (intro5)
-    nil))
+    (generate-world)))
 
 
 ;;;; Title --------------------------------------------------------------------
@@ -71,8 +72,47 @@
              (center *height* *screen-height*))
       (write-lines-centered win *logo* 0)
       (redraw)
-      (charms:get-char win))
-    (intro1)))
+      (charms:get-char win)))
+  (intro1))
+
+
+;;;; World Generation ---------------------------------------------------------
+(defun generate-world% ()
+  (setf *terrain* (ap.gen::generate-heightmap)))
+
+(defun generate-world ()
+  (with-dims (20 2)
+    (with-panel-and-window
+        (pan win *width* *height*
+             (center *width* *screen-width*)
+             (center *height* *screen-height*))
+      (write-string-centered win "Generating world..." 0)
+      (redraw)
+      (generate-world%)))
+  (world-map))
+
+
+;;;; World Map ----------------------------------------------------------------
+(defun terrain-char (height)
+  (cond ((< height 0.0) #\~)
+        (t #\.)))
+
+(defun render-map (window)
+  (iterate
+    (with terrain = *terrain*)
+    (for-nested ((sx :from 0 :below *width*)
+                 (sy :from 0 :below *height*)))
+    (for glyph = (terrain-char (aref terrain sx sy)))
+    (charms:write-char-at-point window glyph sx sy)))
+
+(defun world-map ()
+  (with-dims ((- *screen-width* 2) (- *screen-height* 2))
+    (with-panel-and-window (map-pan map-win *width* *height* 0 0)
+      (iterate
+        (render-map map-win)
+        (redraw)
+        (until (eql #\q (charms:get-char map-win))))))
+  nil)
 
 
 ;;;; Main ---------------------------------------------------------------------