[nongnu] elpa/pacmacs 66cdd67cbb 387/472: Merge pull request #186 from codingteam/prettier-walls-138

[ELPA Syncer]

branch: elpa/pacmacs
commit 66cdd67cbbf6c9152d6b4cc125e21afe2431e28a
Merge: 4ce9773129 365bfaee8e
Author: Alexey Kutepov <reximkut@gmail.com>
Commit: Alexey Kutepov <reximkut@gmail.com>

    Merge pull request #186 from codingteam/prettier-walls-138
    
    Prettier walls
---
 maps/game-over.txt          |  14 ++--
 pacmacs-image.el            | 190 ++++++++++++++++++++++++++++++++------------
 pacmacs-render.el           |   3 +-
 pacmacs-utils.el            |   6 --
 pacmacs-vector.el           |   6 ++
 pacmacs.el                  |  16 ++--
 test/pacmacs-image-test.el  | 100 +++++++++++------------
 test/pacmacs-utils-test.el  |   4 +-
 test/pacmacs-vector-test.el |   4 +
 tools/att.el                |   2 +
 10 files changed, 221 insertions(+), 124 deletions(-)

diff --git a/maps/game-over.txt b/maps/game-over.txt
index 557947e49f..ee635e1f7c 100644
--- a/maps/game-over.txt
+++ b/maps/game-over.txt
@@ -1,10 +1,12 @@
                   
  ### ### ##### ###
- #   # # # # # # #
- # # ### # # # ##
- ### # # # # #  ##
+ #   # # # # # # 
+ # # ### # # # ###
+ # # # # # # # #
+ ### # # # # # ###
                  
  ### # # ### ###  
- # # # # # # # #  
- # # # # ##  #### 
- ###  #   ## #  # 
+ # # # # #   # #  
+ # # # # ### #### 
+ # # ### #   #  #
+ ###  #  ### #  # 
diff --git a/pacmacs-image.el b/pacmacs-image.el
index a0b8159130..6f2e3d25aa 100644
--- a/pacmacs-image.el
+++ b/pacmacs-image.el
@@ -33,30 +33,40 @@
 ;;; Code:
 
 (require 'dash)
+(require 'color)
 
-(defvar pacmacs--wall-blocks
+(require 'pacmacs-vector)
+
+(defconst pacmacs--wall-color "#5555ff")
+(defconst pacmacs--wall-weight 10)
+
+(defvar pacmacs--wall-tiles-cache
   (make-hash-table))
 
+(defun pacmacs--clear-wall-tiles-cache ()
+  (interactive)
+  (clrhash pacmacs--wall-tiles-cache))
+
 (defun pacmacs-load-image (filename)
   (create-image filename 'xpm nil :heuristic-mask t))
 
 (defun pacmacs-insert-image (resource resource-vector)
   (insert-image resource " " nil resource-vector))
 
-(defun pacmacs--put-bits-dot (bits row column weight)
+(defun pacmacs--put-wall-tile-corner (bits row column weight weights-to-color)
   (dotimes (i weight)
     (dotimes (j weight)
-      (aset (aref bits (+ i row)) (+ j column) t))))
+      (aset (aref bits (+ i row)) (+ j column) (funcall weights-to-color i 
j)))))
 
-(defun pacmacs--put-vertical-bar (bits column height weight)
+(defun pacmacs--put-vertical-bar (bits column height weight weight-to-color)
   (dotimes (w weight)
     (dotimes (i height)
-      (aset (aref bits i) (+ column w) t))))
+      (aset (aref bits i) (+ column w) (funcall weight-to-color w)))))
 
-(defun pacmacs--put-horizontal-bar (bits row width weight)
+(defun pacmacs--put-horizontal-bar (bits row width weight weight-to-color)
   (dotimes (w weight)
     (dotimes (i width)
-      (aset (aref bits (+ row w)) i t))))
+      (aset (aref bits (+ row w)) i (funcall weight-to-color w)))))
 
 (defun pacmacs--bit-list-to-integer (bit-list)
   (let ((result 0))
@@ -65,20 +75,39 @@
                            (if bit 1 0))))
     result))
 
-(defun pacmacs--bits-to-xpm (bits width height)
+(defun pacmacs--generate-xpm-palette (palette)
+  (let* ((n (length palette))
+         (palette-indices (number-sequence 0 (1- n))))
+    (->> palette
+         (-zip-with #'cons palette-indices)
+         (-map (-lambda ((index . color))
+                 (format "\"%c c %s\",\n" (+ index ?a) color)))
+         (apply #'concat))))
+
+(defun pacmacs--color-hex-gradient (start stop step-number)
+  (-map (-lambda (color)
+          (apply #'color-rgb-to-hex color))
+        (color-gradient
+         (color-name-to-rgb start)
+         (color-name-to-rgb stop)
+         step-number)))
+
+(defun pacmacs--wall-tile-to-xpm (wall-tile width height palette)
   (concat
    "/* XPM */\n"
    "static char *tile[] = {\n"
    "/**/\n"
-   (format "\"%d %d 2 1\",\n" width height)
+   (format "\"%d %d %d 1\",\n" width height (1+ (length palette)))
    "\"  c None\",\n"
-   "\". c #5555ff\",\n"
+   (pacmacs--generate-xpm-palette palette)
    "/* pixels */\n"
    (mapconcat
     (lambda (row)
       (format "\"%s\""
-       (mapconcat (-lambda (bit) (if bit "." " ")) row "")))
-    bits
+              (mapconcat (-lambda (bit)
+                           (if bit (format "%c" (+ bit ?a)) " "))
+                         row "")))
+    wall-tile
     ",\n")
    "\n};"))
 
@@ -91,53 +120,114 @@
           (and left-bottom  (not left)  (not bottom))
           (and right-bottom (not right) (not bottom)))))
 
-(defun pacmacs--create-wall-tile (width height
-                                  bottom right
-                                  top left
-                                  left-upper right-upper
-                                  left-bottom right-bottom)
-  (let* ((wall-bits (list bottom right top left
-                          left-upper right-upper
-                          left-bottom right-bottom))
-         (cache-index (-> wall-bits
+(defun pacmacs--inverted-weight-to-color (weight)
+  (-lambda (w) (- weight w 1)))
+
+(defun pacmacs--two-weights-to-color (row-inverted column-inverted 
color-inverted weight)
+  (-lambda (row-weight column-weight)
+    (let ((color (->> (pacmacs--squared-distance
+                       0 0
+                       (if row-inverted
+                           (- weight row-weight 1)
+                         row-weight)
+                       (if column-inverted
+                           (- weight column-weight 1)
+                         column-weight))
+                      (sqrt)
+                      (floor)
+                      (min (1- weight)))))
+      (if color-inverted
+          (- weight color 1)
+        color))))
+
+(defun pacmacs--wall-bits-get-corners (wall-bits)
+  (-drop 4 wall-bits))
+
+(defun pacmacs--wall-bits-get-bars (wall-bits)
+  (-take 4 wall-bits))
+
+(defun pacmacs--put-inner-corners (wall-tile width height weight wall-bits)
+  (-let (((left-upper right-upper left-bottom right-bottom)
+          (pacmacs--wall-bits-get-corners wall-bits)))
+    (when left-upper
+      (pacmacs--put-wall-tile-corner wall-tile 0 0 weight
+                                     (pacmacs--two-weights-to-color nil nil 
nil weight)))
+
+    (when right-upper
+      (pacmacs--put-wall-tile-corner wall-tile 0 (- width weight) weight
+                                     (pacmacs--two-weights-to-color nil t nil 
weight)))
+
+    (when left-bottom
+      (pacmacs--put-wall-tile-corner wall-tile (- height weight) 0 weight
+                                     (pacmacs--two-weights-to-color t nil nil 
weight)))
+
+    (when right-bottom
+      (pacmacs--put-wall-tile-corner wall-tile (- height weight) (- width 
weight) weight
+                                     (pacmacs--two-weights-to-color t t nil 
weight)))))
+
+(defun pacmacs--put-bars (wall-tile width height weight wall-bits)
+  (-let (((bottom right top left)
+          (pacmacs--wall-bits-get-bars wall-bits)))
+    (when left
+      (pacmacs--put-vertical-bar wall-tile 0 height weight #'identity))
+
+    (when right
+      (pacmacs--put-vertical-bar wall-tile (- width weight) height weight
+                                 (pacmacs--inverted-weight-to-color weight)))
+
+    (when top
+      (pacmacs--put-horizontal-bar wall-tile 0 width weight #'identity))
+    
+    (when bottom
+      (pacmacs--put-horizontal-bar wall-tile (- height weight) width weight
+                                   (pacmacs--inverted-weight-to-color 
weight)))))
+
+(defun pacmacs--put-outer-corners (wall-tile width height weight wall-bits)
+  (-let (((bottom right top left)
+          (pacmacs--wall-bits-get-bars wall-bits)))
+    (when (and left top) ;left-upper
+      (pacmacs--put-wall-tile-corner wall-tile 0 0 weight
+                                     (pacmacs--two-weights-to-color t t t 
weight)))
+
+    (when (and right top) ;right-upper
+      (pacmacs--put-wall-tile-corner wall-tile 0 (- width weight) weight
+                                     (pacmacs--two-weights-to-color t nil t 
weight)))
+
+    (when (and left bottom) ;left-bottom
+      (pacmacs--put-wall-tile-corner wall-tile (- height weight) 0 weight
+                                     (pacmacs--two-weights-to-color nil t t 
weight)))
+
+    (when (and right bottom) ;right-bottom
+      (pacmacs--put-wall-tile-corner wall-tile (- height weight) (- width 
weight) weight
+                                     (pacmacs--two-weights-to-color nil nil t 
weight)))))
+
+(defun pacmacs--create-wall-tile (width height wall-bits)
+  "Creates a wall tile based on the WALL-BITS.
+WALL-BITS go as follow (bottom right top left left-upper
+right-upper left-bottom right-bottom). WIDTH and HEIGHT are the
+size of the tile. All the created tiles are cached."
+  (let* ((cache-index (-> wall-bits
                           (pacmacs--normalize-wall-bits)
                           (pacmacs--bit-list-to-integer))))
-    (-if-let (cached-tile (gethash cache-index pacmacs--wall-blocks))
+    (-if-let (cached-tile (gethash cache-index pacmacs--wall-tiles-cache))
         cached-tile
       (puthash cache-index
-               (let ((wall-block (make-vector width nil))
-                     (weight 3))
+               (let* ((wall-tile (make-vector width nil))
+                      (palette (pacmacs--color-hex-gradient
+                                (face-attribute 'default :background)
+                                pacmacs--wall-color
+                                pacmacs--wall-weight)))
 
                  (dotimes (i width)
-                   (aset wall-block i (make-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))
+                   (aset wall-tile i (make-vector height nil)))
 
-                 (when top
-                   (pacmacs--put-horizontal-bar wall-block 0 width weight))
-                 
-                 (when bottom
-                   (pacmacs--put-horizontal-bar wall-block (- height weight) 
width weight))
+                 (pacmacs--put-inner-corners wall-tile width height 
pacmacs--wall-weight wall-bits)
+                 (pacmacs--put-bars wall-tile width height 
pacmacs--wall-weight wall-bits)
+                 (pacmacs--put-outer-corners wall-tile width height 
pacmacs--wall-weight wall-bits)
 
-                 (create-image (pacmacs--bits-to-xpm wall-block width height)
+                 (create-image (pacmacs--wall-tile-to-xpm wall-tile width 
height palette)
                                'xpm t))
-               pacmacs--wall-blocks))))
+               pacmacs--wall-tiles-cache))))
 
 (provide 'pacmacs-image)
 
diff --git a/pacmacs-render.el b/pacmacs-render.el
index bf303db5bc..274a16a1d6 100644
--- a/pacmacs-render.el
+++ b/pacmacs-render.el
@@ -41,8 +41,7 @@
 (defun pacmacs--render-empty-cell ()
   (pacmacs-insert-image (pacmacs--create-wall-tile
                          40 40
-                         nil nil nil nil
-                         nil nil nil nil)
+                         (make-list 8 nil))
                         '(0 0 40 40)))
 
 (defun pacmacs--render-life-icon ()
diff --git a/pacmacs-utils.el b/pacmacs-utils.el
index 8d2db4b127..c52b8f0185 100644
--- a/pacmacs-utils.el
+++ b/pacmacs-utils.el
@@ -64,12 +64,6 @@ side-effects."
                                'down  (cons  1  0))))
     (plist-get direction-table direction)))
 
-(defun pacmacs--squared-distance (row1 column1 row2 column2)
-  (let ((d-row (- row2 row1))
-        (d-column (- column2 column1)))
-      (+ (* d-row d-row)
-         (* d-column d-column))))
-
 (defun pacmacs--direction-name (direction-vector)
   (let ((direction-table '((( 0 . -1) . left)
                            (( 0 .  1) . right)
diff --git a/pacmacs-vector.el b/pacmacs-vector.el
index 1332bba166..2953b077fa 100644
--- a/pacmacs-vector.el
+++ b/pacmacs-vector.el
@@ -42,6 +42,12 @@
   (pacmacs--vector-components-operation
    vector1 vector2 #'-))
 
+(defun pacmacs--squared-distance (row1 column1 row2 column2)
+  (let ((d-row (- row2 row1))
+        (d-column (- column2 column1)))
+      (+ (* d-row d-row)
+         (* d-column d-column))))
+
 (provide 'pacmacs-vector)
 
 ;;; pacmacs-vector.el ends here
diff --git a/pacmacs.el b/pacmacs.el
index 4f79cf8427..973561a53a 100644
--- a/pacmacs.el
+++ b/pacmacs.el
@@ -98,6 +98,8 @@
   (pacmacs-mode))
 
 (defun pacmacs--initialize-game (tick-function)
+  (pacmacs--clear-wall-tiles-cache)
+
   (switch-to-buffer pacmacs-buffer-name)
   (buffer-disable-undo pacmacs-buffer-name)
 
@@ -120,7 +122,7 @@
 
 (defun pacmacs--load-current-level ()
   (pacmacs--load-map (aref pacmacs-levels
-                          pacmacs-current-level)))
+                           pacmacs-current-level)))
 
 (defun pacmacs--load-next-level ()
   (setq pacmacs-current-level
@@ -667,12 +669,12 @@
        (apply #'vector)))
 
 (defun pacmacs--wall-tile-at (row column)
-  (apply #'pacmacs--create-wall-tile
-         40 40
-         (-map (-lambda ((row . column))
-                 (not (pacmacs--wall-at-p row column)))
-               (append (pacmacs--possible-side-ways row column)
-                       (pacmacs--possible-diagonal-ways row column)))))
+  (pacmacs--create-wall-tile
+   40 40
+   (-map (-lambda ((row . column))
+           (not (pacmacs--wall-at-p row column)))
+         (append (pacmacs--possible-side-ways row column)
+                 (pacmacs--possible-diagonal-ways row column)))))
 
 (defun pacmacs--load-map (map-name)
   (let* ((lines (split-string (->> map-name
diff --git a/test/pacmacs-image-test.el b/test/pacmacs-image-test.el
index 9937f17bcc..19425bf94c 100644
--- a/test/pacmacs-image-test.el
+++ b/test/pacmacs-image-test.el
@@ -10,42 +10,35 @@
      (mock (insert-image resource " " nil resource-vector) => 42 :times 1)
      (should (= 42 (pacmacs-insert-image resource resource-vector))))))
 
-(ert-deftest pacmacs--put-bits-dot-test ()
-  (let ((input-bits (pacmacs--construct-2d-bool-vector
-                     '((nil nil nil)
-                       (nil nil nil)
-                       (nil nil nil))))
-        (expected-bits (pacmacs--construct-2d-bool-vector
-                        '((t   t   nil)
-                          (t   t   nil)
-                          (nil nil nil)))))
-    (pacmacs--put-bits-dot input-bits 0 0 2)
-    (should (equal expected-bits
-                   input-bits))))
+(ert-deftest pacmacs--put-wall-tile-corner-test ()
+  (let ((input-wall-tile [[nil nil nil]
+                          [nil nil nil]
+                          [nil nil nil]])
+        (expected-wall-tile [[0   1   nil]
+                             [1   2   nil]
+                             [nil nil nil]]))
+    (pacmacs--put-wall-tile-corner input-wall-tile 0 0 2 #'+)
+    (should (equal expected-wall-tile input-wall-tile))))
 
 (ert-deftest pacmacs--put-vertical-bar-test ()
-  (let ((input-bits (pacmacs--construct-2d-bool-vector
-                     '((nil nil nil)
-                       (nil nil nil)
-                       (nil nil nil))))
-        (expected-bits (pacmacs--construct-2d-bool-vector
-                        '((t t nil)
-                          (t t nil)
-                          (t t nil)))))
-    (pacmacs--put-vertical-bar input-bits 0 3 2)
+  (let ((input-bits [[nil nil nil]
+                     [nil nil nil]
+                     [nil nil nil]])
+        (expected-bits [[0 1 nil]
+                        [0 1 nil]
+                        [0 1 nil]]))
+    (pacmacs--put-vertical-bar input-bits 0 3 2 #'identity)
     (should (equal (pacmacs--bits-to-lists expected-bits)
                    (pacmacs--bits-to-lists input-bits)))))
 
 (ert-deftest pacmacs--put-horizontal-bar-test ()
-  (let ((input-bits (pacmacs--construct-2d-bool-vector
-                     '((nil nil nil)
-                       (nil nil nil)
-                       (nil nil nil))))
-        (expected-bits (pacmacs--construct-2d-bool-vector
-                        '((t   t   t)
-                          (t   t   t)
-                          (nil nil nil)))))
-    (pacmacs--put-horizontal-bar input-bits 0 3 2)
+  (let ((input-bits [[nil nil nil]
+                     [nil nil nil]
+                     [nil nil nil]])
+        (expected-bits [[0   0   0]
+                        [1   1   1]
+                        [nil nil nil]]))
+    (pacmacs--put-horizontal-bar input-bits 0 3 2 #'identity)
     (should (equal (pacmacs--bits-to-lists expected-bits)
                    (pacmacs--bits-to-lists input-bits)))))
 
@@ -61,31 +54,38 @@
                            bit-list)))))))
 
 (ert-deftest pacmacs--create-wall-tile-test ()
-  (with-mock
-   (mock (pacmacs--bit-list-to-integer *) => 0)
-   (mock (gethash * *) => nil)
-   (mock (puthash * * *) => nil)
-   (mock (create-image * * *) => nil)
-   (mock (pacmacs--bits-to-xpm [[nil t   t   t]
-                                [t   t   t   t]
-                                [t   t   t   t]
-                                [t   t   t   t]]
-                               4 4))
-   (pacmacs--create-wall-tile 4 4 t t nil nil
-                              nil nil nil nil)))
+  (let ((pacmacs--wall-weight 3))
+    (with-mock
+     (mock (pacmacs--color-hex-gradient * * *) => '("khooy1" "khooy2" 
"khooy3"))
+     (mock (pacmacs--bit-list-to-integer *) => 0)
+     (mock (gethash * *) => nil)
+     (mock (puthash * * *) => nil)
+     (mock (create-image * * *) => nil)
+     (mock (pacmacs--wall-tile-to-xpm [[nil 2   1   0]
+                                       [2   2   1   0]
+                                       [1   1   1   0]
+                                       [0   0   0   0]]
+                                      4 4
+                                      '("khooy1" "khooy2" "khooy3")))
+     (pacmacs--create-wall-tile
+      4 4
+      '(t t nil nil nil nil nil nil)))))
 
-(ert-deftest pacmacs--bits-to-xpm-test ()
+(ert-deftest pacmacs--wall-tile-to-xpm-test ()
   (should (string= (concat "/* XPM */\n"
                            "static char *tile[] = {\n"
-                           "/**/\n\"2 2 2 1\",\n"
+                           "/**/\n\"2 2 3 1\",\n"
                            "\"  c None\",\n"
-                           "\". c #5555ff\",\n"
+                           "\"a c #khooy1\",\n"
+                           "\"b c #khooy2\",\n"
                            "/* pixels */\n"
-                           "\"..\",\n"
-                           "\"  \"\n};")
-                   (pacmacs--bits-to-xpm [[t t]
-                                          [nil nil]]
-                                         2 2))))
+                           "\"ab\",\n"
+                           "\"b \"\n};")
+                   (pacmacs--wall-tile-to-xpm [[0 1]
+                                               [1 nil]]
+                                              2 2
+                                              '("#khooy1"
+                                                "#khooy2")))))
 
 (ert-deftest pacmacs--normalize-wall-bits-test ()
   (should (equal '(nil nil nil nil t nil t nil)
diff --git a/test/pacmacs-utils-test.el b/test/pacmacs-utils-test.el
index 630f9a5f34..03580a3c1f 100644
--- a/test/pacmacs-utils-test.el
+++ b/test/pacmacs-utils-test.el
@@ -11,6 +11,4 @@
   (should (not (pacmacs--levelname-from-filename "."))))
 
 
-(ert-deftest pacmacs--squared-distance-test ()
-  (should (= (pacmacs--squared-distance 1 1 3 3)
-             8)))
+
diff --git a/test/pacmacs-vector-test.el b/test/pacmacs-vector-test.el
new file mode 100644
index 0000000000..ad2f46f54b
--- /dev/null
+++ b/test/pacmacs-vector-test.el
@@ -0,0 +1,4 @@
+
+(ert-deftest pacmacs--squared-distance-test ()
+  (should (= (pacmacs--squared-distance 1 1 3 3)
+             8)))
diff --git a/tools/att.el b/tools/att.el
index 8a18585c8d..91b0d28b68 100644
--- a/tools/att.el
+++ b/tools/att.el
@@ -4,6 +4,8 @@
 (require 'pacmacs-rr)
 (require 'f)
 
+(toggle-debug-on-error)
+
 (defconst att-result-file-path "./att.txt")
 (defvar att-it-case-path "./it-cases/it-case03.el")