2
Copyright 2005,2006 by Mark Weyer
4
This program is free software; you can redistribute it and/or modify
5
it under the terms of the GNU General Public License as published by
6
the Free Software Foundation; either version 2 of the License, or
7
(at your option) any later version.
9
This program is distributed in the hope that it will be useful,
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
GNU General Public License for more details.
14
You should have received a copy of the GNU General Public License
15
along with this program; if not, write to the Free Software
16
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
let whitespace = String.contains " \t\n"
26
int * int * int * int * (* width, height, depth, maxval *)
29
type pamdata = basic_pamdata * string (* tuple type *)
33
let rec read_token line p =
34
let rec finish_token q =
35
if q=(String.length line)
37
else if whitespace (String.get line q)
39
else finish_token (q+1) in
40
if p=(String.length line)
42
else if whitespace (String.get line p)
43
then read_token line (p+1)
44
else let p'=finish_token p in
45
Some (String.sub line p (p'-p), p')
47
let rec tokenize line p =
48
match read_token line p with
50
Some (t,p') -> t::(tokenize line p')
52
let rec read_tupletype line p q =
55
else if whitespace (String.get line p)
56
then read_tupletype line (p+1) q
57
else if whitespace (String.get line q)
58
then read_tupletype line p (q-1)
59
else String.sub line p (q-p+1)
61
let read_headerline channel =
62
let line = input_line channel in
63
if (String.length line)=0 then None else
64
if (String.get line 0)='#' then None else
65
match read_token line 0 with
67
Some (t,p) -> if t="TUPLTYPE"
68
then Some (t::[read_tupletype line p ((String.length line)-1)])
69
else Some (t::(tokenize line p))
71
let read_pamheader channel =
72
(* The "P7" of the magic number is already read, the "\n" is not *)
73
let magic = input_line channel in
74
if magic<>"" then raise Invalid_PAM else
75
let rec parse_header ll =
76
match read_headerline channel with
77
None -> parse_header ll |
78
Some ["ENDHDR"] -> ll |
79
Some l -> parse_header (l::ll) in
80
let header = parse_header [] in
82
let line = List.find (function [] -> false | h::t -> h=token) header in
84
h::n::t -> int_of_string n in
85
let width = find_num "WIDTH" in
86
let height = find_num "HEIGHT" in
87
let depth = find_num "DEPTH" in
88
let maxval = find_num "MAXVAL" in
89
let tuple_type = List.fold_left
90
(function sofar -> (function
91
[token;value] -> if token="TUPLTYPE" then value^" "^sofar else sofar |
94
(width,height,depth,maxval,tuple_type)
98
let rec read_number channel =
99
let c = input_char channel in
100
if whitespace c then read_number channel else
101
let rec read_rest s =
102
let c = input_char channel in
103
if whitespace c then s else read_rest (s^(String.make 1 c)) in
104
int_of_string (read_rest (String.make 1 c))
106
let read_ppmheader channel =
107
let width = read_number channel in
108
let height = read_number channel in
109
let maxval = read_number channel in
110
(width,height,3,maxval,"")
112
let rec read_string channel num =
116
let c=input_char channel in
117
(String.make 1 c)^(read_string channel (num-1))
120
let rec loop bytes maxplus1 = if maxplus1>n
122
else loop (bytes+1) (maxplus1*256) in
125
let read_pam channel =
126
match (match read_string channel 2 with
127
"P7" -> read_pamheader channel |
128
"P6" -> read_ppmheader channel |
129
s -> raise Invalid_PAM)
130
with width,height,depth,maxval,tuple_type ->
131
let bytes = numbytes maxval in
132
let rec read_sample sample bytes =
135
else read_sample (sample*256+(input_byte channel)) (bytes-1) in
136
let read_sample u = read_sample 0 bytes in
137
((width,height,depth,maxval,
138
Array.init height (function y ->
139
Array.init width (function x ->
140
Array.init depth read_sample))),
145
let write_pam channel ((width,height,depth,maxval,data),tuple_type) =
146
let write_num token num =
147
output_string channel (token^" "^(string_of_int num)^"\n") in
148
let bytes = numbytes maxval in
149
let rec write_sample sample bytes =
152
else (write_sample (sample/256) (bytes-1);
153
output_byte channel (sample mod 256)) in
154
let write_sample sample = write_sample sample bytes in
155
output_string channel "P7\n";
156
write_num "WIDTH" width;
157
write_num "HEIGHT" height;
158
write_num "DEPTH" depth;
159
write_num "MAXVAL" maxval;
160
output_string channel ("TUPLTYPE "^tuple_type^"\n");
161
output_string channel "ENDHDR\n";
162
Array.iter (Array.iter (Array.iter write_sample)) data
166
let pam_channel p (width,height,depth,maxval,data) =
167
let rec outdepth sofar n = if n=depth
169
else outdepth (if p n then sofar+1 else sofar) (n+1) in
170
let outdepth = outdepth 0 0 in
171
let rec from_channel inn outn = if p inn
172
then if outn=0 then inn else from_channel (inn+1) (outn-1)
173
else from_channel (inn+1) outn in
174
let from_channel = from_channel 0 in
175
(width,height,outdepth,maxval,
176
Array.init height (function y ->
177
Array.init width (function x ->
178
Array.init outdepth (function n ->
179
data.(y).(x).(from_channel n)))))
183
let pam_stack (width1,height1,depth1,maxval1,data1)
184
(width2,height2,depth2,maxval2,data2) =
185
(width1,height1,depth1+depth2,maxval1,
186
Array.init height1 (function y ->
187
Array.init width1 (function x ->
188
Array.init (depth1+depth2) (function n ->
190
then data1.(y).(x).(n)
191
else data2.(y).(x).(n-depth1)))))
added
removed
datasrc/pics/pam.ml
