1 files changed, 64 insertions, 0 deletions
diff --git a/testsuite/tests/programs/galois_raytrace/Pixmap.hs b/testsuite/tests/programs/galois_raytrace/Pixmap.hs
new file mode 100644
index 0000000000..11d20f0df2
--- /dev/null
+++ b/testsuite/tests/programs/galois_raytrace/Pixmap.hs
@@ -0,0 +1,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"