--- 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)
--- 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")))))
--- /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...
--- 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))
--- /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))
--- 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)
--- /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))
--- 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
--- 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 ;;;;