34cb41653c41

Start the rendering code
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 07 Jan 2017 12:10:22 +0000
parents 89bab7d1eaef
children 91b6c62b6f75
branches/tags (none)
files .lispwords antipodes.asd data/logo.txt package.lisp src/gen/world.lisp src/main.lisp src/utilities.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

diff -r 89bab7d1eaef -r 34cb41653c41 .lispwords
--- a/.lispwords	Sat Jan 07 11:21:42 2017 +0000
+++ b/.lispwords	Sat Jan 07 12:10:22 2017 +0000
@@ -0,0 +1,1 @@
+(1 with-panel-and-window)
diff -r 89bab7d1eaef -r 34cb41653c41 antipodes.asd
--- a/antipodes.asd	Sat Jan 07 11:21:42 2017 +0000
+++ b/antipodes.asd	Sat Jan 07 12:10:22 2017 +0000
@@ -9,6 +9,7 @@
   :depends-on (:beast
                :cl-arrows
                :cl-charms
+               :cl-strings
                :iterate
                :losh)
 
@@ -18,4 +19,8 @@
                              (:file "quickutils")))
                (:file "package")
                (:module "src" :serial t
-                :components ((:file "main")))))
+                :components
+                ((:file "utilities")
+                 (:module "gen" :serial t
+                  :components ((:file "world")))
+                 (:file "main")))))
diff -r 89bab7d1eaef -r 34cb41653c41 data/logo.txt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/data/logo.txt	Sat Jan 07 12:10:22 2017 +0000
@@ -0,0 +1,6 @@
+   _         _   _                 _            
+  /_\  _ __ | |_(_)_ __   ___   __| | ___  ___  
+ //_\\| '_ \| __| | '_ \ / _ \ / _` |/ _ \/ __| 
+/  _  \ | | | |_| | |_) | (_) | (_| |  __/\__ \ 
+\_/ \_/_| |_|\__|_| .__/ \___/ \__,_|\___||___/ 
+                  |_| Press any key to begin... 
diff -r 89bab7d1eaef -r 34cb41653c41 package.lisp
--- a/package.lisp	Sat Jan 07 11:21:42 2017 +0000
+++ b/package.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -1,4 +1,4 @@
-(defpackage :ap
+(defpackage :ap.utilities
   (:use
     :cl
     :iterate
@@ -7,4 +7,41 @@
     :beast
     :ap.quickutils)
   (:export
+    :with-window
+    :with-windows
+    :with-panels
+    :with-panel
+    :with-panel-and-window
+    :with-panels-and-windows
+    :center
+    :border
+    :redraw
+    :write-string-left
+    :write-string-centered
+    :write-lines-left
+    :write-lines-centered
+    :with-dims
+    ))
+
+(defpackage :ap.gen
+  (:use
+    :cl
+    :iterate
+    :cl-arrows
+    :losh
+    :beast
+    :ap.utilities
+    :ap.quickutils)
+  (:export))
+
+(defpackage :ap
+  (:use
+    :cl
+    :iterate
+    :cl-arrows
+    :losh
+    :beast
+    :ap.utilities
+    :ap.quickutils)
+  (:export
     :main))
diff -r 89bab7d1eaef -r 34cb41653c41 src/gen/world.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gen/world.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -0,0 +1,12 @@
+(in-package :ap.gen)
+
+
+(define-constant +chunk-size+ (expt 2 8))
+
+(defun make-empty-heightmap ()
+  (make-array (list +chunk-size+ +chunk-size+)
+    :element-type 'single-float
+    :initial-element 0.0))
+
+(defun generate-heightmap ()
+  (make-empty-heightmap))
diff -r 89bab7d1eaef -r 34cb41653c41 src/main.lisp
--- a/src/main.lisp	Sat Jan 07 11:21:42 2017 +0000
+++ b/src/main.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -1,9 +1,42 @@
 (in-package :ap)
 
-; (declaim (optimize (speed 3) (debug 0) (safety 0)))
-; (declaim (optimize (speed 3) (debug 0) (safety 1)))
-; (declaim (optimize (speed 1) (debug 1) (safety 1)))
+
+;;;; Data ---------------------------------------------------------------------
+(defparameter *logo* (read-file-into-string "data/logo.txt"))
+
+(defparameter *screen-width* nil)
+(defparameter *screen-height* nil)
+
+(defparameter *width* nil)
+(defparameter *height* nil)
 
 
+;;;; State Machine ------------------------------------------------------------
+(defun title ()
+  (with-dims (50 10)
+    (with-panel-and-window
+        (pan win *width* *height*
+             (center *width* *screen-width*)
+             (center *height* *screen-height*))
+      (write-lines-centered win *logo* 0)
+      (redraw)
+      (charms:get-char win))))
+
+
+;;;; Main ---------------------------------------------------------------------
 (defun main ()
+  (charms:with-curses ()
+    (charms:disable-echoing)
+    (charms:enable-raw-input :interpret-control-characters t)
+    (charms:enable-extra-keys t)
+    ; (charms:enable-non-blocking-mode t)
+
+    ; todo: handle resizes
+    (setf (values *screen-width* *screen-height*)
+          (charms:window-dimensions t))
+
+    (let ((*width* *screen-width*)
+          (*height* *screen-height*))
+      (title)))
+
   t)
diff -r 89bab7d1eaef -r 34cb41653c41 src/utilities.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/utilities.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -0,0 +1,76 @@
+(in-package :ap.utilities)
+
+;;;; Charms -------------------------------------------------------------------
+(defmacro with-window ((symbol width height x y) &body body)
+  `(let ((,symbol (charms:make-window ,width ,height ,x ,y)))
+     (unwind-protect (progn ,@body)
+       (charms:destroy-window ,symbol))))
+
+(defmacro with-panel ((symbol window) &body body)
+  `(let ((,symbol (charms:make-panel ,window)))
+     (unwind-protect (progn ,@body)
+       (charms:destroy-panel ,symbol))))
+
+(defmacro with-windows (bindings &body body)
+  (if (null bindings)
+    `(progn ,@body)
+    `(with-window ,(first bindings)
+       (with-windows ,(rest bindings)
+         ,@body))))
+
+(defmacro with-panels (bindings &body body)
+  (if (null bindings)
+    `(progn ,@body)
+    `(with-panel ,(first bindings)
+       (with-panels ,(rest bindings)
+         ,@body))))
+
+(defmacro with-panel-and-window
+    ((panel-symbol window-symbol width height x y) &body body)
+  `(with-window (,window-symbol ,width ,height ,x ,y)
+     (with-panel (,panel-symbol ,window-symbol)
+       ,@body)))
+
+(defmacro with-panels-and-windows (bindings &body body)
+  (if (null bindings)
+    `(progn ,@body)
+    `(with-panel-and-window ,(first bindings)
+       (with-panels-and-windows ,(rest bindings)
+         ,@body))))
+
+
+(defun border (window)
+  (charms::check-status
+    (charms/ll:wborder (charms::window-pointer window) 0 0 0 0 0 0 0 0))
+  t)
+
+(defun redraw ()
+  (charms:update-panels)
+  (charms:update))
+
+
+(defun write-string-left (window string x y)
+  (charms:write-string-at-point window string x y))
+
+(defun write-string-centered (window string y)
+  (charms:write-string-at-point window string (center (length string) *width*) y))
+
+(defun write-lines-left (window string start-x start-y)
+  (iterate (for line :in (cl-strings:split string #\newline))
+           (for y :from start-y)
+           (write-string-left window line start-x y)))
+
+(defun write-lines-centered (window string start-y)
+  (iterate (for line :in (cl-strings:split string #\newline))
+           (for y :from start-y)
+           (write-string-centered window line y)))
+
+(defmacro with-dims ((width height) &body body)
+  `(let ((ap::*width* ,width)
+         (ap::*height* ,height))
+     ,@body))
+
+
+;;;; Maths --------------------------------------------------------------------
+(defun center (size max)
+  (truncate (- max size) 2))
diff -r 89bab7d1eaef -r 34cb41653c41 vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Sat Jan 07 11:21:42 2017 +0000
+++ b/vendor/make-quickutils.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -6,9 +6,11 @@
 
                :compose
                :curry
+               :define-constant
                :mkstr
                :once-only
                :rcurry
+               :read-file-into-string
                :symb
                :with-gensyms
 
diff -r 89bab7d1eaef -r 34cb41653c41 vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Sat Jan 07 11:21:42 2017 +0000
+++ b/vendor/quickutils.lisp	Sat Jan 07 12:10:22 2017 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :MKSTR :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "AP.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :MKSTR :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "AP.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AP.QUICKUTILS")
@@ -14,9 +14,11 @@
 
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :COMPOSE :CURRY :MKSTR :ONCE-ONLY
-                                         :RCURRY :SYMB :STRING-DESIGNATOR
-                                         :WITH-GENSYMS))))
+                                         :COMPOSE :CURRY :DEFINE-CONSTANT
+                                         :MKSTR :ONCE-ONLY :RCURRY
+                                         :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
+                                         :READ-FILE-INTO-STRING :SYMB
+                                         :STRING-DESIGNATOR :WITH-GENSYMS))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -90,6 +92,43 @@
            (apply ,fun ,@curries more)))))
   
 
+  (defun %reevaluate-constant (name value test)
+    (if (not (boundp name))
+        value
+        (let ((old (symbol-value name))
+              (new value))
+          (if (not (constantp name))
+              (prog1 new
+                (cerror "Try to redefine the variable as a constant."
+                        "~@<~S is an already bound non-constant variable ~
+                       whose value is ~S.~:@>" name old))
+              (if (funcall test old new)
+                  old
+                  (restart-case
+                      (error "~@<~S is an already defined constant whose value ~
+                              ~S is not equal to the provided initial value ~S ~
+                              under ~S.~:@>" name old new test)
+                    (ignore ()
+                      :report "Retain the current value."
+                      old)
+                    (continue ()
+                      :report "Try to redefine the constant."
+                      new)))))))
+
+  (defmacro define-constant (name initial-value &key (test ''eql) documentation)
+    "Ensures that the global variable named by `name` is a constant with a value
+that is equal under `test` to the result of evaluating `initial-value`. `test` is a
+function designator that defaults to `eql`. If `documentation` is given, it
+becomes the documentation string of the constant.
+
+Signals an error if `name` is already a bound non-constant variable.
+
+Signals an error if `name` is already a constant variable whose value is not
+equal under `test` to result of evaluating `initial-value`."
+    `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
+       ,@(when documentation `(,documentation))))
+  
+
   (defun mkstr (&rest args)
     "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
 
@@ -147,6 +186,58 @@
         (multiple-value-call fn (values-list more) (values-list arguments)))))
   
 
+  (defmacro with-open-file* ((stream filespec &key direction element-type
+                                                   if-exists if-does-not-exist external-format)
+                             &body body)
+    "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use
+the default value specified for `open`."
+    (once-only (direction element-type if-exists if-does-not-exist external-format)
+      `(with-open-stream
+           (,stream (apply #'open ,filespec
+                           (append
+                            (when ,direction
+                              (list :direction ,direction))
+                            (when ,element-type
+                              (list :element-type ,element-type))
+                            (when ,if-exists
+                              (list :if-exists ,if-exists))
+                            (when ,if-does-not-exist
+                              (list :if-does-not-exist ,if-does-not-exist))
+                            (when ,external-format
+                              (list :external-format ,external-format)))))
+         ,@body)))
+  
+
+  (defmacro with-input-from-file ((stream-name file-name &rest args
+                                                         &key (direction nil direction-p)
+                                                         &allow-other-keys)
+                                  &body body)
+    "Evaluate `body` with `stream-name` to an input stream on the file
+`file-name`. `args` is sent as is to the call to `open` except `external-format`,
+which is only sent to `with-open-file` when it's not `nil`."
+    (declare (ignore direction))
+    (when direction-p
+      (error "Can't specifiy :DIRECTION for WITH-INPUT-FROM-FILE."))
+    `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
+       ,@body))
+  
+
+  (defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
+    "Return the contents of the file denoted by `pathname` as a fresh string.
+
+The `external-format` parameter will be passed directly to `with-open-file`
+unless it's `nil`, which means the system default."
+    (with-input-from-file
+        (file-stream pathname :external-format external-format)
+      (let ((*print-pretty* nil))
+        (with-output-to-string (datum)
+          (let ((buffer (make-array buffer-size :element-type 'character)))
+            (loop
+              :for bytes-read = (read-sequence buffer file-stream)
+              :do (write-sequence buffer datum :start 0 :end bytes-read)
+              :while (= bytes-read buffer-size)))))))
+  
+
   (defun symb (&rest args)
     "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
 
@@ -200,7 +291,7 @@
     `(with-gensyms ,names ,@forms))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry mkstr once-only rcurry symb with-gensyms
-            with-unique-names)))
+  (export '(compose curry define-constant mkstr once-only rcurry
+            read-file-into-string symb with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;