Add `image-format` prefix to library name

1 files changed, 0 insertions, 253 deletions

diff --git a/pnm/read.scm b/pnm/read.scm
deleted file mode 100644
index 4c7dd52..0000000
--- a/pnm/read.scm
+++ /dev/null
@@ -1,253 +0,0 @@
-;;; R7RS-PNM --- Library for reading and writing PNM (Portable Any Map) files for R7RS
-;;; Copyright © 2024 Masaya Tojo <masaya@tojo.tokyo>
-;;;
-;;; This file is part of R7RS-PNM.
-;;;
-;;; R7RS-PNM is free software: you can redistribute it and/or modify it
-;;; under the terms of the GNU Lesser General Public License as published
-;;; by the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; R7RS-PNM 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 Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public License
-;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
-
-(define-library (pnm read)
-  (export pnm-image-read
-          pnm-parse-error?)
-  (import (scheme base)
-          (scheme case-lambda)
-          (pnm image)
-          (pnm pbm)
-          (pnm pgm)
-          (pnm ppm))
-  (begin
-    (define pnm-image-read
-      (case-lambda
-        ((in)
-         (pnm-image-read in #f))
-        ((in unsafe?)
-         (define (read-u8*)
-           (let ((u8 (read-u8 in)))
-             (when (eof-object? u8)
-               (unexpected-eof-error))
-             u8))
-         (define (read-magic-number*)
-           (let ((magic-number (read-magic-number in)))
-             (when (eof-object? magic-number)
-               (unexpected-eof-error))
-             (unless magic-number
-               (unexpected-magic-number-error))
-             magic-number))
-         (define (read-number*)
-           (let ((n (read-number in)))
-             (when (eof-object? n)
-               (unexpected-eof-error))
-             (unless n
-               (unexpected-character-error))
-             n))
-         (define (read-whitespaces*)
-           (let ((result (read-whitespaces in)))
-             (when (eof-object? result)
-               (unexpected-eof-error))
-             (unless result
-               (unexpected-character-error))))
-         (define (read-single-whitespace*)
-           (unless (whitespace? (read-u8*))
-             (unexpected-character-error)))
-
-         (let ((magic-number (read-magic-number*)))
-           (read-whitespaces*)
-           (let ((width (read-number in)))
-             (read-whitespaces*)
-             (let ((height (read-number in)))
-               (case magic-number
-                 ((P4)
-                  (read-single-whitespace*)
-                  (%make-pbm-image width height
-                                   (read-bytevector (* (ceiling (/ width 8)) height) in)
-                                   unsafe?))
-                 ((P1)
-                  (let ((byte-width (ceiling (/ width 8)))
-                        (pbm-image (make-pbm-image width height unsafe?)))
-                    (read-text-raster width height #f in
-                                      (lambda (x y v)
-                                        (pnm-image-set! pbm-image x y (= v 1)))
-                                      unexpected-eof-error
-                                      unexpected-character-error)
-                    pbm-image))
-                 (else
-                  (read-whitespaces*)
-                  (let ((maxval (read-number in)))
-                    (case magic-number
-                      ((P6)
-                       (read-single-whitespace*)
-                       (%make-ppm-image width height maxval
-                                        (if (< maxval 256)
-                                            (read-bytevector (* 3 width height) in)
-                                            (read-bytevector (* 6 width height) in))
-                                        unsafe?))
-                      ((P3)
-                       (let ((ppm-image (make-ppm-image width height maxval unsafe?)))
-                         (read-text-raster width height #t in (pnm-image-pixel-setter ppm-image)
-                                           unexpected-eof-error
-                                           unexpected-character-error)
-                         ppm-image))
-                      ((P5)
-                       (read-single-whitespace*)
-                       (%make-pgm-image width height maxval
-                                        (if (< maxval 256)
-                                            (read-bytevector (* width height) in)
-                                            (read-bytevector (* 2 width height) in))
-                                        unsafe?))
-                      ((P2)
-                       (let ((pgm-image (make-pgm-image width height maxval unsafe?)))
-                         (read-text-raster width height #f in (pnm-image-pixel-setter pgm-image)
-                                           unexpected-eof-error
-                                           unexpected-character-error)
-                         pgm-image))))))))))))
-
-    (define (whitespace? u8)
-      (case (integer->char u8)
-        ((#\newline
-          #\return
-          #\tab
-          #\space
-          #\x000B ;; Vertical Tab
-          #\x000c ;; Form Feed
-          )
-         #t)
-        (else #f)))
-
-    (define (comment? u8)
-      (char=? #\# (integer->char u8)))
-
-    (define (newline? u8)
-      (case (integer->char u8)
-        ((#\newline) #t)
-        (else #f)))
-
-    (define (read-comment in)
-      (let ((u8 (peek-u8 in)))
-        (cond ((eof-object? u8) (eof-object))
-              ((newline? u8)
-               (read-u8 in)
-               (skip-whitespace in))
-              (else
-               (read-u8 in)
-               (read-comment in)))))
-
-    (define (skip-whitespace in)
-      (let ((u8 (peek-u8 in)))
-        (cond ((eof-object? u8) #t)
-              ((whitespace? u8)
-               (read-u8 in)
-               (skip-whitespace in))
-              ((comment? u8)
-               (read-u8 in)
-               (read-comment in))
-              (else #t))))
-
-    (define (digit? u8)
-      (and (<= 48 u8)
-           (<= u8 57)))
-
-    (define (u8->integer u8)
-      (- u8 48))
-
-    (define (read-magic-number in)
-      (let* ((P/u8 (char->integer #\P))
-             (u8-1 (read-u8 in))
-             (u8-2 (read-u8 in))
-             (u8-2/int (u8->integer u8-2)))
-        (cond ((or (eof-object? u8-1) (eof-object? u8-2)) (eof-object))
-              ((and (= u8-1 P/u8) (= u8-2/int 6)) 'P6)
-              ((and (= u8-1 P/u8) (= u8-2/int 5)) 'P5)
-              ((and (= u8-1 P/u8) (= u8-2/int 4)) 'P4)
-              ((and (= u8-1 P/u8) (= u8-2/int 3)) 'P3)
-              ((and (= u8-1 P/u8) (= u8-2/int 2)) 'P2)
-              ((and (= u8-1 P/u8) (= u8-2/int 1)) 'P1)
-              (else #f))))
-
-    (define (read-whitespaces in)
-      (let ((u8 (peek-u8 in)))
-        (cond ((eof-object? u8) (eof-object))
-              ((whitespace? u8)
-               (read-u8 in)
-               (skip-whitespace in))
-              (else #f))))
-
-    (define (read-text-raster width height rgb? in proc fail-eof-object fail-unexpected-char)
-      (call-with-current-continuation
-       (lambda (return)
-         (define (read-whitespaces*)
-           (let ((result (read-whitespaces in)))
-             (when (eof-object? result)
-               (return (fail-eof-object)))
-             (unless result
-               (return (fail-unexpected-char)))))
-         (define (read-number*)
-           (let ((number (read-number in)))
-             (when (eof-object? number)
-               (return (fail-eof-object)))
-             (unless number
-               (return (fail-unexpected-char)))
-             number))
-         (let ((size (* width height)))
-           (do ((y 0 (+ y 1)))
-               ((= y height))
-             (do ((x 0 (+ x 1)))
-                 ((= x width))
-               (if rgb?
-                   (let* ((r (begin (read-whitespaces*) (read-number*)))
-                          (g (begin (read-whitespaces*) (read-number*)))
-                          (b (begin (read-whitespaces*) (read-number*))))
-                     (proc x y r g b))
-                   (proc x y (begin (read-whitespaces*) (read-number*))))))))))
-
-    (define (read-number in)
-      (call-with-current-continuation
-       (lambda (return)
-         (let ((u8 (peek-u8 in)))
-           (when (eof-object? u8)
-             (return (eof-object)))
-           (when (not (digit? u8))
-             (return #f)))
-         (let loop ((number 0))
-           (let ((u8 (peek-u8 in)))
-             (cond ((eof-object? u8) (eof-object))
-                   ((digit? u8)
-                    (read-u8 in)
-                    (loop (+ (* number 10) (u8->integer u8))))
-                   (else number)))))))
-
-    (define (unexpected-magic-number-error)
-      (raise (pnm-parse-error "(pnm read) pnm-image-read: Not supported magic number")))
-    (define (unexpected-eof-error)
-      (raise (pnm-parse-error "(pnm read) pnm-image-read: Unexpected end of file")))
-    (define (unexpected-character-error)
-      (raise (pnm-parse-error "(pnm read) pnm-image-read: Unexpected character"))))
-  (cond-expand
-    ((library (srfi 35))
-     (import (srfi 35))
-     (begin
-       (define-condition-type &pnm-parse-error &error
-         pnm-parse-error?)
-
-       (define (pnm-parse-error msg)
-         (raise (condition (&pnm-parse-error)
-                           (&message
-                            (message msg)))))))
-    (r7rs
-     (begin
-       (define-record-type <pnm-parse-error>
-         (make-pnm-parse-error message)
-         pnm-parse-error?
-         (message pnm-parse-error-message))
-
-       (define (pnm-parse-error msg)
-         (raise (make-pnm-parse-error msg)))))))