branch: elpa/pacmacs
commit f65f288b1802eb9755321785754dc1eaed335596
Author: rexim <[email protected]>
Commit: rexim <[email protected]>
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
