# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1486833243 0
# Node ID 7d9a9d2a4af236bd8deae9647a72d70bfd8eea4a
# Parent  eb92688beebc6da84ad03c20b9eb1ee1d248b5af
Finish wrapping some stuff, remove prefixes

diff -r eb92688beebc -r 7d9a9d2a4af2 examples/terrain.lisp
--- a/examples/terrain.lisp	Sat Feb 11 14:37:44 2017 +0000
+++ b/examples/terrain.lisp	Sat Feb 11 17:14:03 2017 +0000
@@ -98,31 +98,36 @@
 
 ;;;; GUI ----------------------------------------------------------------------
 (defun terrain-char (height)
-  (cond ((< height 0.4) #\~)
-        ((< height 0.7) #\.)
+  (cond ((< height 0.2) #\#)
+        ((< height 0.4) #\#)
+        ((< height 0.7) #\#)
         ((< height 0.9) #\#)
-        (t #\*)))
+        (t              #\#)))
 
 (defparameter *heightmap* (allocate-heightmap))
 
 (defun draw ()
   (iterate
-    (for-nested ((x :from 0 :below (blt::terminal-width))
-                 (y :from 0 :below (blt::terminal-height))))
-    (blt::terminal-put-char x y (terrain-char (aref *heightmap* x y))))
-  (blt::terminal-refresh))
+    (for-nested ((x :from 0 :below (min +world-size+ (blt:width)))
+                 (y :from 0 :below (min +world-size+ (blt:height)))))
+    (for height = (aref *heightmap* x y))
+    (setf
+      (blt:color) (blt:rgbaf height height height 1.0)
+      (blt:cell-char x y) (terrain-char height)))
+  ; (blt:print 1 1 "Demo!")
+  (blt:refresh))
 
 (defun config ()
-  (blt::terminal-set "window.resizeable = true")
-  (blt::terminal-set "window.cellsize = 10x10")
-  (blt::terminal-set "window.title = Terrain Gen Demo"))
+  (blt:set "window.resizeable = true")
+  (blt:set "window.cellsize = 10x10")
+  (blt:set "window.title = Terrain Gen Demo"))
 
 (defun main ()
-  (blt::with-terminal
-    (config)
+  (blt:with-terminal
     (iterate
+      (config)
       (draw)
-      (blt::key-case (blt::terminal-read)
+      (blt:key-case (blt:read)
         (:space (diamond-square *heightmap*))
         (:escape (return))
         (:close (return))))))
diff -r eb92688beebc -r 7d9a9d2a4af2 package.lisp
--- a/package.lisp	Sat Feb 11 14:37:44 2017 +0000
+++ b/package.lisp	Sat Feb 11 17:14:03 2017 +0000
@@ -7,8 +7,47 @@
   (:documentation "This package contains the low-level, SWIG-generated wrapper functions for bearlibterminal."))
 
 (defpackage :bearlibterminal/high-level
-  (:use :cl
-        :bearlibterminal.quickutils)
-  (:export)
+  (:use :cl :bearlibterminal.quickutils)
+  (:export
+
+    :background-color
+    :cell-background-color
+    :cell-char
+    :cell-code
+    :cell-color
+    :clear
+    :clear-area
+    :close
+    :color
+    :color-name
+    :composition
+    :crop
+    :has-input-p
+    :height
+    :key-case
+    :layer
+    :open
+    :peek
+    :print
+    :read
+    :refresh
+    :rgba
+    :rgbaf
+    :set
+    :sleep
+    :width
+    :with-terminal
+
+    )
+  (:shadow
+
+    :close
+    :open
+    :print
+    :read
+    :set
+    :sleep
+
+    )
   (:nicknames :blt/hl :blt)
   (:documentation "This package contains a high-level, lispy interface to bearlibterminal.  It has the nickname `blt` for easy prefixing."))
diff -r eb92688beebc -r 7d9a9d2a4af2 src/high-level/bearlibterminal.lisp
--- a/src/high-level/bearlibterminal.lisp	Sat Feb 11 14:37:44 2017 +0000
+++ b/src/high-level/bearlibterminal.lisp	Sat Feb 11 17:14:03 2017 +0000
@@ -3,6 +3,8 @@
 ; (sb-int:set-floating-point-modes :traps nil)
 
 ;;;; Utils --------------------------------------------------------------------
+(declaim (inline color-float-to-byte rgba rgbaf))
+
 (defun pr (val)
   (format t "~S~%" val)
   (finish-output)
@@ -22,14 +24,35 @@
      <>))
 
 
+(deftype color-float ()
+  '(single-float 0.0 1.0))
+
+(deftype color-byte ()
+  '(unsigned-byte 8))
+
+(deftype color ()
+  '(unsigned-byte 32))
+
+
+(defun color-float-to-byte (float)
+  (truncate (* float 255.0)))
+
 (defun rgba (r g b a)
   (-<> 0
-    (dpb a (byte 2 6) <>)
-    (dpb r (byte 2 4) <>)
-    (dpb g (byte 2 2) <>)
-    (dpb b (byte 2 0) <>)))
+    (dpb a (byte 8 24) <>)
+    (dpb r (byte 8 16) <>)
+    (dpb g (byte 8 8) <>)
+    (dpb b (byte 8 0) <>)))
 
-(defun name (color-name)
+(defun rgbaf (r g b a)
+  (declare (optimize speed)
+           (type color-float r g b a))
+  (rgba (color-float-to-byte r)
+        (color-float-to-byte g)
+        (color-float-to-byte b)
+        (color-float-to-byte a)))
+
+(defun color-name (color-name)
   (blt/ll:color-from-name color-name))
 
 
@@ -51,6 +74,17 @@
   (int-to-boolean (blt/ll:terminal-state state)))
 
 
+(defun character-to-code-point (character)
+  ;; These seem to work in SBCL, ABCL, CCL, and ECL, but I need to do more
+  ;; digging before I'm convinced.
+  (char-code character))
+
+(defun code-point-to-character (code-point)
+  ;; These seem to work in SBCL, ABCL, CCL, and ECL, but I need to do more
+  ;; digging before I'm convinced.
+  (code-char code-point))
+
+
 ;;;; Error Checking -----------------------------------------------------------
 (define-condition bearlibterminal-error (error) ())
 
@@ -60,83 +94,107 @@
 
 
 ;;;; Wrappers -----------------------------------------------------------------
-(defun terminal-open ()
+
+; Initialization and configuration: set
+; Output: put ext, measure
+; Input: read str
+
+(defun open ()
   (check (blt/ll:terminal-open)))
 
-(defun terminal-close ()
+(defun close ()
   (blt/ll:terminal-close))
 
-(defun terminal-set (configuration-string)
+(defun set (configuration-string)
   (check (blt/ll:terminal-set-8 configuration-string)))
 
 
-(defun terminal-refresh ()
+(defun refresh ()
   (blt/ll:terminal-refresh))
 
-(defun terminal-clear ()
+(defun clear ()
   (blt/ll:terminal-clear))
 
-(defun terminal-clear-area (x y width height)
+(defun clear-area (x y width height)
   (blt/ll:terminal-clear-area x y width height))
 
-(defun terminal-crop (x y width height)
+(defun crop (x y width height)
   (blt/ll:terminal-crop x y width height))
 
 
-(defun terminal-layer ()
+(defun layer ()
   (blt/ll:terminal-state blt/ll:+tk-layer+))
 
-(defun (setf terminal-layer) (new-value)
+(defun (setf layer) (new-value)
   (blt/ll:terminal-layer new-value)
   new-value)
 
 
-(defun terminal-color ()
+(defun color ()
   (blt/ll:terminal-state blt/ll:+tk-color+))
 
-(defun (setf terminal-color) (color)
+(defun (setf color) (color)
   (blt/ll:terminal-color color))
 
 
-(defun terminal-background-color ()
+(defun background-color ()
   (blt/ll:terminal-state blt/ll:+tk-bkcolor+))
 
-(defun (setf terminal-background-color) (color)
+(defun (setf background-color) (color)
   (blt/ll:terminal-bkcolor color))
 
 
-(defun terminal-composition ()
+(defun composition ()
   (onoff-to-boolean (blt/ll:terminal-state blt/ll:+tk-composition+)))
 
-(defun (setf terminal-composition) (new-value)
+(defun (setf composition) (new-value)
   (blt/ll:terminal-composition (boolean-to-onoff new-value))
   new-value)
 
 
-(defun terminal-has-input-p ()
+(defun has-input-p ()
   (int-to-boolean (blt/ll:terminal-has-input)))
 
-(defun terminal-read ()
+(defun read ()
   (blt/ll:terminal-read))
 
-(defun terminal-peek ()
+(defun peek ()
   (blt/ll:terminal-peek))
 
-(defun terminal-delay (seconds)
+(defun sleep (seconds)
   (blt/ll:terminal-delay (truncate (* seconds 1000))))
 
 
-(defun terminal-put-char (x y char)
-  (blt/ll:terminal-put x y (char-code char)))
+(defun width ()
+  (blt/ll:terminal-state blt/ll:+tk-width+))
+
+(defun height ()
+  (blt/ll:terminal-state blt/ll:+tk-height+))
+
 
-(defun terminal-put-code (x y code-point)
+(defun cell-code (x y &optional (index 0))
+  (let ((code (blt/ll:terminal-pick x y index)))
+    (if (zerop code)
+      nil
+      code)))
+
+(defun cell-char (x y &optional (index 0))
+  (let ((code (cell-code x y index)))
+    (when code (code-point-to-character code))))
+
+
+(defun (setf cell-code) (code-point x y)
   (blt/ll:terminal-put x y code-point))
 
-(defun terminal-width ()
-  (blt/ll:terminal-state blt/ll:+tk-width+))
+(defun (setf cell-char) (character x y)
+  (blt/ll:terminal-put x y (character-to-code-point character)))
+
 
-(defun terminal-height ()
-  (blt/ll:terminal-state blt/ll:+tk-height+))
+(defun cell-color (x y &optional (index 0))
+  (blt/ll:terminal-pick-color x y index))
+
+(defun cell-background-color (x y)
+  (blt/ll:terminal-pick-bkcolor x y))
 
 
 ;;;; Higher-Level API ---------------------------------------------------------
@@ -150,10 +208,10 @@
 
 (defmacro with-terminal (&body body)
   `(defuck-floats
-     (terminal-open)
+     (open)
      (unwind-protect
          (progn ,@body)
-       (terminal-close))))
+       (close))))
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -313,10 +371,10 @@
 (defun test ()
   (trivial-main-thread:with-body-in-main-thread (:blocking t)
     (with-terminal
-      (terminal-refresh)
-      (terminal-set "input.filter = [keyboard+, mouse+]")
+      (refresh)
+      (set "input.filter = [keyboard+, mouse+]")
       (loop
-        :for data = (terminal-read)
+        :for data = (read)
         :do (pr data)
         :while (key-case data
                  ((:a :down) (pr "A down") t)