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 # 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)))) diff --git a/pacmacs-image.el b/pacmacs-image.el new file mode 100644 index 0000000..2f3ff1c --- /dev/null +++ b/pacmacs-image.el @@ -0,0 +1,160 @@ +;;; pacmacs-image.el --- Pacman for Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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-data (width height) + (let ((data (make-vector height nil))) + (dotimes (i height) + (aset data i (make-vector width nil))) + 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)) + image + (aref (aref data y) x))) + +(defun pacmacs--set-image-pixel (image x y color) + (plist-bind ((data :data)) + 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) + (data :data)) + image + (let ((palette '())) + (dotimes (y height) + (dotimes (x width) + (let ((pixel (aref (aref data y) x))) + (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--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) + (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 2b8f6d9..149a78b 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)) diff --git a/test/pacmacs-image-test.el b/test/pacmacs-image-test.el new file mode 100644 index 0000000..1f9fa06 --- /dev/null +++ b/test/pacmacs-image-test.el @@ -0,0 +1,97 @@ +(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))))) + +(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))))))))