179 lines
7.9 KiB
EmacsLisp
179 lines
7.9 KiB
EmacsLisp
;;; image-transforms-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Alan Third <alan@idiocy.org>
|
|
;; Keywords: internal
|
|
;; Human-Keywords: internal
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Type M-x test-transforms RET to generate the test buffer.
|
|
|
|
;;; Code:
|
|
|
|
(defun test-rotation ()
|
|
(let ((up "<svg height='9' width='9'><polygon points='0,8 4,0 8,8'/></svg>")
|
|
(down "<svg height='9' width='9'><polygon points='0,0 4,8 8,0'/></svg>")
|
|
(left "<svg height='9' width='9'><polygon points='8,0 0,4 8,8'/></svg>")
|
|
(right "<svg height='9' width='9'><polygon points='0,0 8,4 0,8'/></svg>"))
|
|
(insert-header "Test Rotation: rotating an image")
|
|
(insert-test "0" up up '(:rotation 0))
|
|
(insert-test "360" up up '(:rotation 360))
|
|
(insert-test "180" down up '(:rotation 180))
|
|
(insert-test "-90" left up '(:rotation -90))
|
|
(insert-test "90" right up '(:rotation 90))
|
|
(insert-test "90.0" right up '(:rotation 90.0))
|
|
|
|
;; This should log a message and display the unrotated image.
|
|
(insert-test "45" up up '(:rotation 45)))
|
|
(insert "\n\n"))
|
|
|
|
(defun test-cropping ()
|
|
(let ((image "<svg height='30' width='30'>
|
|
<rect x='0' y='0' width='10' height='10'/>
|
|
<rect x='10' y='10' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<line x1='10' y1='10' x2='20' y2='20' style='stroke:currentColor'/>
|
|
<line x1='20' y1='10' x2='10' y2='20' style='stroke:currentColor'/>
|
|
<rect x='20' y='20' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
</svg>")
|
|
(top-left "<svg height='10' width='10'>
|
|
<rect x='0' y='0' width='10' height='10'/>
|
|
</svg>")
|
|
(middle "<svg height='10' width='10'>
|
|
<rect x='0' y='0' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<line x1='0' y1='0' x2='10' y2='10' style='stroke:currentColor'/>
|
|
<line x1='10' y1='0' x2='0' y2='10' style='stroke:currentColor'/>
|
|
</svg>")
|
|
(bottom-right "<svg height='10' width='10'>
|
|
<rect x='0' y='0' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
</svg>"))
|
|
(insert-header "Test Crop: cropping an image (only works with ImageMagick)")
|
|
(insert-test "all params" top-left image '(:crop (10 10 0 0)))
|
|
(insert-test "width/height only" middle image '(:crop (10 10)))
|
|
(insert-test "negative x y" middle image '(:crop (10 10 -10 -10)))
|
|
(insert-test "all params" bottom-right image '(:crop (10 10 20 20))))
|
|
(insert "\n\n"))
|
|
|
|
(defun test-scaling ()
|
|
(let ((image "<svg height='10' width='10'>
|
|
<rect x='0' y='0' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<line x1='0' y1='0' x2='10' y2='10' style='stroke:currentColor'/>
|
|
<line x1='10' y1='0' x2='0' y2='10' style='stroke:currentColor'/>
|
|
</svg>")
|
|
(large "<svg height='20' width='20'>
|
|
<rect x='0' y='0' width='20' height='20'
|
|
style='fill:none;stroke-width:2;stroke:currentColor'/>
|
|
<line x1='0' y1='0' x2='20' y2='20'
|
|
style='stroke-width:2;stroke:currentColor'/>
|
|
<line x1='20' y1='0' x2='0' y2='20'
|
|
style='stroke-width:2;stroke:currentColor'/>
|
|
</svg>")
|
|
(small "<svg height='5' width='5'>
|
|
<rect x='0' y='0' width='4' height='4'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<line x1='0' y1='0' x2='4' y2='4' style='stroke:currentColor'/>
|
|
<line x1='4' y1='0' x2='0' y2='4' style='stroke:currentColor'/>
|
|
</svg>"))
|
|
(insert-header "Test Scaling: resize an image (pixelization may occur)")
|
|
(insert-test "1x" image image '(:scale 1))
|
|
(insert-test "2x" large image '(:scale 2))
|
|
(insert-test "0.5x" image large '(:scale 0.5))
|
|
(insert-test ":max-width" image large '(:max-width 10))
|
|
(insert-test ":max-height" image large '(:max-height 10))
|
|
(insert-test "width, height" image large '(:width 10 :height 10)))
|
|
(insert "\n\n"))
|
|
|
|
(defun test-scaling-rotation ()
|
|
(let ((image "<svg height='20' width='20'>
|
|
<rect x='0' y='0' width='20' height='20'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<rect x='0' y='0' width='10' height='10'
|
|
style='fill:currentColor'/>
|
|
</svg>")
|
|
(x2-90 "<svg height='40' width='40'>
|
|
<rect x='0' y='0' width='40' height='40'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<rect x='20' y='0' width='20' height='20'
|
|
style='fill:currentColor'/>
|
|
</svg>")
|
|
(x2--90 "<svg height='40' width='40'>
|
|
<rect x='0' y='0' width='40' height='40'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<rect x='0' y='20' width='20' height='20'
|
|
style='fill:currentColor'/>
|
|
</svg>")
|
|
(x0.5-180 "<svg height='10' width='10'>
|
|
<rect x='0' y='0' width='10' height='10'
|
|
style='fill:none;stroke-width:1;stroke:currentColor'/>
|
|
<rect x='5' y='5' width='5' height='5'
|
|
style='fill:currentColor'/>
|
|
</svg>"))
|
|
(insert-header "Test Scaling and Rotation: resize and rotate an image (pixelization may occur)")
|
|
(insert-test "1x, 0 degrees" image image '(:scale 1 :rotation 0))
|
|
(insert-test "2x, 90 degrees" x2-90 image '(:scale 2 :rotation 90.0))
|
|
(insert-test "2x, -90 degrees" x2--90 image '(:scale 2 :rotation -90.0))
|
|
(insert-test "0.5x, 180 degrees" x0.5-180 image '(:scale 0.5 :rotation 180.0)))
|
|
(insert "\n\n"))
|
|
|
|
(defun insert-header (description)
|
|
(insert description)
|
|
(insert "\n")
|
|
(indent-to 38)
|
|
(insert "expected")
|
|
(indent-to 48)
|
|
(insert "result")
|
|
(when (fboundp #'imagemagick-types)
|
|
(indent-to 58)
|
|
(insert "ImageMagick"))
|
|
(insert "\n"))
|
|
|
|
(defun insert-test (description expected image params)
|
|
(indent-to 2)
|
|
(insert description)
|
|
(indent-to 40)
|
|
(insert-image (create-image expected 'svg t))
|
|
(indent-to 50)
|
|
(insert-image (apply #'create-image image 'svg t params))
|
|
(when (fboundp #'imagemagick-types)
|
|
(indent-to 60)
|
|
(insert-image (apply #'create-image image 'imagemagick t params)))
|
|
(insert "\n"))
|
|
|
|
(defun test-transforms ()
|
|
(interactive)
|
|
(let ((buf (get-buffer "*Image Transform Test*")))
|
|
(if buf
|
|
(kill-buffer buf))
|
|
(switch-to-buffer (get-buffer-create "*Image Transform Test*"))
|
|
(erase-buffer)
|
|
(unless #'imagemagick-types
|
|
(insert "ImageMagick not detected. ImageMagick tests will be skipped.\n\n"))
|
|
(test-rotation)
|
|
(test-cropping)
|
|
(test-scaling)
|
|
(test-scaling-rotation)
|
|
(goto-char (point-min))))
|
|
|
|
;;; image-transforms-tests.el ends here
|