# HG changeset patch # User Steve Losh # Date 1508000610 14400 # Node ID e0811ef78cce9d80aae90f43a77b33bac6e0d421 # Parent 6a6d09e57b9b2401a976ece83ea380c814fc1e46 Add `or` to `key-case`, change box borders, lib path diff -r 6a6d09e57b9b -r e0811ef78cce src/high-level/bearlibterminal.lisp --- 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) diff -r 6a6d09e57b9b -r e0811ef78cce src/high-level/boxes.lisp --- 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)))) diff -r 6a6d09e57b9b -r e0811ef78cce src/low-level/bearlibterminal.lisp --- 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) diff -r 6a6d09e57b9b -r e0811ef78cce src/low-level/bearlibterminal.swig --- 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)