e0811ef78cce

Add `or` to `key-case`, change box borders, lib path
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 14 Oct 2017 13:03:30 -0400
parents 6a6d09e57b9b
children 4f9d726d7ea6
branches/tags (none)
files src/high-level/bearlibterminal.lisp src/high-level/boxes.lisp src/low-level/bearlibterminal.lisp src/low-level/bearlibterminal.swig

Changes

--- a/src/high-level/bearlibterminal.lisp	Wed Jul 26 14:07:24 2017 -0400
+++ b/src/high-level/bearlibterminal.lisp	Sat Oct 14 13:03:30 2017 -0400
@@ -666,40 +666,44 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun parse-key-case-head (head data-symbol)
-    (if (eq t head)
-      t
-      (destructuring-bind (event &rest modifiers)
-          (ensure-list head)
-        (let* ((up (member :up modifiers))
-               (down (member :down modifiers))
-               (up/down (cond ((and up down) :both)
-                              (up :up)
-                              (down :down)
-                              (t :down)))
-               (shift (ensure-boolean
-                        (member :shift modifiers)))
-               (alt (ensure-boolean
-                      (intersection modifiers
-                                    '(:alt :option :meta))))
-               (control (ensure-boolean
-                          (intersection modifiers
-                                        '(:control :command)))))
-          `(and
-             ,(ecase up/down
-                (:both `(eql (logand ,data-symbol
-                                     ,(lognot blt/ll:+tk-key-released+))
-                          ,(find-integer event)))
-                (:up   `(eql ,data-symbol
-                          ,(logior (find-integer event)
-                                   blt/ll:+tk-key-released+)))
-                (:down `(eql ,data-symbol
-                          ,(find-integer event))))
-             (,(if shift 'progn 'not)
-              (state-boolean blt/ll:+tk-shift+))
-             (,(if control 'progn 'not)
-              (state-boolean blt/ll:+tk-control+))
-             (,(if alt 'progn 'not)
-              (state-boolean blt/ll:+tk-alt+))))))))
+    (flet ((parse-condition (condition)
+             (destructuring-bind (event &rest modifiers)
+                 (ensure-list condition)
+               (let* ((up (member :up modifiers))
+                      (down (member :down modifiers))
+                      (up/down (cond ((and up down) :both)
+                                     (up :up)
+                                     (down :down)
+                                     (t :down)))
+                      (shift (ensure-boolean
+                               (member :shift modifiers)))
+                      (alt (ensure-boolean
+                             (intersection modifiers
+                                           '(:alt :option :meta))))
+                      (control (ensure-boolean
+                                 (intersection modifiers
+                                               '(:control :command :ctrl)))))
+                 `(and
+                    ,(ecase up/down
+                       (:both `(eql (logand ,data-symbol
+                                            ,(lognot blt/ll:+tk-key-released+))
+                                 ,(find-integer event)))
+                       (:up   `(eql ,data-symbol
+                                 ,(logior (find-integer event)
+                                          blt/ll:+tk-key-released+)))
+                       (:down `(eql ,data-symbol
+                                 ,(find-integer event))))
+                    (,(if shift 'progn 'not)
+                     (state-boolean blt/ll:+tk-shift+))
+                    (,(if control 'progn 'not)
+                     (state-boolean blt/ll:+tk-control+))
+                    (,(if alt 'progn 'not)
+                     (state-boolean blt/ll:+tk-alt+)))))))
+      (cond
+        ((eq t head) t)
+        ((and (consp head) (eq (first head) 'or))
+         `(or ,@(mapcar #'parse-condition (rest head))))
+        (t (parse-condition head))))))
 
 (defmacro key-case (data &rest clauses)
   (once-only (data)
--- a/src/high-level/boxes.lisp	Wed Jul 26 14:07:24 2017 -0400
+++ b/src/high-level/boxes.lisp	Sat Oct 14 13:03:30 2017 -0400
@@ -26,7 +26,7 @@
 (defun draw-box-background (x y w h color outline?)
   (setf (blt:color) color)
   (draw-box-fill (1+ x) (1+ y) (- w 2) (- h 2))
-  (when outline?
+  (if outline?
     (draw-box-outline x y w h
                       #\lower_half_block
                       #\upper_half_block
@@ -35,7 +35,16 @@
                       #\quadrant_lower_right
                       #\quadrant_lower_left
                       #\quadrant_upper_right
-                      #\quadrant_upper_left)))
+                      #\quadrant_upper_left)
+    (draw-box-outline x y w h
+                      #\full_block
+                      #\full_block
+                      #\full_block
+                      #\full_block
+                      #\full_block
+                      #\full_block
+                      #\full_block
+                      #\full_block)))
 
 
 (defun draw-box-border-light (x y w h color)
@@ -93,49 +102,46 @@
              :height (- h 2)))
 
 
-(defun draw-box (layer x y width height contents &key
+(defun draw-box (x y width height &key
+                 (contents nil)
                  (border :light)
                  (background-color (blt:rgba 0 0 0))
                  (border-color (blt:rgba 255 255 255)))
   "Draw a box.
 
-  The box will be draw on `layer`, and the necessary area will be cleared before
-  doing so.
+  The border of the box, if present, will be one cell wide/tall.
 
-  The border of the box will be one cell wide/tall.  `border` specifies the type
-  of border to draw, and can be one of `:light`, `:heavy`, or `:double`, or
-  `nil` for a transparent border.
+  `border` specifies the type of border to draw, and can be one of `:light`,
+  `:heavy`, or `:double`, or `nil` for no border.
 
   `background-color` and `border-color` specify the colors to use.  If `nil` is
   given they will not be drawn.
 
-  The `width` and `height` measurements include the two border cells.  For
-  example: a `width` of `10` would have `8` cells of content space.
+  The `width` and `height` measurements include the two border cells, if
+  present.  For example: a `width` of `10` would have `8` cells of content
+  space with a border.
 
-  `contents` will be `print`ed inside the box with the appropriate bounds.  The
-  color, font, etc will all be whatever they are currently set to.
+  If given, `contents` will be `print`ed inside the box with the appropriate
+  bounds.  The color, font, etc will all be whatever they are currently set to.
 
   **EXPERIMENTAL**: This function is experimental and may change or be remove
   entirely in the future.
 
   "
-  (save-values (blt:composition blt:layer)
-    (setf (blt:layer) layer
-          (blt:composition) t)
-
-    (clear-area x y width height)
+  (save-value blt:composition
+    (setf (blt:composition) t)
 
-    (save-value blt:color
-      (when background-color
-        (draw-box-background x y width height background-color
-                             (and border border-color)))
-      (when (and border border-color)
-        (funcall (ecase border
-                   (:light #'draw-box-border-light)
-                   (:heavy #'draw-box-border-heavy)
-                   (:double #'draw-box-border-double)
-                   (:block #'draw-box-border-block))
-                 x y width height border-color)))
+    (when background-color
+      (draw-box-background x y width height background-color
+                           (and border border-color)))
+    (when (and border border-color)
+      (funcall (ecase border
+                 (:light #'draw-box-border-light)
+                 (:heavy #'draw-box-border-heavy)
+                 (:double #'draw-box-border-double)
+                 (:block #'draw-box-border-block))
+               x y width height border-color))
 
-    (draw-box-contents x y width height contents)))
+    (when contents
+      (draw-box-contents x y width height contents))))
 
--- a/src/low-level/bearlibterminal.lisp	Wed Jul 26 14:07:24 2017 -0400
+++ b/src/low-level/bearlibterminal.lisp	Sat Oct 14 13:03:30 2017 -0400
@@ -1,5 +1,5 @@
 ;;; This file was automatically generated by SWIG (http://www.swig.org).
-;;; Version 3.0.10
+;;; Version 3.0.12
 ;;;
 ;;; Do not make changes to this file unless you know what you are doing--modify
 ;;; the SWIG interface file instead.
@@ -9,7 +9,8 @@
 (cffi:defctype color :uint)
 
 (cffi:define-foreign-library blt:bearlibterminal
-  (:darwin (:or "Contents/Frameworks/libBearLibTerminal.dylib"
+  (:darwin (:or "Contents/Resources/libBearLibTerminal.dylib"
+                "libBearLibTerminal.dylib"
                 "lib/libBearLibTerminal.dylib")))
 
 (cffi:use-foreign-library blt:bearlibterminal)
--- a/src/low-level/bearlibterminal.swig	Wed Jul 26 14:07:24 2017 -0400
+++ b/src/low-level/bearlibterminal.swig	Sat Oct 14 13:03:30 2017 -0400
@@ -6,7 +6,8 @@
 (cffi:defctype color :uint)
 
 (cffi:define-foreign-library blt:bearlibterminal
-  (:darwin (:or "Contents/Frameworks/libBearLibTerminal.dylib"
+  (:darwin (:or "Contents/Resources/libBearLibTerminal.dylib"
+                "libBearLibTerminal.dylib"
                 "lib/libBearLibTerminal.dylib")))
 
 (cffi:use-foreign-library blt:bearlibterminal)