From 3bf437afac98d494ee38779efa324c6a3f70e50e Mon Sep 17 00:00:00 2001 From: rexim Date: Sun, 31 Jan 2016 11:26:02 +0600 Subject: [PATCH 1/8] Start branch for #41 meta feature, retarget badges Meta feature #41 requires lots of changes that are pretty risky. We gonna develop it in a separate branch. All the subtasks related to #41 should be merged to this branch. Once the implementation is ready and has sufficent performance, we gonna merge this branch to the master. This makes it easier to decline everything related to the one canvas technique if something goes wrong. --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 0399c54..cb7893b 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -[![Build Status](https://travis-ci.org/codingteam/pacmacs.el.svg?branch=master)](https://travis-ci.org/codingteam/pacmacs.el) -[![Coverage Status](https://coveralls.io/repos/codingteam/pacmacs.el/badge.svg?branch=master&service=github)](https://coveralls.io/github/codingteam/pacmacs.el?branch=master) +[![Build Status](https://travis-ci.org/codingteam/pacmacs.el.svg?branch=feature/one-canvas-technique-41)](https://travis-ci.org/codingteam/pacmacs.el) +[![Coverage Status](https://coveralls.io/repos/codingteam/pacmacs.el/badge.svg?branch=feature/one-canvas-technique-41&service=github)](https://coveralls.io/github/codingteam/pacmacs.el?branch=feature/one-canvas-technique-41) [![MELPA](http://melpa.org/packages/pacmacs-badge.svg)](http://melpa.org/#/pacmacs) # Pacmacs # From ac0420f3663b55b879d072499a038908906a93b7 Mon Sep 17 00:00:00 2001 From: rexim Date: Sat, 30 Jan 2016 23:13:26 +0600 Subject: [PATCH 2/8] Implement basic funcs for internal image format (#208) --- pacmacs-image.el | 58 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 pacmacs-image.el diff --git a/pacmacs-image.el b/pacmacs-image.el new file mode 100644 index 0000000..552e6d2 --- /dev/null +++ b/pacmacs-image.el @@ -0,0 +1,58 @@ +;;; pacmacs-image.el --- Pacman for Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Codingteam + +;; Author: Codingteam +;; Maintainer: Alexey Kutepov +;; 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: + +;; Internal image format implementation + +;;; Code: + +(require 'pacmacs-utils) + +(defun pacmacs--make-image (width height &optional name) + (let ((data (make-vector height nil))) + (dotimes (i height) + (aset data i (make-vector width nil))) + (list :width width + :height height + :data data + :name name))) + +(defun pacmacs--get-image-pixel (image row column) + (plist-bind ((data :data)) + image + (aref (aref data row) column))) + +(defun pacmacs--set-image-pixel (image row column color) + (plist-bind ((data :data)) + image + (aset (aref data row) column color))) + +(provide 'pacmacs-image) + +;;; pacmacs-image.el ends here From 13c0432660d78d08dbaf9fc7f29812127d4b71a2 Mon Sep 17 00:00:00 2001 From: rexim Date: Sat, 30 Jan 2016 23:48:18 +0600 Subject: [PATCH 3/8] Implement image to xpm convert (#208) --- pacmacs-image.el | 59 ++++++++++++++++++++++++++++++++++++++++++++++++ pacmacs-walls.el | 10 +------- 2 files changed, 60 insertions(+), 9 deletions(-) diff --git a/pacmacs-image.el b/pacmacs-image.el index 552e6d2..0c8b1ca 100644 --- a/pacmacs-image.el +++ b/pacmacs-image.el @@ -53,6 +53,65 @@ image (aset (aref data row) column color))) +(defun pacmacs--palette-from-image (image) + (plist-bind ((width :width) + (height :height) + (data :data)) + image + (let ((palette '())) + (dotimes (row height) + (dotimes (column width) + (let ((pixel (aref (aref data row) column))) + (when pixel + (push pixel palette) + (delete-dups palette))))) + palette))) + +(defun pacmacs--make-palette-char-map (palette) + (let* ((n (length palette)) + (palette-indices (number-sequence 0 (1- n)))) + (->> (-zip-with #'cons palette palette-indices) + (-map (-lambda ((color . index)) + (cons color (+ index ?a))))))) + +(defun pacmacs--render-xpm-palette (palette-char-map) + (->> palette-char-map + (-map (-lambda ((color . char)) + (format "\"%c c %s\",\n" char color))) + (apply #'concat))) + +(defun pacmacs--generate-xpm-palette (palette) + (->> palette + (pacmacs--make-palette-char-map) + (pacmacs--render-xpm-palette))) + +(defun pacmacs--image-to-xpm (image) + (plist-bind ((width :width) + (height :height) + (data :data) + (name :name)) + image + (let* ((palette (pacmacs--palette-from-image image)) + (palette-char-map (pacmacs--make-palette-char-map palette))) + (concat + "/* XPM */\n" + "static char *" (if name name "image") "[] = {\n" + "/**/\n" + (format "\"%d %d %d 1\",\n" width height (1+ (length palette))) + "\" c None\",\n" + (pacmacs--render-xpm-palette palette-char-map) + "/* pixels */\n" + (mapconcat + (lambda (row) + (format "\"%s\"" + (mapconcat (-lambda (color) + (let ((char (cdr (assoc color palette-char-map)))) + (if char (format "%c" char) " "))) + row ""))) + data + ",\n") + "\n};")))) + (provide 'pacmacs-image) ;;; pacmacs-image.el ends here diff --git a/pacmacs-walls.el b/pacmacs-walls.el index 77c72b2..115829b 100644 --- a/pacmacs-walls.el +++ b/pacmacs-walls.el @@ -36,6 +36,7 @@ (require 'color) (require 'pacmacs-vector) +(require 'pacmacs-image) (defconst pacmacs--wall-color "#5555ff") (defconst pacmacs--wall-weight 10) @@ -69,15 +70,6 @@ (if bit 1 0)))) result)) -(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)) From 8e338af3e038215558e5c3937474ebf53ee9d1ea Mon Sep 17 00:00:00 2001 From: rexim Date: Sun, 31 Jan 2016 12:43:08 +0600 Subject: [PATCH 4/8] Add UTs for image module (#208) Unit tested functions: - pacmacs--make-image - pacmacs--get-image-pixel - pacmacs--set-image-pixel - pacmacs--palette-from-image - pacmacs--make-palette-char-map - pacmacs--render-xpm-palette - pacmacs--generate-xpm-palette --- test/pacmacs-image-test.el | 51 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 test/pacmacs-image-test.el diff --git a/test/pacmacs-image-test.el b/test/pacmacs-image-test.el new file mode 100644 index 0000000..94edfcf --- /dev/null +++ b/test/pacmacs-image-test.el @@ -0,0 +1,51 @@ +(ert-deftest pacmacs--make-image-test () + (let ((expected-image (list :width 2 + :height 3 + :data [[nil nil] + [nil nil] + [nil nil]] + :name "khooy"))) + (should (equal expected-image + (pacmacs--make-image 2 3 "khooy"))))) + +(ert-deftest pacmacs--get-set-image-pixel-test () + (let ((image (pacmacs--make-image 10 10))) + (should (null (pacmacs--get-image-pixel image 3 4))) + (pacmacs--set-image-pixel image 3 4 "red") + (should (equal "red" (pacmacs--get-image-pixel image 3 4))))) + +(ert-deftest pacmacs--palette-from-image-test () + (let ((image (pacmacs--make-image 3 3)) + (expected-palette (list "red" "green" "blue"))) + (pacmacs--set-image-pixel image 0 0 "red") + (pacmacs--set-image-pixel image 1 0 "green") + (pacmacs--set-image-pixel image 1 1 "blue") + (should (equal (sort expected-palette #'string<) + (sort (pacmacs--palette-from-image image) #'string<))))) + +(ert-deftest pacmacs--make-palette-char-map-test () + (let ((palette (list "red" "green" "blue")) + (expected-palette-char-map (list (cons "red" ?a) + (cons "green" ?b) + (cons "blue" ?c)))) + (should (equal expected-palette-char-map + (pacmacs--make-palette-char-map palette))))) + +(ert-deftest pacmacs--render-xpm-palette-test () + (let ((palette-char-map (list (cons "red" ?a) + (cons "green" ?b) + (cons "blue" ?c))) + (expected-xpm-palette (concat "\"a c red\",\n" + "\"b c green\",\n" + "\"c c blue\",\n"))) + (should (equal expected-xpm-palette + (pacmacs--render-xpm-palette palette-char-map))))) + +(ert-deftest pacmacs--generate-xpm-palette-test () + (let ((palette (list "red" "green" "blue")) + (expected-xpm-palette (concat "\"a c red\",\n" + "\"b c green\",\n" + "\"c c blue\",\n"))) + (should (equal expected-xpm-palette + (pacmacs--generate-xpm-palette palette))))) + From 5d65a0ec2f6f62130530b7a3314081b120643341 Mon Sep 17 00:00:00 2001 From: rexim Date: Sun, 31 Jan 2016 14:03:45 +0600 Subject: [PATCH 5/8] Bump the copyright year (#208) --- pacmacs-image.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pacmacs-image.el b/pacmacs-image.el index 0c8b1ca..16b199b 100644 --- a/pacmacs-image.el +++ b/pacmacs-image.el @@ -1,6 +1,6 @@ ;;; pacmacs-image.el --- Pacman for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 2015 Codingteam +;; Copyright (C) 2016 Codingteam ;; Author: Codingteam ;; Maintainer: Alexey Kutepov From 55c37e8f6708d7663bfbf1675c6cb8352132e4d3 Mon Sep 17 00:00:00 2001 From: rexim Date: Sun, 31 Jan 2016 14:43:28 +0600 Subject: [PATCH 6/8] Use (x, y) instead of (row, column) (#208) --- pacmacs-image.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/pacmacs-image.el b/pacmacs-image.el index 16b199b..8657e02 100644 --- a/pacmacs-image.el +++ b/pacmacs-image.el @@ -43,15 +43,15 @@ :data data :name name))) -(defun pacmacs--get-image-pixel (image row column) +(defun pacmacs--get-image-pixel (image x y) (plist-bind ((data :data)) image - (aref (aref data row) column))) + (aref (aref data y) x))) -(defun pacmacs--set-image-pixel (image row column color) +(defun pacmacs--set-image-pixel (image x y color) (plist-bind ((data :data)) image - (aset (aref data row) column color))) + (aset (aref data y) x color))) (defun pacmacs--palette-from-image (image) (plist-bind ((width :width) @@ -59,9 +59,9 @@ (data :data)) image (let ((palette '())) - (dotimes (row height) - (dotimes (column width) - (let ((pixel (aref (aref data row) column))) + (dotimes (y height) + (dotimes (x width) + (let ((pixel (aref (aref data y) x))) (when pixel (push pixel palette) (delete-dups palette))))) From 876e8c980c5946a608795478ac0117aa6d10dc76 Mon Sep 17 00:00:00 2001 From: rexim Date: Sun, 31 Jan 2016 22:55:26 +0600 Subject: [PATCH 7/8] Implement drawing image on another image (#213) --- pacmacs-image.el | 53 ++++++++++++++++++++++++++++++++++---- test/pacmacs-image-test.el | 46 +++++++++++++++++++++++++++++++++ 2 files changed, 94 insertions(+), 5 deletions(-) diff --git a/pacmacs-image.el b/pacmacs-image.el index 8657e02..2f3ff1c 100644 --- a/pacmacs-image.el +++ b/pacmacs-image.el @@ -34,14 +34,17 @@ (require 'pacmacs-utils) -(defun pacmacs--make-image (width height &optional name) +(defun pacmacs--make-image-data (width height) (let ((data (make-vector height nil))) (dotimes (i height) (aset data i (make-vector width nil))) - (list :width width - :height height - :data data - :name name))) + data)) + +(defun pacmacs--make-image (width height &optional name) + (list :width width + :height height + :data (pacmacs--make-image-data width height) + :name name)) (defun pacmacs--get-image-pixel (image x y) (plist-bind ((data :data)) @@ -53,6 +56,12 @@ image (aset (aref data y) x color))) +(defun pacmacs--image-width (image) + (plist-get image :width)) + +(defun pacmacs--image-height (image) + (plist-get image :height)) + (defun pacmacs--palette-from-image (image) (plist-bind ((width :width) (height :height) @@ -85,6 +94,40 @@ (pacmacs--make-palette-char-map) (pacmacs--render-xpm-palette))) +(defun pacmacs--make-image-from-data (raw-data) + (let* ((height (length raw-data)) + (width (->> raw-data + (-map #'length) + (apply #'max))) + (data (pacmacs--make-image-data width height))) + (dotimes (y (length raw-data)) + (dotimes (x (length (aref raw-data y))) + (let ((color (aref (aref raw-data y) x))) + (aset (aref data y) x color)))) + (list :width width + :height height + :data data + :name nil))) + +(defun pacmacs--draw-image (canvas-image image x y) + (plist-bind ((image-width :width) + (image-height :height) + (image-data :data)) + image + (plist-bind ((canvas-width :width) + (canvas-height :height) + (canvas-data :data)) + canvas-image + (dotimes (image-y (length image-data)) + (dotimes (image-x (length (aref image-data image-y))) + (let ((image-color (aref (aref image-data image-y) image-x)) + (canvas-x (+ image-x x)) + (canvas-y (+ image-y y))) + (when (and (<= 0 canvas-x (1- canvas-width)) + (<= 0 canvas-y (1- canvas-height))) + (aset (aref canvas-data canvas-y) canvas-x + image-color)))))))) + (defun pacmacs--image-to-xpm (image) (plist-bind ((width :width) (height :height) diff --git a/test/pacmacs-image-test.el b/test/pacmacs-image-test.el index 94edfcf..1f9fa06 100644 --- a/test/pacmacs-image-test.el +++ b/test/pacmacs-image-test.el @@ -49,3 +49,49 @@ (should (equal expected-xpm-palette (pacmacs--generate-xpm-palette palette))))) +(ert-deftest pacmacs--image-width-height-test () + (let ((image (pacmacs--make-image 10 20))) + (should (equal 10 (pacmacs--image-width image))) + (should (equal 20 (pacmacs--image-height image))))) + +(ert-deftest pacmacs--make-image-data-test () + (let ((expected-data [[nil nil nil] + [nil nil nil] + [nil nil nil]]) + (actual-data (pacmacs--make-image-data 3 3))) + (should (equal actual-data expected-data)))) + +(ert-deftest pacmacs--make-image-from-data-test () + (let* ((input-data [["red" "blue" nil] + ["green"] + [nil nil nil]]) + (image (pacmacs--make-image-from-data input-data)) + (expected-pixels '((0 0 "red") + (1 0 "blue") + (2 0 nil) + (0 1 "green") + (1 1 nil)))) + (should (equal 3 (pacmacs--image-width image))) + (should (equal 3 (pacmacs--image-height image))) + (-each expected-pixels + (-lambda ((x y color)) + (should (equal color (pacmacs--get-image-pixel image x y))))))) + +(ert-deftest pacmacs--draw-image-test () + (let ((canvas-image (pacmacs--make-image 5 5)) + (image (pacmacs--make-image-from-data + [["red" "blue" "red"] + ["blue" "green" "blue"] + ["red" "blue" "red"]])) + (expected-canvas-data [["red" "blue" "red" nil nil] + ["blue" "green" "blue" nil nil] + ["red" "blue" "red" nil nil] + [nil nil nil "red" "blue"] + [nil nil nil "blue" "green"]])) + (pacmacs--draw-image canvas-image image 0 0) + (pacmacs--draw-image canvas-image image 3 3) + (dotimes (y (length expected-canvas-data)) + (dotimes (x (length (aref expected-canvas-data y))) + (let ((color (aref (aref expected-canvas-data y) x))) + (should (equal color + (pacmacs--get-image-pixel canvas-image x y)))))))) From 44fbd202e4643ec5341661d10602af2cb2be794d Mon Sep 17 00:00:00 2001 From: rexim Date: Mon, 1 Feb 2016 14:39:45 +0600 Subject: [PATCH 8/8] Add benchmark for draw-image function --- benchmarks/pacmacs-draw-image-benchmark.el | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 benchmarks/pacmacs-draw-image-benchmark.el diff --git a/benchmarks/pacmacs-draw-image-benchmark.el b/benchmarks/pacmacs-draw-image-benchmark.el new file mode 100644 index 0000000..126c32c --- /dev/null +++ b/benchmarks/pacmacs-draw-image-benchmark.el @@ -0,0 +1,9 @@ +(require 'pacmacs-image) + +(let ((canvas (pacmacs--make-image 1000 1000)) + (image (pacmacs--make-image 500 500))) + (benchmark 1000000 + (progn + (pacmacs--draw-image canvas image 0 0) + (pacmacs--draw-image canvas image 100 100) + (pacmacs--draw-image canvas image 900 900))))