6de2b94783d5
More examples
| author | Steve Losh <steve@stevelosh.com> |
|---|---|
| date | Thu, 13 Apr 2017 12:42:10 +0000 |
| parents | 6fdb6639f071 |
| children | a2fb5d06bfb6 |
| branches/tags | (none) |
| files | .lispwords examples/box.lisp examples/build.lisp examples/map.lisp examples/sample-map.txt package.lisp src/high-level/bearlibterminal.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp |
Changes
--- a/.lispwords Wed Apr 12 13:08:18 2017 +0000 +++ b/.lispwords Thu Apr 13 12:42:10 2017 +0000 @@ -1,1 +1,2 @@ (1 key-case) +(1 in-layer in-clear-layer)
--- a/examples/box.lisp Wed Apr 12 13:08:18 2017 +0000 +++ b/examples/box.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -6,8 +6,9 @@ (in-package :cl-blt.examples.box) ;;;; GUI ---------------------------------------------------------------------- -(defun clear-layer (layer) - (setf (blt:layer) layer) +(defun clear-layer (&optional layer) + (when layer + (setf (blt:layer) layer)) (blt:clear-area 0 0 (blt:width) (blt:height))) @@ -15,7 +16,7 @@ (setf (blt:layer) 0) (iterate (for-nested ((x :from 0 :below (truncate (blt:width) 2)) (y :from 0 :below (truncate (blt:height) 2)))) - (for color = (random-range 0.5 0.9)) + (for color = (random-range 0.1 0.3)) (setf (blt:color) (blt:rgba color color color) (blt:cell-char (* 2 x) (* 2 y)) (random-elt "abcdefghijklmnopqrstuvwxyz")))) @@ -111,6 +112,50 @@ (collect (word-wrap-line line width))))) +(defun read-string (x y maximum-length &key (font "")) + (let ((result (make-array maximum-length + :element-type 'character + :fill-pointer 0))) + ;; Have to do the `print` fuckery so non-1x1 fonts work right. + (labels ((draw-string () + (blt:print x y (format nil "[font=~A]~V,,,'_A[/font]" + font maximum-length result)))) + (iterate + (clear-layer) + (draw-string) + (blt:refresh) + (blt:key-case (blt:read) + (:escape (return)) + (:close (return)) + (:enter (return result)) + (:backspace (when (plusp (length result)) + (vector-pop result))) + (t (let ((char (blt:character-input))) + (when (and char (< (length result) maximum-length)) + (vector-push char result))))) + (blt:refresh) + (finally-protected (clear-layer) + (blt:refresh)))))) + +(defun get-user-input (x y layer prompt maximum-length) + (draw-box x y (+ 3 (max (length prompt) + maximum-length)) + 6 + prompt + layer) + (setf (blt:layer) (+ layer 2)) + (prog1 (read-string (+ x 1) + (+ y 3) + maximum-length + :font "normal") + (clear-layer layer) + (clear-layer (1+ layer)))) + +(defun get-name () + (clear-layer 15) + (pr (get-user-input 0 10 10 "What is your name?" 15))) + + (defun draw () (draw-box 3 3 20 10 (format nil "[color=red]hello~%world! how [font=italic]close[font=normal] can [font=bold]we[font=normal] get here, what if we go over oh no![/color]") 5) @@ -136,5 +181,6 @@ (draw) (blt:key-case (blt:read) (:space (draw-background)) + (:enter (get-name)) (:escape (return)) (:close (return))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/build.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -0,0 +1,7 @@ +(load "examples/map.lisp") +(sb-ext:gc :full t) +(sb-ext:save-lisp-and-die + "map" + :toplevel #'cl-blt.examples.map::main + :executable t) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/map.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -0,0 +1,116 @@ +;; (ql:quickload '(:cl-blt :losh :iterate :split-sequence)) +(asdf:load-system :cl-blt) +(asdf:load-system :losh) +(asdf:load-system :iterate) +(asdf:load-system :split-sequence) + +(defpackage :cl-blt.examples.map + (:use :cl :losh :iterate :bearlibterminal.quickutils)) + +(in-package :cl-blt.examples.map) + +(defun clear-layer (&optional layer) + (when layer + (setf (blt:layer) layer)) + (blt:clear-area 0 0 (blt:width) (blt:height))) + +(defmacro in-layer (layer &body body) + (let ((previous-layer (gensym))) + `(let ((,previous-layer (blt:layer))) + (setf (blt:layer) ,layer) + (unwind-protect (progn ,@body) + (setf (blt:layer) ,previous-layer))))) + +(defmacro in-clear-layer (layer &body body) + `(in-layer ,layer + (clear-layer) + ,@body)) + + +(defstruct tile + (glyph #\Space :type character) + (color 0 :type blt::color)) + +(defun draw-map (map) + (in-clear-layer 0 + (iterate + (with (map-width map-height) = (array-dimensions map)) + (for-nested ((x :from 0 :below (min map-width (truncate (blt:width) 2))) + (y :from 0 :below (min map-height (truncate (blt:height) 2))))) + (for tile = (aref map x y)) + (setf (blt:color) (tile-color tile) + (blt:cell-char (* 2 x) (* 2 y)) (tile-glyph tile))))) + +(defun make-random-tile () + (make-tile :glyph (random-elt ",.") + :color (blt:hsva 0.4 + (random-range 0.4 0.9) + (random-range 0.4 0.9)))) + +(defun make-random-map (width height) + (let ((map (make-array (list width height) + :element-type 'tile + :initial-element (make-random-tile)))) + (iterate + (for (_ x y) :in-array map) + (setf (aref map x y) (make-random-tile))) + map)) + + +(defun read-map-from-file (filename) + (iterate + (with lines = (split-sequence:split-sequence + #\newline + (read-file-into-string filename))) + (with height = (length lines)) + (with width = (reduce #'max (mapcar #'length lines))) + (with result = (make-array (list width height) + :element-type 'tile + :initial-element (make-tile))) + (for y :from 0) + (for line :in lines) + (iterate (for x :from 0) + (for char :in-vector line) + (setf (aref result x y) + (make-tile :glyph char + :color (blt:hsva 1.0 0.0 1.0)))) + (finally (return result)))) + +(defparameter *map* nil) +(defparameter *size* 10) + +(defun draw () + (blt:clear) + (draw-map *map*) + (blt:refresh)) + +(defun resize (new-cell-size) + (let ((c new-cell-size) + (cc (* 2 new-cell-size))) + (blt:set (format nil "normal font: ./examples/UbuntuMono/UbuntuMono-R.ttf, size=~Dx~D, spacing=1x2, align=center;" c cc)) + (blt:set (format nil "italic font: ./examples/UbuntuMono/UbuntuMono-RI.ttf, size=~Dx~D, spacing=1x2, align=center;" c cc)) + (blt:set (format nil "bold font: ./examples/UbuntuMono/UbuntuMono-B.ttf, size=~Dx~D, spacing=1x2, align=center;" c cc)) + (blt:set (format nil "font: ./examples/ProggySquare/ProggySquare.ttf, size=~Dx~D, spacing=2x2, align=dead-center;" cc cc)) + (blt:set (format nil "window.cellsize = ~Dx~D" c c)))) + +(defun config () + (blt:set "window.resizeable = true") + (blt:set "window.size = 80x50") + (blt:set "window.title = Map Demo")) + +(defun main () + (blt:with-terminal + (setf *size* 10) + (setf *map* (make-random-map 10 10)) + (resize *size*) + (config) + (iterate + (draw) + (blt:key-case (blt:read) + (:space (setf *map* (make-random-map (random-range 1 100) + (random-range 1 100)))) + (:r (setf *map* (read-map-from-file "examples/sample-map.txt"))) + (:numpad-plus (incf *size* 1) (resize *size*)) + (:numpad-minus (setf *size* (max 1 (1- *size*))) (resize *size*)) + (:escape (return)) + (:close (return))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/sample-map.txt Thu Apr 13 12:42:10 2017 +0000 @@ -0,0 +1,30 @@ +...................................................................,...... +............,,,,,,,,,,,,,,,,,,,,,,,,,..............................,...... +..................,,,,,,,..........................................,.,,... +.........................,,,,,,,,,,,,...........,..................,,..... +...................,,,...............,...........,,,,,.............,,..... +..................,..,................,...............,...........,,,..... +.........---------------,,,............,,,,,,,,,,,.....,,,,,,.....,,,..... +.........- -,,,,...,,,,,,,,,,,,.......,,,,,,,,,.....,,.,,..... +.........- -,,,,,,,.......,,,,,,,,,,,,,,,...........,..,...... +.........- -..,.,......,,,,,,,,,....................,..,...... +........,- -,,,,,..,,,,,,........................,,,,..,...... +.......,,----+----------,,,,,,,,,,,...............,,,.........,....,...... +.......,....._.......,,,,,,,...,,...........,,,......,,,......,....,...... +.......,....._....,,,,,.,,,,,,,,,,,........,.,..........,......,...,...... +............._...,,,,,,,,...,..........,,,,.,............,.....,...,...... +............._....,,,,,,,,,,,,,,,,,,,,,,...,.............,,....,...,,,,,,. +............._,,,,.,,,,,,,,,,......,,,,,,,,.............,.......,..,....., +............._..,,,,,,,,..........,,,............,,,,,,,.........,.,....., +...........,,_,,............,,,,,,,,,,,,,,,.....,.................,,...,,. +............._...........,,,,,,,,,,..,.........,...............,,,,,,,,,,. +......,......_.........,,,,,,,,,,,,,,....,,,,,,....,,,,,,,,,,,,.,..,,,,... +.....,......._.........,,,,,,,..........,.........,,,,,,,,,,,,,,...,...... +....,,,,,,,..__________,,,,,,,,,,,,,,,,,,,,,,,,,,,..................,..... +.....,,,,.............____..........,...,,,,,,,,,..,,,,,.............,.... +....,......................_......,,,,,,............,................,.... +....,,,,,,,,................__.....................,.................,.... +........,.....................__..............,,,,,,,,,,,,....,,,,,.,..... +...,,,,,........................__............,,,,,..,,,,,,,,,....,,...... +..,..............................._................,,,............,,...... +,,.................................____...................................
--- a/package.lisp Wed Apr 12 13:08:18 2017 +0000 +++ b/package.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -15,35 +15,35 @@ :cell-char :cell-code :cell-color + :character-input :clear :clear-area :close :color :color-name - :mouse - :mouse-x - :mouse-y + :color-to-hsva + :color-to-rgba :composition :crop :has-input-p :height + :hsva :key-case :layer + :mouse + :mouse-x + :mouse-y :open :peek :print :read :refresh + :rgba :set :sleep :width :with-terminal - :rgba - :hsva - :color-to-rgba - :color-to-hsva - ) (:shadow
--- a/src/high-level/bearlibterminal.lisp Wed Apr 12 13:08:18 2017 +0000 +++ b/src/high-level/bearlibterminal.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -370,6 +370,11 @@ (blt/ll:terminal-delay (truncate (* seconds 1000)))) +(defun character-input () + (when (state-boolean blt/ll:+tk-wchar+) + (code-char (blt/ll:terminal-state blt/ll:+tk-wchar+)))) + + (defun width () (blt/ll:terminal-state blt/ll:+tk-width+))
--- a/vendor/make-quickutils.lisp Wed Apr 12 13:08:18 2017 +0000 +++ b/vendor/make-quickutils.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -11,6 +11,7 @@ :mkstr :once-only :rcurry + :read-file-into-string :symb :with-gensyms
--- a/vendor/quickutils.lisp Wed Apr 12 13:08:18 2017 +0000 +++ b/vendor/quickutils.lisp Thu Apr 13 12:42:10 2017 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "BEARLIBTERMINAL.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "BEARLIBTERMINAL.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "BEARLIBTERMINAL.QUICKUTILS") @@ -16,7 +16,9 @@ (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-LIST :MKSTR :ONCE-ONLY :RCURRY - :SYMB :STRING-DESIGNATOR :WITH-GENSYMS)))) + :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`, @@ -159,6 +161,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. @@ -213,6 +267,6 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (export '(compose curry ensure-boolean ensure-list mkstr once-only rcurry - symb with-gensyms with-unique-names))) + read-file-into-string symb with-gensyms with-unique-names))) ;;;; END OF quickutils.lisp ;;;;