# HG changeset patch # User Steve Losh # Date 1483798601 0 # Node ID d0c6e89468c247db983a646e87586309711e5bd5 # Parent 552921869758d72c6068fd648439d028ad703aa6 Maps and colors oh my diff -r 552921869758 -r d0c6e89468c2 antipodes.asd --- 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"))))) diff -r 552921869758 -r d0c6e89468c2 package.lisp --- 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 diff -r 552921869758 -r d0c6e89468c2 src/ent/player.lisp --- /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) diff -r 552921869758 -r d0c6e89468c2 src/gen/world.lisp --- 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 () diff -r 552921869758 -r d0c6e89468c2 src/main.lisp --- 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*) diff -r 552921869758 -r d0c6e89468c2 src/utilities.lisp --- 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))