# HG changeset patch # User Steve Losh # Date 1483791022 0 # Node ID 34cb41653c41aab4f6775b40c9262c102cb5cbf2 # Parent 89bab7d1eaefc05002f346f491db7c50caff1a04 Start the rendering code 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 ;;;;