d0c6e89468c2

Maps and colors oh my
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 07 Jan 2017 14:16:41 +0000
parents 552921869758
children 9a486239bf46
branches/tags (none)
files antipodes.asd package.lisp src/ent/player.lisp src/gen/world.lisp src/main.lisp src/utilities.lisp

Changes

--- a/antipodes.asd	Sat Jan 07 13:17:51 2017 +0000
+++ b/antipodes.asd	Sat Jan 07 14:16:41 2017 +0000
@@ -24,4 +24,6 @@
                 ((:file "utilities")
                  (:module "gen" :serial t
                   :components ((:file "world")))
+                 (:module "ent" :serial t
+                  :components ((:file "player")))
                  (:file "main")))))
--- a/package.lisp	Sat Jan 07 13:17:51 2017 +0000
+++ b/package.lisp	Sat Jan 07 14:16:41 2017 +0000
@@ -22,6 +22,9 @@
     :write-lines-left
     :write-lines-centered
     :with-dims
+    :defcolors
+    :with-color
+    :init-colors
     ))
 
 (defpackage :ap.gen
@@ -35,6 +38,17 @@
     :ap.quickutils)
   (:export))
 
+(defpackage :ap.ent
+  (:use
+    :cl
+    :iterate
+    :cl-arrows
+    :losh
+    :beast
+    :ap.utilities
+    :ap.quickutils)
+  (:export))
+
 (defpackage :ap
   (:use
     :cl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ent/player.lisp	Sat Jan 07 14:16:41 2017 +0000
@@ -0,0 +1,1 @@
+(in-package :ap.ent)
--- a/src/gen/world.lisp	Sat Jan 07 13:17:51 2017 +0000
+++ b/src/gen/world.lisp	Sat Jan 07 14:16:41 2017 +0000
@@ -1,20 +1,26 @@
 (in-package :ap.gen)
 
 
-(define-constant +chunk-size+ (expt 2 8))
+(defparameter *map-size* 2000)
+(defparameter *noise-scale* 0.03)
+(defparameter *noise-seed-x* (random 1000.0))
+(defparameter *noise-seed-y* (random 1000.0))
 
 (defun make-empty-heightmap ()
-  (make-array (list +chunk-size+ +chunk-size+)
+  (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
-            (* x 0.1)
-            (* y 0.1)
+            (+ ox (* x scale))
+            (+ oy (* y scale))
             0.0))))
 
 (defun generate-heightmap ()
--- a/src/main.lisp	Sat Jan 07 13:17:51 2017 +0000
+++ b/src/main.lisp	Sat Jan 07 14:16:41 2017 +0000
@@ -18,6 +18,25 @@
 
 (defparameter *terrain* nil)
 
+(defparameter *view-x* nil)
+(defparameter *view-y* nil)
+
+(defparameter *wat* nil)
+
+
+;;;; Colors -------------------------------------------------------------------
+(defcolors
+  (+white-black+  charms/ll:COLOR_WHITE   charms/ll:COLOR_BLACK)
+  (+blue-black+   charms/ll:COLOR_BLUE    charms/ll:COLOR_BLACK)
+  (+cyan-black+   charms/ll:COLOR_CYAN    charms/ll:COLOR_BLACK)
+  (+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)
+  )
+
+
 ;;;; Intro --------------------------------------------------------------------
 (defmacro dialog (&body body)
   `(with-dims (50 10)
@@ -73,12 +92,17 @@
       (write-lines-centered win *logo* 0)
       (redraw)
       (charms:get-char win)))
-  (intro1))
+  ; (intro1)
+  (generate-world)
+  )
 
 
 ;;;; World Generation ---------------------------------------------------------
 (defun generate-world% ()
-  (setf *terrain* (ap.gen::generate-heightmap)))
+  (setf *terrain* (ap.gen::generate-heightmap))
+  (destructuring-bind (map-width map-height) (array-dimensions *terrain*)
+    (setf *view-x* (truncate map-width 2)
+          *view-y* (truncate map-height 2))))
 
 (defun generate-world ()
   (with-dims (20 2)
@@ -94,16 +118,34 @@
 
 ;;;; World Map ----------------------------------------------------------------
 (defun terrain-char (height)
-  (cond ((< height 0.0) #\~)
-        (t #\.)))
+  (cond ((< height -0.20) (values #\~ +blue-black+)) ; deep water
+        ((< height -0.05) (values #\~ +cyan-black+)) ; shallow water
+        ((< height  0.05) (values #\` +yellow-black+)) ; sand
+        ((< height  0.40) (values #\. +white-black+)) ; dirt
+        ((< height  0.55) (values #\^ +white-black+)) ; hills
+        (t                (values #\# +white-black+)))) ; mountains
 
 (defun render-map (window)
   (iterate
     (with terrain = *terrain*)
+    (with vx = *view-x*)
+    (with vy = *view-y*)
     (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)))
+    (for x = (+ sx vx))
+    (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))))
+
+
+(defun world-map-input (window)
+  (case (charms:get-char window)
+    (#\q :quit)
+    (:left  (zapf *view-x* (clamp (1- %) 0 20000)))
+    (:right (zapf *view-x* (clamp (1+ %) 0 20000)))
+    (:up    (zapf *view-y* (clamp (1- %) 0 20000)))
+    (:down  (zapf *view-y* (clamp (1+ %) 0 20000)))))
 
 (defun world-map ()
   (with-dims ((- *screen-width* 2) (- *screen-height* 2))
@@ -111,7 +153,7 @@
       (iterate
         (render-map map-win)
         (redraw)
-        (until (eql #\q (charms:get-char map-win))))))
+        (until (eql :quit (world-map-input map-win))))))
   nil)
 
 
@@ -121,7 +163,9 @@
     (charms:disable-echoing)
     (charms:enable-raw-input :interpret-control-characters t)
     (charms:enable-extra-keys t)
-    ; (charms:enable-non-blocking-mode t)
+    (charms/ll:start-color)
+    (charms:clear-window t)
+    (init-colors)
 
     ; todo: handle resizes
     (setf (values *screen-width* *screen-height*)
--- a/src/utilities.lisp	Sat Jan 07 13:17:51 2017 +0000
+++ b/src/utilities.lisp	Sat Jan 07 14:16:41 2017 +0000
@@ -78,6 +78,27 @@
      ,@body))
 
 
+(defmacro defcolors (&rest colors)
+  `(progn
+    ,@(iterate (for n :from 0)
+               (for (constant nil nil) :in colors)
+               (collect `(define-constant ,constant ,n)))
+    (defun init-colors ()
+      ,@(iterate
+          (for (constant fg bg) :in colors)
+          (collect `(charms/ll:init-pair ,constant ,fg ,bg))))))
+
+(defmacro with-color ((window color) &body body)
+  (once-only (window color)
+    `(unwind-protect
+       (progn
+         (charms/ll:wattron (charms::window-pointer ,window)
+                            (charms/ll:color-pair ,color))
+         ,@body)
+       (charms/ll:wattroff (charms::window-pointer ,window)
+                           (charms/ll:color-pair ,color)))))
+
+
 ;;;; Maths --------------------------------------------------------------------
 (defun center (size max)
   (truncate (- max size) 2))