← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/hpc/tests/raytrace/Pixmap.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/hpc/tests/raytrace/Pixmap.hs
 
1
-- Copyright (c) 2000 Galois Connections, Inc.
 
2
-- All rights reserved.  This software is distributed as
 
3
-- free software under the license in the file "LICENSE",
 
4
-- which is included in the distribution.
 
5
 
 
6
module Pixmap where
 
7
 
 
8
import Char
 
9
import IO hiding (try)
 
10
import Parsec
 
11
 
 
12
readPPM f
 
13
  = do  h <- openFile f ReadMode
 
14
        s <- hGetContents h
 
15
        case (parse parsePPM f s) of
 
16
          Left err -> error (show err)
 
17
          Right x  -> return x
 
18
 
 
19
writePPM f ppm
 
20
  = do  h <- openFile f WriteMode
 
21
        let s = showPPM (length (head ppm)) (length ppm) ppm
 
22
        hPutStr h s
 
23
 
 
24
-- parsing
 
25
 
 
26
parsePPM
 
27
  = do  string "P6"
 
28
        whiteSpace
 
29
        width <- number
 
30
        whiteSpace
 
31
        height <- number
 
32
        whiteSpace
 
33
        colormax <- number
 
34
        whiteSpace
 
35
        cs <- getInput
 
36
        return (chop width (chopColors cs))
 
37
 
 
38
chopColors [] = []
 
39
chopColors (a:b:c:ds) = (ord a, ord b, ord c) : chopColors ds
 
40
 
 
41
chop n [] = []
 
42
chop n xs = h : chop n t
 
43
    where (h, t) = splitAt n xs
 
44
 
 
45
number
 
46
  = do  ds <- many1 digit
 
47
        return (read ds :: Int)
 
48
 
 
49
whiteSpace
 
50
  = skipMany (simpleSpace <|> oneLineComment <?> "")
 
51
    where simpleSpace = skipMany1 (oneOf " \t\n\r\v")    
 
52
          oneLineComment =
 
53
              do  char '#'
 
54
                  skipMany (noneOf "\n\r\v")
 
55
                  return ()
 
56
 
 
57
-- printing
 
58
 
 
59
showPPM :: Int -> Int -> [[(Int,Int,Int)]] -> String
 
60
showPPM wid ht pss
 
61
  = header ++ concat [[chr r, chr g, chr b] | ps <- pss, (r, g, b) <-ps]
 
62
  where
 
63
    header = "P6\n#Galois\n" ++ show wid ++ " " ++ show ht ++ "\n255\n"
 
64
showPPM _ _ _ = error "incorrect length of bitmap string"