aboutsummaryrefslogtreecommitdiff
path: root/pnm
diff options
context:
space:
mode:
Diffstat (limited to 'pnm')
-rw-r--r--pnm/image.scm56
-rw-r--r--pnm/pbm.scm24
-rw-r--r--pnm/pgm.scm12
-rw-r--r--pnm/ppm.scm12
-rw-r--r--pnm/read.scm18
-rw-r--r--pnm/write.scm52
6 files changed, 87 insertions, 87 deletions
diff --git a/pnm/image.scm b/pnm/image.scm
index ceab0cf..f9d0b83 100644
--- a/pnm/image.scm
+++ b/pnm/image.scm
@@ -17,37 +17,37 @@
;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
(define-library (pnm image)
- (export make-image
- image?
- image-type
- image-width
- image-height
- image-maxval
- image-data
- image-pixel-getter
- image-pixel-setter
- image-ref
- image-set!)
+ (export make-pnm-image
+ pnm-image?
+ pnm-image-type
+ pnm-image-width
+ pnm-image-height
+ pnm-image-maxval
+ pnm-image-data
+ pnm-image-pixel-getter
+ pnm-image-pixel-setter
+ pnm-image-ref
+ pnm-image-set!)
(import (scheme base)
(scheme case-lambda))
(begin
- (define-record-type <image>
- (make-image type width height maxval data pixel-getter pixel-setter)
- image?
- (type image-type)
- (width image-width)
- (height image-height)
- (maxval image-maxval)
- (data image-data)
- (pixel-getter image-pixel-getter)
- (pixel-setter image-pixel-setter))
+ (define-record-type <pnm-image>
+ (make-pnm-image type width height maxval data pixel-getter pixel-setter)
+ pnm-image?
+ (type pnm-image-type)
+ (width pnm-image-width)
+ (height pnm-image-height)
+ (maxval pnm-image-maxval)
+ (data pnm-image-data)
+ (pixel-getter pnm-image-pixel-getter)
+ (pixel-setter pnm-image-pixel-setter))
- (define (image-ref image x y)
- ((image-pixel-getter image) x y))
+ (define (pnm-image-ref pnm-image x y)
+ ((pnm-image-pixel-getter pnm-image) x y))
- (define image-set!
+ (define pnm-image-set!
(case-lambda
- ((image x y v)
- ((image-pixel-setter image) x y v))
- ((image x y r g b)
- ((image-pixel-setter image) x y r g b))))))
+ ((pnm-image x y v)
+ ((pnm-image-pixel-setter pnm-image) x y v))
+ ((pnm-image x y r g b)
+ ((pnm-image-pixel-setter pnm-image) x y r g b))))))
diff --git a/pnm/pbm.scm b/pnm/pbm.scm
index 696c4d3..d580616 100644
--- a/pnm/pbm.scm
+++ b/pnm/pbm.scm
@@ -56,15 +56,15 @@
(error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
(let ((check-xy (make-xy-checker width height))
(check-boolean-value (make-boolean-value-checker)))
- (make-image 'pbm width height #t data
- (if unsafe?
- pixel-getter
- (lambda (x y)
- (check-xy x y)
- (pixel-getter x y)))
- (if unsafe?
- pixel-setter
- (lambda (x y v)
- (check-xy x y)
- (check-boolean-value v)
- (pixel-setter x y v)))))))))
+ (make-pnm-image 'pbm width height #t data
+ (if unsafe?
+ pixel-getter
+ (lambda (x y)
+ (check-xy x y)
+ (pixel-getter x y)))
+ (if unsafe?
+ pixel-setter
+ (lambda (x y v)
+ (check-xy x y)
+ (check-boolean-value v)
+ (pixel-setter x y v)))))))))
diff --git a/pnm/pgm.scm b/pnm/pgm.scm
index 6bb29d2..5a4f027 100644
--- a/pnm/pgm.scm
+++ b/pnm/pgm.scm
@@ -70,9 +70,9 @@
(bytevector-u8-set! data idx v)))
(unless (= byte-count (bytevector-length data))
(error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
- (make-image 'pgm width height maxval data
- (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
- (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))
+ (make-pnm-image 'pgm width height maxval data
+ (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
+ (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))
(let ((byte-count (* width height 2)))
(define (xy->idx x y) (+ x (* y width)))
(define (pixel-getter x y)
@@ -86,6 +86,6 @@
(bytevector-u8-set! data (+ idx 1) v2))))
(unless (= byte-count (bytevector-length data))
(error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
- (make-image 'pgm width height maxval data
- (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
- (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))))))
+ (make-pnm-image 'pgm width height maxval data
+ (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
+ (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))))))
diff --git a/pnm/ppm.scm b/pnm/ppm.scm
index bdf60cf..ff1abb3 100644
--- a/pnm/ppm.scm
+++ b/pnm/ppm.scm
@@ -79,9 +79,9 @@
(bytevector-u8-set! data (+ idx 2) b)))
(unless (= byte-count (bytevector-length data))
(error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
- (make-image 'ppm width height maxval data
- (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
- (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))
+ (make-pnm-image 'ppm width height maxval data
+ (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
+ (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))
(let* ((w*6 (* width 6))
(byte-count (* w*6 height)))
(define (xy->idx x y) (+ (* 6 x) (* y w*6)))
@@ -106,6 +106,6 @@
(bytevector-u8-set! data (+ idx 5) b2))))
(unless (= byte-count (bytevector-length data))
(error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count)))
- (make-image 'ppm width height maxval data
- (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
- (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))))))
+ (make-pnm-image 'ppm width height maxval data
+ (if unsafe? pixel-getter (make-safe-pixel-getter pixel-getter))
+ (if unsafe? pixel-setter (make-safe-pixel-setter pixel-setter))))))))
diff --git a/pnm/read.scm b/pnm/read.scm
index f673c35..4c7dd52 100644
--- a/pnm/read.scm
+++ b/pnm/read.scm
@@ -17,7 +17,7 @@
;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
(define-library (pnm read)
- (export image-read
+ (export pnm-image-read
pnm-parse-error?)
(import (scheme base)
(scheme case-lambda)
@@ -26,10 +26,10 @@
(pnm pgm)
(pnm ppm))
(begin
- (define image-read
+ (define pnm-image-read
(case-lambda
((in)
- (image-read in #f))
+ (pnm-image-read in #f))
((in unsafe?)
(define (read-u8*)
(let ((u8 (read-u8 in)))
@@ -76,7 +76,7 @@
(pbm-image (make-pbm-image width height unsafe?)))
(read-text-raster width height #f in
(lambda (x y v)
- (image-set! pbm-image x y (= v 1)))
+ (pnm-image-set! pbm-image x y (= v 1)))
unexpected-eof-error
unexpected-character-error)
pbm-image))
@@ -93,7 +93,7 @@
unsafe?))
((P3)
(let ((ppm-image (make-ppm-image width height maxval unsafe?)))
- (read-text-raster width height #t in (image-pixel-setter ppm-image)
+ (read-text-raster width height #t in (pnm-image-pixel-setter ppm-image)
unexpected-eof-error
unexpected-character-error)
ppm-image))
@@ -106,7 +106,7 @@
unsafe?))
((P2)
(let ((pgm-image (make-pgm-image width height maxval unsafe?)))
- (read-text-raster width height #f in (image-pixel-setter pgm-image)
+ (read-text-raster width height #f in (pnm-image-pixel-setter pgm-image)
unexpected-eof-error
unexpected-character-error)
pgm-image))))))))))))
@@ -226,11 +226,11 @@
(else number)))))))
(define (unexpected-magic-number-error)
- (raise (pnm-parse-error "(pnm read) image-read: Not supported magic number")))
+ (raise (pnm-parse-error "(pnm read) pnm-image-read: Not supported magic number")))
(define (unexpected-eof-error)
- (raise (pnm-parse-error "(pnm read) image-read: Unexpected end of file")))
+ (raise (pnm-parse-error "(pnm read) pnm-image-read: Unexpected end of file")))
(define (unexpected-character-error)
- (raise (pnm-parse-error "(pnm read) image-read: Unexpected character"))))
+ (raise (pnm-parse-error "(pnm read) pnm-image-read: Unexpected character"))))
(cond-expand
((library (srfi 35))
(import (srfi 35))
diff --git a/pnm/write.scm b/pnm/write.scm
index 849e3de..60dbd0e 100644
--- a/pnm/write.scm
+++ b/pnm/write.scm
@@ -17,15 +17,15 @@
;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
(define-library (pnm write)
- (export image-write)
+ (export pnm-image-write)
(import (scheme base)
(scheme case-lambda)
(pnm image))
(begin
- (define image-write
+ (define pnm-image-write
(case-lambda
- ((image out)
- (case (image-type image)
+ ((pnm-image out)
+ (case (pnm-image-type pnm-image)
((ppm)
(write-string-u8 "P6\n" out))
((pgm)
@@ -33,23 +33,23 @@
((pbm)
(write-string-u8 "P4\n" out))
(else
- (error "(pnm write) image-write: Not supported type" (image-type image))))
- (write-string-u8 (number->string (image-width image)) out)
+ (error "(pnm write) pnm-image-write: Not supported type" (pnm-image-type pnm-image))))
+ (write-string-u8 (number->string (pnm-image-width pnm-image)) out)
(write-string-u8 " " out)
- (write-string-u8 (number->string (image-height image)) out)
+ (write-string-u8 (number->string (pnm-image-height pnm-image)) out)
(write-string-u8 "\n" out)
- (case (image-type image)
+ (case (pnm-image-type pnm-image)
((pgm ppm)
- (write-string-u8 (number->string (image-maxval image)) out)
+ (write-string-u8 (number->string (pnm-image-maxval pnm-image)) out)
(write-string-u8 "\n" out)))
- (write-bytevector (image-data image) out))
- ((image out plain?)
+ (write-bytevector (pnm-image-data pnm-image) out))
+ ((pnm-image out plain?)
(if plain?
- (image-write/plan image out)
- (image-write image out)))))
+ (pnm-image-write/plan pnm-image out)
+ (pnm-image-write pnm-image out)))))
- (define (image-write/plan image out)
- (case (image-type image)
+ (define (pnm-image-write/plan pnm-image out)
+ (case (pnm-image-type pnm-image)
((ppm)
(write-string-u8 "P3\n" out))
((pgm)
@@ -57,19 +57,19 @@
((pbm)
(write-string-u8 "P1\n" out))
(else
- (error "(pnm write) image-write: Not supported type" (image-type image))))
- (write-string-u8 (number->string (image-width image)) out)
+ (error "(pnm write) image-write: Not supported type" (pnm-image-type pnm-image))))
+ (write-string-u8 (number->string (pnm-image-width pnm-image)) out)
(write-string-u8 " " out)
- (write-string-u8 (number->string (image-height image)) out)
+ (write-string-u8 (number->string (pnm-image-height pnm-image)) out)
(write-string-u8 "\n" out)
- (case (image-type image)
+ (case (pnm-image-type pnm-image)
((pgm ppm)
- (write-string-u8 (number->string (image-maxval image)) out)
+ (write-string-u8 (number->string (pnm-image-maxval pnm-image)) out)
(write-string-u8 "\n" out)))
(let-values (((write-token write-newline)
(limit-line-length-writer 70 out)))
- (let ((width (image-width image))
- (height (image-height image)))
+ (let ((width (pnm-image-width pnm-image))
+ (height (pnm-image-height pnm-image)))
(define (write-raster write-pixel)
(do ((y 0 (+ y 1)))
((= y height))
@@ -78,23 +78,23 @@
((= x width))
(write-pixel x y))
(write-newline)))
- (case (image-type image)
+ (case (pnm-image-type pnm-image)
((ppm)
(write-raster
(lambda (x y)
- (let-values (((r g b) (image-ref image x y)))
+ (let-values (((r g b) (pnm-image-ref pnm-image x y)))
(write-token (number->string r))
(write-token (number->string g))
(write-token (number->string b))))))
((pgm)
(write-raster
(lambda (x y)
- (let ((v (image-ref image x y)))
+ (let ((v (pnm-image-ref pnm-image x y)))
(write-token (number->string v))))))
((pbm)
(write-raster
(lambda (x y)
- (let ((b (image-ref image x y)))
+ (let ((b (pnm-image-ref pnm-image x y)))
(write-token (if b "1" "0"))))))))))
(define (write-string-u8 str out)
generated by cgit v1.2.3 (git 2.50.1) at 2025-10-31 12:02:21 +0000