--- 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)