Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

PNG input conversion rewrite for better transparency/alpha support.

There are two possible representations of transparency in PNG files:
alpha channel for :truecolor-alpha and :greyscale-alpha colour types,
and a separate transparency map in a tRNS ancillary chunk. PNG-READ
retains the difference by keeping data from tRNS as a separate
TRANSPARENCY property of png-state.

New version of OPTICL:READ-PNG-STREAM uses transparency data for
OPTICL alpha channel when reading a PNG with no "native" alpha channel
implied by colour-type. Additionally, as OPTICL has no equivalent for
:greyscale-alpha, greyscale images with (any kind of) transparency
data are converted to RGBA.

Due to a bug in PNG-READ (fix committed on pull request
<Ramarren/png-read#3), PNG-READ::TRANPARENCY
property contained a raw representation of tRNS ancillary chunk
instead of 2D 8-bit transparency data (that's how it was intended to
work). A workaround for unfixed PNG-READ was added to this version of
OPTICL:READ-PNG-STREAM: If TRANSPARENCY is not a 2D-array, its content
is ignored (as if there were no alpha channel). Warning or error could
be more appropriate here.

Turning :greyscale-alpha colour type to RGBA is an example of new use
cases supported by rewritten READ-PNG-STREAM, even with older
PNG-READ.
  • Loading branch information...
commit 9e0ba93a239658c0a345561ea6fd42a5698d3203 1 parent 28f6f3b
Anton Kovalenko authored

Showing 1 changed file with 72 additions and 68 deletions. Show diff stats Hide diff stats

  1. +72 68 png.lisp
140 png.lisp
@@ -4,74 +4,78 @@
4 4 (in-package :opticl)
5 5
6 6 (defun read-png-stream (stream)
7   - (let ((png (png-read:read-png-datastream stream)))
8   - (with-accessors
9   - ((colour-type png-read:colour-type)
10   - (bit-depth png-read:bit-depth)
11   - (width png-read:width)
12   - (height png-read:height)
13   - (image-data png-read:image-data))
14   - png
15   - (cond ((and (eq colour-type :truecolor)
16   - (eql bit-depth 8))
17   - (let ((img (make-8-bit-rgb-image height width)))
18   - (declare (type 8-bit-rgb-image img))
19   - (loop for i below height
20   - do
21   - (loop for j below width
22   - do
23   - (setf (pixel img i j)
24   - (values (aref image-data j i 0)
25   - (aref image-data j i 1)
26   - (aref image-data j i 2)))))
27   - img))
28   -
29   - ((and (eq colour-type :truecolor-alpha)
30   - (eql bit-depth 8))
31   - (let ((img (make-8-bit-rgba-image height width)))
32   - (declare (type 8-bit-rgba-image img))
33   - (loop for i below height
34   - do
35   - (loop for j below width
36   - do
37   - (setf (pixel img i j)
38   - (values (aref image-data j i 0)
39   - (aref image-data j i 1)
40   - (aref image-data j i 2)
41   - (aref image-data j i 3)))))
42   - img))
43   -
44   - ;;; the README says the colors are indexed -- but then on
45   - ;;; the next line says they're decoded. looks like decoded
46   - ;;; wins.
47   - ((and (eq colour-type :indexed-colour)
48   - (eql bit-depth 8))
49   - (let ((img (make-8-bit-rgb-image height width)))
50   - (declare (type 8-bit-rgb-image img))
51   - (loop for i below height
52   - do
53   - (loop for j below width
54   - do
55   - (setf (pixel img i j)
56   - (values (aref image-data j i 0)
57   - (aref image-data j i 1)
58   - (aref image-data j i 2)))))
59   - img))
60   -
61   - ((and (eq colour-type :greyscale)
62   - (eql bit-depth 8))
63   - (let ((img (make-8-bit-gray-image height width)))
64   - (declare (type 8-bit-gray-image img))
65   - (loop for i below height
66   - do
67   - (loop for j below width
68   - do
69   - (setf (pixel img i j)
70   - (aref image-data j i))))
71   - img))
72   -
73   - (t
74   - (error "unable to read PNG image -- fix read-png-stream!"))))))
  7 + (let* ((png (png-read:read-png-datastream stream))
  8 + (colour-type (png-read:colour-type png))
  9 + (bit-depth (png-read:bit-depth png))
  10 + (width (png-read:width png))
  11 + (height (png-read:height png))
  12 + (image-data (png-read:image-data png))
  13 + (transparency (png-read::transparency png)))
  14 + ;; Temporary provision for buggy png-read where an internal
  15 + ;; representation of transparency chunk were not turned into a
  16 + ;; proper transparency map during postprocessing (see
  17 + ;; <https://github.com/Ramarren/png-read/pull/3>.)
  18 + (unless (typep transparency '(array * 2))
  19 + (setf transparency nil))
  20 + (flet ((get-pixel-grey (i j)
  21 + (aref image-data j i))
  22 + (get-pixel-grey-alpha (i j)
  23 + (let ((brightness (aref image-data j i 0)))
  24 + (values brightness
  25 + brightness
  26 + brightness
  27 + (aref image-data j i 1))))
  28 + (get-pixel-grey-tmap (i j)
  29 + (let ((brightness (aref image-data j i)))
  30 + (values brightness
  31 + brightness
  32 + brightness
  33 + (aref transparency j i))))
  34 + (get-pixel-rgba (i j)
  35 + (values (aref image-data j i 0)
  36 + (aref image-data j i 1)
  37 + (aref image-data j i 2)
  38 + (aref image-data j i 3)))
  39 + (get-pixel-rgb-tmap (i j)
  40 + (values (aref image-data j i 0)
  41 + (aref image-data j i 1)
  42 + (aref image-data j i 2)
  43 + (aref transparency j i)))
  44 + (get-pixel-rgb (i j)
  45 + (values (aref image-data j i 0)
  46 + (aref image-data j i 1)
  47 + (aref image-data j i 2))))
  48 + (multiple-value-bind (constructor get-pixel-fn)
  49 + (case bit-depth
  50 + (8 (case transparency
  51 + ((nil)
  52 + (case colour-type
  53 + ((:truecolor :indexed-colour)
  54 + (values #'make-8-bit-rgb-image
  55 + #'get-pixel-rgb))
  56 + (:truecolor-alpha
  57 + (values #'make-8-bit-rgba-image
  58 + #'get-pixel-rgba))
  59 + (:greyscale-alpha
  60 + (values #'make-8-bit-rgba-image
  61 + #'get-pixel-grey-alpha))
  62 + (:greyscale
  63 + (values #'make-8-bit-gray-image
  64 + #'get-pixel-grey))))
  65 + (t
  66 + (values #'make-8-bit-rgba-image
  67 + (case colour-type
  68 + ((:truecolor :indexed-colour)
  69 + #'get-pixel-rgb-tmap)
  70 + (:greyscale
  71 + #'get-pixel-grey-tmap)))))))
  72 + (unless get-pixel-fn
  73 + (error "unable to read PNG image -- fix read-png-stream!"))
  74 + (let ((img (funcall constructor height width)))
  75 + (dotimes (i height img)
  76 + (dotimes (j width)
  77 + (setf (pixel img i j)
  78 + (funcall get-pixel-fn i j)))))))))
75 79
76 80 (defun read-png-file (pathname)
77 81 (with-open-file (stream pathname :direction :input :element-type '(unsigned-byte 8))

0 comments on commit 9e0ba93

Please sign in to comment.
Something went wrong with that request. Please try again.