blob: 01e74d04a63a9a98a2f1bcc12775c7717ee848c1 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(define-library (pnm read)
(export image-read)
(import (scheme base)
(pnm image)
(pnm pgm)
(pnm ppm))
(begin
(define (image-read in)
(define (unexpected-eof-error)
(error "(pnm read) image-read: Unexpected end of file"))
(define (unexpected-char-error)
(error "(pnm read) image-read: Unexpected character"))
(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
(error "(pnm read) image-read: Not supported magic number"))
magic-number))
(define (read-number*)
(let ((n (read-number in)))
(when (eof-object? n)
(unexpected-eof-error))
(unless n
(unexpected-char-error))
n))
(define (read-whitespaces*)
(when (eof-object? (read-whitespaces in))
(unexpected-eof-error)))
(let ((magic-number (read-magic-number*)))
(read-whitespaces*)
(let ((width (read-number in)))
(read-whitespaces*)
(let ((height (read-number in)))
(read-whitespaces*)
(let ((maxval (read-number in)))
(unless (whitespace? (read-u8*))
(unexpected-char-error))
(case magic-number
((P6)
(make-ppm-image width height maxval
(if (< maxval 256)
(read-bytevector (* 3 width height) in)
(read-bytevector (* 6 width height) in))))
((P5)
(make-pgm-image width height maxval
(if (< maxval 256)
(read-bytevector (* width height) in)
(read-bytevector (* 2 width height) in))))))))))
(define (whitespace? u8)
(case (integer->char u8)
((#\newline #\return #\tab #\space) #t)
(else #f)))
(define (comment? u8)
(char=? #\# (integer->char u8)))
(define (newline? u8)
(case (integer->char u8)
((#\newline #\return) #t)
(else #f)))
(define (read-comment in)
(let ((u8 (peek-u8 in)))
(cond ((eof-object? u8) (eof-object))
((newline? u8)
(read-u8 in)
(read-whitespaces in))
(else
(read-u8 in)
(read-comment in)))))
(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)
(else #f))))
(define (read-whitespaces in)
(let ((u8 (peek-u8 in)))
(cond ((eof-object? u8) (eof-object))
((whitespace? u8)
(read-u8 in)
(read-whitespaces in))
((comment? u8)
(read-u8 in)
(read-comment in))
(else #t))))
(define (read-number in)
(call-with-current-continuation
(lambda (return)
(let ((u8 (peek-u8 in)))
(when (or (eof-object? u8)
(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)))))))))
|
