# HG changeset patch # User Steve Losh # Date 1483661360 0 # Node ID 080c2eeb0986ad778c6a61a1dac64502d4bb614b # Parent 6f663e0f9da6e94f00127212a6c068db5e811a34 Experiment with curses panels diff -r 6f663e0f9da6 -r 080c2eeb0986 src/ascii.lisp --- a/src/ascii.lisp Fri Dec 30 16:42:58 2016 -0500 +++ b/src/ascii.lisp Fri Jan 06 00:09:20 2017 +0000 @@ -4,111 +4,32 @@ (defparameter *running* nil) (defparameter *running* t) -(defparameter *ball* (list :x 0 :y 20 :vx 1)) +(defparameter *ball* (list :x 0 :y 6 :vx 2)) (defparameter *width* 1) (defparameter *height* 1) - - -;;;; Color -------------------------------------------------------------------- -(defmethod print-object ((object hash-table) stream) - (let* ((keys (hash-table-keys object)) - (vals (hash-table-values object)) - (count (hash-table-count object)) - (key-width (-<> keys - (mapcar (compose #'length #'prin1-to-string) <>) - (reduce #'max <> :initial-value 0) - (clamp 0 20 <>)))) - (print-unreadable-object (object stream :type t :identity nil) - (format stream ":test ~A :count ~D {~%~{~{ ~vs ~s~}~%~}}" - (hash-table-test object) - count - (loop - :with limit = 40 - :for key :in keys - :for val :in vals - :for i :from 0 :to limit - :collect (if (= i limit) - (list key-width 'too-many-items (list (- count i) 'more)) - (list key-width key val))))))) - - -(defvar *colors* (make-hash-table)) -(defvar *color-pairs* (make-hash-table)) -(defvar *color-pair-counter* 100) - -(defun initialize-color () - (charms/ll:start-color) - (clrhash *color-pairs*) - (setf *color-pair-counter* 100) - (iterate - (for (nil (number r g b)) :in-hashtable *colors*) - (charms/ll:init-color number r g b))) - +(defparameter *window-x* 0) +(defparameter *window-y* 0) -(defun color-content (color-index) - (cffi:with-foreign-objects ((r :short) (g :short) (b :short)) - (charms/ll:color-content 1 r g b) - (list (cffi:mem-ref r :short) - (cffi:mem-ref g :short) - (cffi:mem-ref b :short)))) - -(defmacro with-attr (attr &body body) - `(prog2 - (charms/ll:attron ,attr) - (progn ,@body) - (charms/ll:attroff ,attr))) - - -(defun define-color (name number r g b) - (flet ((conv (fl) - (clamp 0 999 (truncate (* 1000 fl))))) - (setf (gethash name *colors*) - (list number (conv r) (conv g) (conv b))) - (clrhash *color-pairs*) ; fuck it - t)) - -(define-color :black 100 0 0 0) -(define-color :lavender 101 0.733 0.549 0.757) -(define-color :peach 102 0.831 0.537 0.416) -(define-color :red 103 1 0 0) - -(defun setup-color-pair (fg bg) - (let ((pair-id (incf *color-pair-counter*))) - (charms/ll:init-pair pair-id - (first (gethash fg *colors*)) - (first (gethash bg *colors*))) - pair-id)) - -(defun retrieve-color-pair (fg bg) - (-<> *color-pairs* - (ensure-gethash bg <> (make-hash-table)) - (ensure-gethash fg <> (setup-color-pair fg bg)) - (charms/ll:color-pair <>))) - -(defmacro with-color ((fg bg) &body body) - `(with-attr (retrieve-color-pair ,fg ,bg) - ,@body)) - -(defun render () - (with-color (:red :red) - (charms:write-string-at-point charms:*standard-window* - "KINGBREAKER" - 10 8)) - (charms:move-cursor charms:*standard-window* +(defun render (window) + (charms:clear-window window) + (charms:move-cursor window (getf *ball* :x) (getf *ball* :y)) - (charms:write-char-at-cursor charms:*standard-window* #\o) - (charms:move-cursor charms:*standard-window* 0 0) + (charms:write-char-at-cursor window #\@) + ; (charms:move-cursor window 0 0) ) (defun tick () (incf (getf *ball* :x) (getf *ball* :vx)) - (when (not (< 0 (getf *ball* :x) (1- *width*))) - (negatef (getf *ball* :vx))) - (setf (getf *ball* :y) (truncate (/ *height* 2)))) + (when (not (in-range-p 0 (getf *ball* :x) 10)) + (negatef (getf *ball* :vx)) + (zapf (getf *ball* :x) + (max 0 (min (1- 10) %)))) + ; (setf (getf *ball* :y) (truncate (/ *height* 2))) + ) (defparameter *input* nil) (defun handle-input () @@ -117,6 +38,10 @@ (push input *input*)) (case input ((nil) nil) + (#\h (zapf *window-x* (1- %))) + (#\j (zapf *window-y* (1+ %))) + (#\k (zapf *window-y* (1- %))) + (#\l (zapf *window-x* (1+ %))) (#\q (setf *running* nil))))) (defun manage-screen () @@ -124,23 +49,61 @@ (charms:window-dimensions charms:*standard-window*) (setf *width* w *height* h))) +(defun fill-window (window width height ch) + (iterate (for-nested ((x :from 0 :below width) + (y :from 0 :below height))) + (charms:write-char-at-point window ch x y))) + +(defmacro with-window ((symbol width height start-x start-y) &body body) + `(let ((,symbol (charms:make-window ,width ,height ,start-x ,start-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)))) + + (defun run () (setf *running* t) (charms:with-curses () (charms:disable-echoing) (charms:enable-raw-input :interpret-control-characters t) (charms:enable-non-blocking-mode charms:*standard-window*) - (initialize-color) - (iterate - (while *running*) - (charms:clear-window charms:*standard-window*) - (manage-screen) - (handle-input) - (tick) - (render) - (charms:refresh-window charms:*standard-window*) - (sleep 0.1)))) + (with-windows ((x-win 20 20 1 1) + (ball-win 10 10 0 0) + (o-win 5 5 4 0)) + (fill-window x-win 20 20 #\x) + (fill-window o-win 5 5 #\O) + (with-panels ((x-pan x-win) + (ball-pan ball-win) + (o-pan o-win)) + (iterate + (while *running*) + (manage-screen) + (handle-input) + (tick) + (charms:move-panel ball-pan *window-x* *window-y*) + (render ball-win) + (charms:update-panels) + (charms:update) + (sleep 0.1)))))) ; (run)