[nongnu] elpa/pacmacs f65f288b18 239/472: Cache wall tiles (#131)

[ELPA Syncer]

branch: elpa/pacmacs
commit f65f288b1802eb9755321785754dc1eaed335596
Author: rexim <reximkut@gmail.com>
Commit: rexim <reximkut@gmail.com>

    Cache wall tiles (#131)
---
 pacmacs-image.el | 90 ++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 55 insertions(+), 35 deletions(-)

diff --git a/pacmacs-image.el b/pacmacs-image.el
index 513e08ef66..faf4443b32 100644
--- a/pacmacs-image.el
+++ b/pacmacs-image.el
@@ -32,7 +32,10 @@
 
 ;;; Code:
 
+(require 'dash)
+
 (defconst pacmacs--flip-xbm-bits (eq system-type 'windows-nt))
+(defvar pacmacs--wall-blocks (make-vector 256 nil))
 
 (defun pacmacs-load-image (filename)
   (create-image filename 'xpm nil :heuristic-mask t))
@@ -69,45 +72,62 @@
     (dotimes (i width)
       (aset (aref bits (+ row w)) i t))))
 
+(defun pacmacs--bit-list-to-integer (bit-list)
+  (let ((result 0))
+    (dolist (bit bit-list)
+      (setq result (logior (lsh result 1)
+                           (if bit 1 0))))
+    result))
+
 (defun pacmacs--create-wall-block (width
                                    height color
-                                   bottom right top left
+
+                                   bottom right
+                                   top left
                                    left-upper right-upper
                                    left-bottom right-bottom)
-  (let ((wall-block (make-vector
-                     width nil))
-        (weight 3))
-
-    (dotimes (i width)
-      (aset wall-block i (make-bool-vector height nil)))
-
-    (when left-upper
-      (pacmacs--put-bits-dot wall-block 0 0 weight))
-
-    (when right-upper
-      (pacmacs--put-bits-dot wall-block 0 (- width weight) weight))
-
-    (when left-bottom
-      (pacmacs--put-bits-dot wall-block (- height weight) 0 weight))
-
-    (when right-bottom
-      (pacmacs--put-bits-dot wall-block (- height weight) (- width weight) 
weight))
-
-    (when left
-      (pacmacs--put-vertical-bar wall-block 0 height weight))
-
-    (when right
-      (pacmacs--put-vertical-bar wall-block (- width weight) height weight))
-
-    (when top
-      (pacmacs--put-horizontal-bar wall-block 0 width weight))
-    
-    (when bottom
-      (pacmacs--put-horizontal-bar wall-block (- height weight) width weight))
-
-    (create-image wall-block 'xbm t :width width :height height
-                  :foreground color
-                  :background nil)))
+  (let ((cache-index
+         (pacmacs--bit-list-to-integer
+          (list bottom right top left
+                left-upper right-upper
+                left-bottom right-bottom))))
+    (-if-let (cached-tile (aref pacmacs--wall-blocks cache-index))
+        cached-tile
+      (aset pacmacs--wall-blocks cache-index
+            (let ((wall-block (make-vector
+                               width nil))
+                  (weight 3))
+
+              (dotimes (i width)
+                (aset wall-block i (make-bool-vector height nil)))
+
+              (when left-upper
+                (pacmacs--put-bits-dot wall-block 0 0 weight))
+
+              (when right-upper
+                (pacmacs--put-bits-dot wall-block 0 (- width weight) weight))
+
+              (when left-bottom
+                (pacmacs--put-bits-dot wall-block (- height weight) 0 weight))
+
+              (when right-bottom
+                (pacmacs--put-bits-dot wall-block (- height weight) (- width 
weight) weight))
+
+              (when left
+                (pacmacs--put-vertical-bar wall-block 0 height weight))
+
+              (when right
+                (pacmacs--put-vertical-bar wall-block (- width weight) height 
weight))
+
+              (when top
+                (pacmacs--put-horizontal-bar wall-block 0 width weight))
+              
+              (when bottom
+                (pacmacs--put-horizontal-bar wall-block (- height weight) 
width weight))
+
+              (create-image wall-block 'xbm t :width width :height height
+                            :foreground color
+                            :background nil))))))
 
 (defun pacmacs-create-transparent-block (width height)
   (create-image