|
| From: | ELPA Syncer |
| Subject: | [nongnu] elpa/pacmacs 79aa80e1d2 245/472: Merge branch 'connecte-walls'. Close #131 |
| Date: | Thu, 6 Jan 2022 21:59:28 -0500 (EST) |
branch: elpa/pacmacs
commit 79aa80e1d2791dd5e6018cf9e39721079abcfeb5
Merge: 98599015bb e0856fc881
Author: rexim <reximkut@gmail.com>
Commit: rexim <reximkut@gmail.com>
Merge branch 'connecte-walls'. Close #131
---
maps/game-over.txt | 17 ++++-----
pacmacs-image.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++
pacmacs.el | 40 ++++++++++++++++-----
test/pacmacs-image-test.el | 39 +++++++++++++++++++++
test/test-helper.el | 20 +++++++++++
5 files changed, 186 insertions(+), 17 deletions(-)
diff --git a/maps/game-over.txt b/maps/game-over.txt
index f28cdbb21f..557947e49f 100644
--- a/maps/game-over.txt
+++ b/maps/game-over.txt
@@ -1,9 +1,10 @@
-### ### ##### ###
-# # # # # # # #
-# # ### # # # ##
-### # # # # # ##
+
+ ### ### ##### ###
+ # # # # # # # #
+ # # ### # # # ##
+ ### # # # # # ##
-### # # ### ###
-# # # # # # # #
-# # # # ## ####
-### # ## # #
+ ### # # ### ###
+ # # # # # # # #
+ # # # # ## ####
+ ### # ## # #
diff --git a/pacmacs-image.el b/pacmacs-image.el
index 3a92838007..8e444c8d11 100644
--- a/pacmacs-image.el
+++ b/pacmacs-image.el
@@ -32,7 +32,11 @@
;;; Code:
+(require 'dash)
+
(defconst pacmacs--flip-xbm-bits (eq system-type 'windows-nt))
+(defvar pacmacs--wall-blocks
+ (make-hash-table))
(defun pacmacs-load-image (filename)
(create-image filename 'xpm nil :heuristic-mask t))
@@ -54,6 +58,89 @@
:foreground nil
:background color))))
+(defun pacmacs--put-bits-dot (bits row column weight)
+ (dotimes (i weight)
+ (dotimes (j weight)
+ (aset (aref bits (+ i row)) (+ j column) t))))
+
+(defun pacmacs--put-vertical-bar (bits column height weight)
+ (dotimes (w weight)
+ (dotimes (i height)
+ (aset (aref bits i) (+ column w) t))))
+
+(defun pacmacs--put-horizontal-bar (bits row width weight)
+ (dotimes (w weight)
+ (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-tile (width
+ height color
+
+ bottom right
+ top left
+ left-upper right-upper
+ left-bottom right-bottom)
+ (let ((cache-index
+ (pacmacs--bit-list-to-integer
+ (list bottom right top left
+ (and left-upper
+ (not left)
+ (not top))
+ (and right-upper
+ (not right)
+ (not top))
+ (and left-bottom
+ (not left)
+ (not bottom))
+ (and right-bottom
+ (not right)
+ (not bottom))))))
+ (-if-let (cached-tile (gethash cache-index pacmacs--wall-blocks))
+ cached-tile
+ (puthash 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))
+ pacmacs--wall-blocks))))
+
(defun pacmacs-create-transparent-block (width height)
(create-image
(make-vector
diff --git a/pacmacs.el b/pacmacs.el
index 9d6b3f4cb4..4075f944d5 100644
--- a/pacmacs.el
+++ b/pacmacs.el
@@ -124,8 +124,7 @@
(pacmacs--load-current-level))
(defun pacmacs--make-wall-cell (row column)
- (list :current-animation (pacmacs-make-anim (list (pacmacs-make-frame '(0 0
40 40) 100))
- (pacmacs-create-color-block 40
40 "red"))
+ (list :current-animation nil
:row row
:column column
:type 'wall))
@@ -243,11 +242,17 @@
(pacmacs--put-object game-object)))
(plist-put game-object :speed-counter (1- speed-counter)))))
-(defun pacmacs--possible-ways (row column)
- (list (cons (1+ row) column)
- (cons row (1+ column))
- (cons (1- row) column)
- (cons row (1- column))))
+(defun pacmacs--possible-side-ways (row column)
+ (list (cons (1+ row) column) ;down
+ (cons row (1+ column)) ;right
+ (cons (1- row) column) ;up
+ (cons row (1- column)))) ;left
+
+(defun pacmacs--possible-diagonal-ways (row column)
+ (list (cons (1- row) (1- column))
+ (cons (1- row) (1+ column))
+ (cons (1+ row) (1- column))
+ (cons (1+ row) (1+ column))))
(defun pacmacs--filter-candidates (p)
(let ((row (car p))
@@ -280,7 +285,7 @@
(dolist (p wave)
(let* ((row (car p))
(column (cdr p))
- (possible-ways (pacmacs--possible-ways row column))
+ (possible-ways (pacmacs--possible-side-ways row column))
(candidate-ways
(cl-remove-if #'pacmacs--filter-candidates possible-ways)))
(dolist (candidate-way candidate-ways)
@@ -505,6 +510,14 @@
(-sort #'string-lessp)
(apply #'vector)))
+(defun pacmacs--wall-tile-at (row column)
+ (apply #'pacmacs--create-wall-tile
+ 40 40 "#5555ff"
+ (-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
(format "./maps/%s.txt")
@@ -537,7 +550,16 @@
((char-equal x ?g)
(add-to-list 'pacmacs--ghosts (pacmacs--make-ghost
row column))))))
- (pacmacs--fill-object-board)))
+
+ (pacmacs--fill-object-board)
+
+ (dolist (wall pacmacs--wall-cells)
+ (plist-bind ((row :row)
+ (column :column))
+ wall
+ (plist-put wall :current-animation
+ (pacmacs-make-anim (list (pacmacs-make-frame '(0 0 40 40)
100))
+ (pacmacs--wall-tile-at row column)))))))
(provide 'pacmacs)
diff --git a/test/pacmacs-image-test.el b/test/pacmacs-image-test.el
index ae5461e277..6bf68f5a1c 100644
--- a/test/pacmacs-image-test.el
+++ b/test/pacmacs-image-test.el
@@ -51,3 +51,42 @@
:height height) => create-image-result :times 1)
(should (equal create-image-result
(pacmacs-create-transparent-block width height))))))
+
+(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-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)
+ (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)
+ (should (equal (pacmacs--bits-to-lists expected-bits)
+ (pacmacs--bits-to-lists input-bits)))))
diff --git a/test/test-helper.el b/test/test-helper.el
index 0115ca979d..acf0aa1e57 100644
--- a/test/test-helper.el
+++ b/test/test-helper.el
@@ -2,8 +2,28 @@
;this
(require 'el-mock)
(require 'undercover)
+(require 'dash)
(undercover "*.el")
+(defun pacmacs--list-to-bool-vector (xs)
+ (let* ((index 0)
+ (size (length xs))
+ (result (make-bool-vector (length xs) nil)))
+ (dolist (x xs)
+ (aset result index x)
+ (cl-incf index))
+ result))
+
+(defun pacmacs--bool-vector-to-list (xs)
+ (-map #'identity xs))
+
+(defun pacmacs--construct-2d-bool-vector (data)
+ (apply #'vector
+ (-map #'pacmacs--list-to-bool-vector data)))
+
+(defun pacmacs--bits-to-lists (bits)
+ (-map #'pacmacs--bool-vector-to-list bits))
+
(add-to-list 'load-path ".")
(load "pacmacs.el")
| [Prev in Thread] | Current Thread | [Next in Thread] |