initial import

.gitignore

@@ -0,0 +1,3 @@
+cabal-dev/
+dist/
+*~

Graphics/Formats/OFF/Simple.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | A simple datatype and parser for 3D OFF files. A single type is
+-- used for OFF information with or without color. Loosely based on
+-- <http://people.sc.fsu.edu/~jburkardt/data/off/off.html>, but uses the
+-- file header to determine whether the object's faces contain color
+-- values. 
+module Graphics.Formats.OFF.Simple (
+    OFF (..)
+  , Face (..)
+  , vertexCount
+  , faceCount
+  , hasColor
+  , parseOFF
+  , readOFFFile
+) where
+
+import Control.Applicative hiding ( (<|>), many, optional )
+
+import qualified Data.Vector as V
+import Data.Vector ( Vector )
+
+import Numeric
+
+import Text.Parsec
+import Text.Parsec.String ( Parser )
+
+-- | A vertex is just a triple of 'Double's.
+type Vertex = (Double, Double, Double)
+
+-- | A color is a 4-tuple of 'Double's representing RGB values.
+type Color = (Double, Double, Double)
+
+-- | A face is a vector of vertex indices and an optional color value.
+data Face = Face (Vector Int) (Maybe Color)
+            deriving (Show, Eq, Ord)
+
+-- | Representation of an object in OFF format; a pair of vectors
+-- containing the vertices and the faces of the object.
+data OFF = OFF { 
+                 vertices    :: Vector Vertex
+               , faces       :: Vector Face
+               }
+           deriving (Show, Eq, Ord)
+
+-- | The number of vertices in an 'OFF' object.
+vertexCount :: OFF -> Int
+vertexCount (OFF { vertices }) = V.length vertices
+
+-- | The number of faces in an 'OFF' object.
+faceCount :: OFF -> Int
+faceCount (OFF { faces }) = V.length faces
+
+-- | Returns 'True' if the 'OFF' object has color values associated
+-- with its faces.
+hasColor :: OFF -> Bool
+hasColor (OFF { faces }) =
+  case faces V.!? 0 of
+    Just (Face _ (Just _)) -> True
+    _ -> False
+
+-- | Determines whether we're handling color files.
+parseHeader :: Parser Bool
+parseHeader = string "OFF" *> (char 'C' *> return True
+                                       <|> return False)
+
+-- | Comments span from @#@ to the end of the line.
+parseComment :: Parser ()
+parseComment = char '#' >> manyTill anyChar newline >> return ()
+
+-- | Parse the vertex and face counts.
+parseCounts :: Parser (Int, Int)
+parseCounts = do
+    vc <- parseInt
+    spaces
+    fc <- parseInt
+    optional (many (oneOf "\t ") >> parseInt) -- edges ignored
+    return (vc, fc)
+  <?> "vertex, face, and edge count"
+
+-- | Parse a line of vertex coordinates.
+parseVertex :: Parser Vertex
+parseVertex = do
+    [x, y, z] <- count 3 (parseDouble <* spaces)
+    return (x, y, z)
+  <?> "x, y, z coordinates"
+
+-- | Parse the given number of vertex lines
+parseVertices :: Int -> Parser (Vector Vertex)
+parseVertices n = V.replicateM n (parseVertex <* eatWhitespace)
+  <?> show n ++ " vertices"
+
+-- | Parse a line of non-colored vertex indices defining a face.
+parseFace :: Parser Face
+parseFace = do
+    numVerts <- parseInt
+    spaces
+    verts <- V.replicateM numVerts (parseInt <* spaces)
+    return $ Face verts Nothing
+  <?> "vertex indices"
+
+-- | First parse the indices of a face, then parse three additional
+-- 'Double's representing the color value.
+parseFaceC :: Parser Face
+parseFaceC = do
+    (Face verts Nothing) <- parseFace
+    [r, g, b] <- count 3 (parseDouble <* spaces)
+    return $ Face verts (Just (r, g, b))
+  <?> "3 color components"
+
+-- | Parse the given number of non-colored faces.
+parseFaces :: Int -> Parser (Vector Face)
+parseFaces n = V.replicateM n (parseFace <* eatWhitespace)
+  <?> show n ++ " faces"
+
+-- | Parse the given number of colored faces.
+parseFacesC :: Int -> Parser (Vector Face)
+parseFacesC n = V.replicateM n (parseFaceC <* eatWhitespace)
+  <?> show n ++ " faces"
+
+-- | Parse a 'Text' string representing an OFF object.
+parseOFF :: Parser OFF
+parseOFF = do
+  eatWhitespace
+  isColor <- parseHeader
+  eatWhitespace
+  (numVerts, numFaces) <- parseCounts
+  eatWhitespace
+  verts <- parseVertices numVerts
+  eatWhitespace
+  faces <- if isColor
+           then parseFacesC numFaces
+           else parseFaces numFaces
+  eatWhitespace >> eof
+  return $ OFF verts faces
+
+-- | Read an OFF object from the given 'FilePath', returning either
+-- the corresponding 'OFF' value or a 'ParseError'.
+readOFFFile :: FilePath -> IO (Either ParseError OFF)
+readOFFFile f = parse parseOFF f <$> readFile f
+
+-- | Parse and discard whitespace and comments up until the next
+-- non-comment, non-whitespace character.
+eatWhitespace :: Parser ()
+eatWhitespace =  try (spaces >> parseComment >> eatWhitespace) 
+             <|> spaces 
+             <|> return ()
+
+-- | Parse an unsigned decimal 'Int'.
+parseInt :: Parser Int
+parseInt = do 
+  s <- getInput
+  case readDec s of
+    [(n, s')] -> n <$ setInput s'
+    _ -> empty
+
+-- | Parse a signed 'Double'.
+parseDouble :: Parser Double
+parseDouble = do 
+  s <- getInput
+  case readSigned readFloat s of
+    [(n, s')] -> n <$ setInput s'
+    _ -> empty
+

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c)2011, Adam C. Foltzer
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Adam C. Foltzer nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,4 @@
+## off-simple
+
+Two primary interfaces are exposed for reading `OFF` files; see
+haddock in `Graphics/Formats/OFF/Simple.hs` for details.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

off-simple.cabal

@@ -0,0 +1,31 @@
+Name:                off-simple
+Version:             0.1
+Synopsis:            A parser for simplified-syntax OFF files
+Description:         A simple datatype and parser for 3D OFF files, 
+                     loosely based on 
+                     <http://people.sc.fsu.edu/~jburkardt/data/off/off.html>, 
+                     but uses the file header to determine whether the object's
+                     faces contain color values. 
+License:             BSD3
+License-file:        LICENSE
+Author:              Adam C. Foltzer
+Maintainer:          acfoltzer@gmail.com
+Category:            Graphics
+Build-type:          Simple
+Cabal-version:       >=1.8
+Extra-source-files:  tests/Main.hs
+                     tests/TestData.hs
+                     tests/off-simple-tests.cabal
+                     tests/Setup.hs
+                     tests/samples/cube.off
+                     tests/samples/cube.offc
+                     tests/samples/dodec.off
+                     tests/samples/mushroom.off
+                     tests/samples/tetra.off
+                     tests/samples/tetra.offc
+
+Library
+  exposed-modules:   Graphics.Formats.OFF.Simple
+  build-depends:     base == 4.*,
+                     parsec3 == 1.*,
+                     vector == 0.9.*

tests/Main.hs

@@ -0,0 +1,51 @@
+module Main where
+
+import Graphics.Formats.OFF.Simple
+
+import Control.Arrow
+
+import Data.Vector ( Vector )
+import qualified Data.Vector as V
+
+import Test.HUnit ( assertFailure, (@?=) )
+import Test.Framework
+import Test.Framework.Providers.HUnit
+
+import System.FilePath
+
+import TestData
+
+samplePrefix = "samples"
+
+fileMatches :: FilePath -> OFF -> Test
+fileMatches file off = testCase file $ do
+  eoff <- readOFFFile (samplePrefix </> file)
+  case eoff of
+    Left err -> assertFailure (show err)
+    Right off' -> off' @?= off
+
+makeOFF :: ([(Double, Double, Double)], [[Int]]) -> OFF
+makeOFF (vs, fs) = 
+  OFF { vertices = V.fromList vs
+      , faces = V.map (flip Face Nothing) $ V.fromList (map V.fromList fs)
+      }
+
+makeOFFC :: ( [(Double, Double, Double)] 
+            , [([Int], (Double, Double, Double))])
+         -> OFF
+makeOFFC (vs, fs) =
+  OFF { vertices = V.fromList vs
+      , faces = V.map (uncurry Face) $ 
+                  V.fromList (map (first V.fromList . second Just) fs)
+      }
+
+tests = [ "cube.off" `fileMatches` makeOFF cubeData
+        , "cube.offc" `fileMatches` makeOFFC cubecData
+        , "dodec.off" `fileMatches` makeOFF dodecData
+        , "mushroom.off" `fileMatches` makeOFFC mushroomData
+        , "tetra.off" `fileMatches` makeOFF tetraData
+        , "tetra.offc" `fileMatches` makeOFFC tetracData
+        ]
+
+main :: IO ()
+main = defaultMain tests

tests/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

tests/off-simple-tests.cabal

@@ -0,0 +1,21 @@
+Name:                off-simple-tests
+Version:             0.1
+Synopsis:            Test suite for off-simple
+License:             BSD3
+License-file:        LICENSE
+Author:              Adam C. Foltzer
+Maintainer:          acfoltzer@gmail.com
+Category:            Testing
+Build-type:          Simple
+Cabal-version:       >=1.8
+
+Executable off-simple-tests
+  main-is:           Main.hs
+  build-depends:     base == 4.*,
+                     filepath == 1.2.*,
+                     HUnit == 1.2.*,
+                     test-framework == 0.4.*,
+                     test-framework-hunit == 0.2.*,
+                     vector == 0.9.*,
+                     off-simple
+  other-modules:     TestData

tests/samples/cube.off

@@ -0,0 +1,16 @@
+OFF
+8 6 12
+ 1.0   1.0   1.0
+-1.0   1.0   1.0
+-1.0  -1.0   1.0
+ 1.0  -1.0   1.0
+ 1.0   1.0  -1.0
+-1.0   1.0  -1.0
+-1.0  -1.0  -1.0
+ 1.0  -1.0  -1.0
+4  0 1 2 3
+4  7 6 5 4
+4  0 3 7 4
+4  3 2 6 7
+4  2 1 5 6
+4  0 4 5 1

tests/samples/cube.offc

@@ -0,0 +1,16 @@
+OFFC
+8 6 12
+ 1.0   1.0   1.0
+-1.0   1.0   1.0
+-1.0  -1.0   1.0
+ 1.0  -1.0   1.0
+ 1.0   1.0  -1.0
+-1.0   1.0  -1.0
+-1.0  -1.0  -1.0
+ 1.0  -1.0  -1.0
+4  0 1 2 3    1 0 0
+4  7 6 5 4    0 1 0
+4  0 3 7 4    0 0 1
+4  3 2 6 7    1 1 0
+4  2 1 5 6    1 0 1
+4  0 4 5 1    0 1 1

tests/samples/dodec.off

@@ -0,0 +1,35 @@
+# dodecahedron
+OFF
+20 12
+1.214124 0.000000 1.589309
+0.375185 1.154701 1.589309
+-0.982247 0.713644 1.589309
+-0.982247 -0.713644 1.589309
+0.375185 -1.154701 1.589309
+1.964494 0.000000 0.375185
+0.607062 1.868345 0.375185
+-1.589309 1.154701 0.375185
+-1.589309 -1.154701 0.375185
+0.607062 -1.868345 0.375185
+1.589309 1.154701 -0.375185
+-0.607062 1.868345 -0.375185
+-1.964494 0.000000 -0.375185
+-0.607062 -1.868345 -0.375185
+1.589309 -1.154701 -0.375185
+0.982247 0.713644 -1.589309
+-0.375185 1.154701 -1.589309
+-1.214124 0.000000 -1.589309
+-0.375185 -1.154701 -1.589309
+0.982247 -0.713644 -1.589309
+5 0 1 2 3 4
+5 0 5 10 6 1
+5 1 6 11 7 2
+5 2 7 12 8 3
+5 3 8 13 9 4
+5 4 9 14 5 0
+5 15 10 5 14 19
+5 16 11 6 10 15
+5 17 12 7 11 16
+5 18 13 8 12 17
+5 19 14 9 13 18
+5 19 18 17 16 15