[nongnu] elpa/pacmacs 481eb8bd37 326/472: Merge pull request #169 from codingteam/distances-instead-of-directions-159

[ELPA Syncer]

branch: elpa/pacmacs
commit 481eb8bd371d1aef6cb3ce76bb7b6278175aa0c0
Merge: d6b63ef5b9 fa83e10d82
Author: Alexey Kutepov <reximkut@gmail.com>
Commit: Alexey Kutepov <reximkut@gmail.com>

    Merge pull request #169 from codingteam/distances-instead-of-directions-159
    
    Distances instead of directions
---
 pacmacs-render.el    |  15 ++------
 pacmacs-vector.el    |  47 +++++++++++++++++++++++
 pacmacs.el           | 103 ++++++++++++++++++++++++++-------------------------
 test/pacmacs-test.el |  39 ++++---------------
 4 files changed, 111 insertions(+), 93 deletions(-)

diff --git a/pacmacs-render.el b/pacmacs-render.el
index 3606baa326..f0fb72cfda 100644
--- a/pacmacs-render.el
+++ b/pacmacs-render.el
@@ -70,17 +70,10 @@
     (dotimes (row height)
       (dotimes (column width)
         (let ((x (pacmacs--cell-wrapped-get track-board row column)))
-          (cond
-           ((null x)
-            (insert "."))
-           ((equal x 'left)
-            (insert "<"))
-           ((equal x 'right)
-            (insert ">"))
-           ((equal x 'up)
-            (insert "^"))
-           ((equal x 'down)
-            (insert "v")))))
+          (insert "\t")
+          (if x
+              (insert (int-to-string x))
+            (insert "."))))
       (insert "\n"))))
 
 (provide 'pacmacs-render)
diff --git a/pacmacs-vector.el b/pacmacs-vector.el
new file mode 100644
index 0000000000..28f1ad745a
--- /dev/null
+++ b/pacmacs-vector.el
@@ -0,0 +1,47 @@
+;;; pacmacs-vector.el --- Pacman for Emacs -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Codingteam
+
+;; Author: Codingteam <codingteam@conference.jabber.ru>
+;; Maintainer: Alexey Kutepov <reximkut@gmail.com>
+;; URL: http://github.com/rexim/pacmacs.el
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+;;; Commentary:
+
+;; Routines for working with vector
+
+;;; Code:
+
+(defun pacmacs--vector-components-operation (vector1 vector2 operation)
+  (-let (((row1 . column1) vector1)
+         ((row2 . column2) vector2))
+    (cons (funcall operation row1 row2)
+          (funcall operation column1 column2))))
+
+(defun pacmacs--vector- (vector1 vector2)
+  (pacmacs--vector-components-operation
+   vector1 vector2 #'-))
+
+(provide 'pacmacs-vector)
+
+;;; pacmacs-vector.el ends here
diff --git a/pacmacs.el b/pacmacs.el
index 695ffb9ec2..d93ee1a437 100644
--- a/pacmacs.el
+++ b/pacmacs.el
@@ -46,6 +46,7 @@
 (require 'pacmacs-utils)
 (require 'pacmacs-render)
 (require 'pacmacs-score)
+(require 'pacmacs-vector)
 
 (defconst pacmacs-buffer-name "*Pacmacs*")
 (defconst pacmacs-tick-duration-ms 100)
@@ -322,46 +323,72 @@
     (or (pacmacs--wall-at-p row column)
         (pacmacs--cell-tracked-p row column))))
 
-(defun pacmacs--track-point (start end)
-  (let* ((start-row (car start))
-         (start-column (cdr start))
-
-         (end-row (car end))
-         (end-column (cdr end))
-
-         (d-row (- end-row start-row))
-         (d-column (- end-column start-column)))
-    
-    (pacmacs--cell-wrapped-set pacmacs--track-board
-                       start-row start-column
-                       (pacmacs--direction-name (cons d-row d-column)))))
-
 (defun pacmacs--recalc-track-board ()
   (pacmacs--fill-board pacmacs--track-board nil)
   (plist-bind ((player-row :row)
                (player-column :column))
       pacmacs--player-state
     (let ((wave (list (cons player-row player-column))))
+      (pacmacs--cell-wrapped-set pacmacs--track-board
+                                 player-row player-column
+                                 0)
       (while (not (null wave))
         (let ((next-wave nil))
-          (dolist (p wave)
-            (let* ((row (car p))
-                   (column (cdr p))
-                   (possible-ways (pacmacs--possible-side-ways row column))
+          (dolist (current-tile wave)
+            (let* ((current-row (car current-tile))
+                   (current-column (cdr current-tile))
+                   (possible-ways (pacmacs--possible-side-ways current-row
+                                                               current-column))
                    (candidate-ways
-                    (cl-remove-if #'pacmacs--filter-candidates possible-ways)))
-              (dolist (candidate-way candidate-ways)
-                (pacmacs--track-point candidate-way p))
+                    (cl-remove-if #'pacmacs--filter-candidates
+                                  possible-ways))
+                   (candidate-distance (1+ (pacmacs--cell-wrapped-get
+                                            pacmacs--track-board
+                                            current-row current-column))))
+              (-each candidate-ways
+                (-lambda ((candidate-row . candidate-column))
+                  (pacmacs--cell-wrapped-set pacmacs--track-board
+                                             candidate-row
+                                             candidate-column
+                                             candidate-distance)))
               (setq next-wave
                     (append next-wave candidate-ways))))
           (setq wave next-wave))))))
 
-(defun pacmacs--track-object (game-object)
+(defun pacmacs--track-object-direction (game-object distance-comparator)
   (plist-bind ((row :row)
                (column :column))
       game-object
-    (let ((direction (pacmacs--cell-wrapped-get pacmacs--track-board row 
column)))
-      (pacmacs--switch-direction game-object direction))))
+    (let* ((candidate-ways (cons
+                            (cons row column)
+                            (-remove (-lambda ((candidate-row . 
candidate-column))
+                                       (pacmacs--wall-at-p candidate-row 
candidate-column))
+                                     (pacmacs--possible-side-ways row 
column))))
+           (candidate-distances (-map (-lambda ((candidate-row . 
candidate-column))
+                                        (pacmacs--cell-wrapped-get 
pacmacs--track-board
+                                                                   
candidate-row
+                                                                   
candidate-column))
+                                      candidate-ways))
+           (next-tile (->> (-zip candidate-distances candidate-ways)
+                           (-sort (-lambda ((distance-1 . _) (distance-2 . _))
+                                    (funcall distance-comparator
+                                             distance-1 distance-2)))
+                           (cdar))))
+      (when next-tile
+        (->> (pacmacs--vector- next-tile (cons row column))
+             (pacmacs--direction-name))))))
+
+(defun pacmacs--track-object (game-object distance-comparator)
+  (-when-let (direction (pacmacs--track-object-direction
+                         game-object
+                         distance-comparator))
+    (pacmacs--switch-direction game-object direction)))
+
+(defun pacmacs--track-object-to-player (game-object)
+  (pacmacs--track-object game-object #'<))
+
+(defun pacmacs--track-object-from-player (game-object)
+  (pacmacs--track-object game-object #'>))
 
 (defun pacmacs-tick ()
   (interactive)
@@ -382,36 +409,12 @@
 
 (defun pacmacs--step-ghosts ()
   (dolist (ghost pacmacs--ghosts)
-    (pacmacs--track-object ghost)
+    (pacmacs--track-object-to-player ghost)
     (pacmacs--step-object ghost)))
 
-(defun pacmacs--run-away-direction (runner bogey blocked-tile-predicate)
-  (plist-bind ((runner-row :row)
-               (runner-column :column))
-      runner
-    (plist-bind ((bogey-row :row)
-                 (bogey-column :column))
-        bogey
-      (let* ((current-distance (pacmacs--squared-distance runner-row 
runner-column
-                                                          bogey-row 
bogey-column))
-             (possible-ways
-              (->> (pacmacs--possible-side-ways runner-row runner-column)
-                   (-remove (-lambda ((row . column))
-                              (or (funcall blocked-tile-predicate row column)
-                                  (> current-distance
-                                     (pacmacs--squared-distance row column
-                                                                bogey-row 
bogey-column))))))))
-        (-when-let ((row . column) (car possible-ways))
-          (pacmacs--direction-name (cons (- row runner-row)
-                                         (- column runner-column))))))))
-
 (defun pacmacs--step-terrified-ghosts ()
   (dolist (terrified-ghost pacmacs--terrified-ghosts)
-    (-when-let (direction (pacmacs--run-away-direction
-                           terrified-ghost
-                           pacmacs--player-state
-                           #'pacmacs--wall-at-p))
-      (pacmacs--switch-direction terrified-ghost direction))
+    (pacmacs--track-object-from-player terrified-ghost)
     (pacmacs--step-object terrified-ghost)))
 
 (defun pacmacs--create-game-object (row column list-name constructor)
diff --git a/test/pacmacs-test.el b/test/pacmacs-test.el
index f2be579b06..c0ce55d0ec 100644
--- a/test/pacmacs-test.el
+++ b/test/pacmacs-test.el
@@ -7,30 +7,17 @@
     (should (not (pacmacs--cell-tracked-p 0 0)))
     (should (pacmacs--cell-tracked-p 1 0))))
 
-(ert-deftest pacmacs--track-point-test ()
-  (let ((pacmacs--track-board (list :width 2
-                                     :height 2
-                                     :data [[nil nil]
-                                            [nil nil]])))
-    (pacmacs--track-point (cons 0 0) (cons 0 1))
-    (should (equal [[right nil]
-                    [nil nil]]
-                   (plist-get pacmacs--track-board :data)))
-    (pacmacs--track-point (cons 1 0) (cons 1 -1))
-    (should (equal [[right nil]
-                    [left nil]]
-                   (plist-get pacmacs--track-board :data)))))
-
-(ert-deftest pacmacs--track-object-test ()
-  (let ((pacmacs--track-board (list :width 2
-                                     :height 2
-                                     :data [[right down]
-                                            [up left]]))
+(ert-deftest pacmacs--track-object-to-player-test ()
+  (let ((pacmacs--track-board (list :width 3
+                                    :height 2
+                                    :data [[2 1 2]
+                                           [2 0 2]]))
         (game-object (list :row 0
                            :column 0)))
     (with-mock
+     (mock (pacmacs--wall-at-p * *) => nil)
      (mock (pacmacs--switch-direction (list :row 0 :column 0) 'right) :times 1)
-     (pacmacs--track-object game-object))))
+     (pacmacs--track-object-to-player game-object))))
 
 (ert-deftest pacmacs--put-object-test ()
   (let ((pacmacs--object-board (list :width 2
@@ -55,18 +42,6 @@
     (should (equal expected-outcome
                    pacmacs--terrified-ghosts))))
 
-(ert-deftest pacmacs--run-away-direction-test ()
-  (let ((runner '(:row 2 :column 2))
-        (bogey '(:row 2 :column 3))
-        (walls '((1 . 2)
-                 (3 . 2)))
-        (blocked-tile-predicate (-lambda (row column)
-                                  (-find (-partial #'equal (cons row column))
-                                         walls))))
-    (should (equal (pacmacs--run-away-direction runner bogey
-                                                blocked-tile-predicate)
-                   'left))))
-
 (ert-deftest pacmacs--replace-game-objects-test ()
   (let* ((game-objects '((:row 10 :column 20)
                          (:row 30 :column 40)))