;;; Chickadee Game Toolkit
;;; Copyright © 2023 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;
;; Data type for representing images on disk.
;;
;;; Code:

(define-module (chickadee image)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics pixbuf)
  #:use-module (chickadee image jpeg)
  #:use-module (chickadee image png)
  #:use-module (chickadee utils)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:export (make-image
            image?
            image-file-name
            temp-image-file-name
            read-image
            write-image))

(define &image-error
  (make-exception-type '&image-error &error '()))

(define make-image-error (record-constructor &image-error))

(define (image-error message irritants)
 (raise-exception
  (make-exception
   (make-image-error)
   (make-exception-with-message message)
   (make-exception-with-irritants irritants))))

;; An image is pixel data that is stored on disk in one of a variety
;; of formats.
(define-record-type <image>
  (%make-image file-name)
  image?
  (file-name image-file-name))

(define (make-image file-name)
  (%make-image (absolute-file-name file-name)))

(define (print-image image port)
  ;; Rendering in a format that Geiser understands so that images can
  ;; be viewed inline at the REPL.
  (format port "#<Image: ~a>" (image-file-name image)))

(set-record-type-printer! <image> print-image)

(define (image-format image)
  (match (file-extension (image-file-name image))
    ((or "jpg" "jpeg") 'jpeg)
    ("png" 'png)
    (_ 'unknown)))

(define* (read-image image)
  "Read data from IMAGE and return a pixbuf."
  (define-values (pixels width height)
    (case (image-format image)
      ((jpeg)
       (load-jpeg (image-file-name image)))
      ((png)
       (load-png (image-file-name image)))
      (else
       (image-error "unsupported image format: ~a" (image-format image)))))
  (bytevector->pixbuf pixels width height #:format 'rgba #:bit-depth 8))

;; Not guaranteed to be a file that doesn't exist, but good enough.
(define (temp-image-file-name format)
  (string-append (tmpdir) "/"
                 (symbol->string
                  (gensym "chickadee-"))
                 "."
                 (symbol->string format)))

(define* (write-image pixbuf
                      #:optional (file-name (temp-image-file-name 'png))
                      #:key (format 'png))
  "Write PIXBUF to FILE-NAME and return an image object.  FORMAT may be
either 'png' or 'jpeg'."
  (unless (and (eq? (pixbuf-format pixbuf) 'rgba)
               (= (pixbuf-bit-depth pixbuf) 8))
    (image-error "can only write RGBA pixbufs with 8 bit depth: ~a" pixbuf))
  (case format
    ((png)
     (save-png (pixbuf-pixels pixbuf)
               (pixbuf-width pixbuf)
               (pixbuf-height pixbuf)
               file-name))
    (else
     (image-error "unsupport image format: ~a" format)))
  (make-image file-name))