blob: 11d20f0df2cde30aa199dad52d44ec68604f19b5 (
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
|
-- Copyright (c) 2000 Galois Connections, Inc.
-- All rights reserved. This software is distributed as
-- free software under the license in the file "LICENSE",
-- which is included in the distribution.
module Pixmap where
import Char
import IO hiding (try)
import Parsec
readPPM f
= do h <- openFile f ReadMode
s <- hGetContents h
case (parse parsePPM f s) of
Left err -> error (show err)
Right x -> return x
writePPM f ppm
= do h <- openFile f WriteMode
let s = showPPM (length (head ppm)) (length ppm) ppm
hPutStr h s
-- parsing
parsePPM
= do string "P6"
whiteSpace
width <- number
whiteSpace
height <- number
whiteSpace
colormax <- number
whiteSpace
cs <- getInput
return (chop width (chopColors cs))
chopColors [] = []
chopColors (a:b:c:ds) = (ord a, ord b, ord c) : chopColors ds
chop n [] = []
chop n xs = h : chop n t
where (h, t) = splitAt n xs
number
= do ds <- many1 digit
return (read ds :: Int)
whiteSpace
= skipMany (simpleSpace <|> oneLineComment <?> "")
where simpleSpace = skipMany1 (oneOf " \t\n\r\v")
oneLineComment =
do char '#'
skipMany (noneOf "\n\r\v")
return ()
-- printing
showPPM :: Int -> Int -> [[(Int,Int,Int)]] -> String
showPPM wid ht pss
= header ++ concat [[chr r, chr g, chr b] | ps <- pss, (r, g, b) <-ps]
where
header = "P6\n#Galois\n" ++ show wid ++ " " ++ show ht ++ "\n255\n"
showPPM _ _ _ = error "incorrect length of bitmap string"
|
