modules/png/image (initialize): Allow #:color-type to be a symbol

* modules/png/image.scm (initialize): <png-image>: Allow #:color-type to be a symbol. * tests/image.scm ("<png-image>: png-image-clone"): Fix.
artyom-poptsov · Jan 22, 2024 · ff694d1 · ff694d1
1 parent a7b7d47
commit ff694d1
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 3 deletions.
diff --git a/modules/png/image.scm b/modules/png/image.scm
@@ -339,7 +339,18 @@ set to #t, the procedure returns data in uncompressed form."
       (png-image-data-set! image (make-bytevector (* (png-image-width image)
                                                      (png-image-height image)
                                                      3)
-                                                  0)))))
+                                                  0))))
+  (let ((color-type (constructor-argument #:color-type initargs)))
+    (cond
+      ((symbol? color-type)
+       (png-image-color-type-set! image
+                                  (symbol->png-image-color-type color-type)))
+      ((number? color-type)
+       (png-image-color-type-set! image color-type))
+      ((not color-type)
+       (error "#:color-type must be set" color-type))
+      (else
+       (error "#:color-type must be either a symbol or a number" color-type)))))
 
 
 (define (png-image? x)

diff --git a/tests/image.scm b/tests/image.scm
@@ -137,8 +137,9 @@
                   #:type      'IHDR))
          (iend  (make <png-chunk:IEND>))
          (image (make <png-image>
-                  #:chunks    (list ihdr iend)
-                  #:data      #vu8(255 255 255 255)))
+                  #:color-type 2
+                  #:chunks     (list ihdr iend)
+                  #:data        #vu8(255 255 255 255)))
          (image-clone (png-image-clone image)))
     (and (not (eq? (png-image-chunks image)
                    (png-image-chunks image-clone)))