Initial commit.

47 files changed, 4234 insertions, 0 deletions

diff --git a/src/Codec/Wavefront.hs b/src/Codec/Wavefront.hs
new file mode 100644
index 0000000..affec01
--- /dev/null
+++ b/src/Codec/Wavefront.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-- Currently, you can parse a file and get a 'WavefrontOBJ' with the 'fromFile'
+-- function.
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront (
+    -- * Vertex location
+    Location(..)
+    -- * Vertex texture coordinates
+  , TexCoord(..)
+    -- * Vertex normals
+  , Normal(..)
+    -- * Points
+  , Point(..)
+    -- * Lines
+  , Line(..)
+  , LineIndex(..)
+    -- * Faces
+  , Face(..)
+  , FaceIndex(..)
+  , pattern Triangle
+  , pattern Quad
+    -- * Element
+  , Element(..)
+    -- * Object
+  , WavefrontOBJ(..)
+    -- * Re-exports
+  , module Codec.Wavefront.IO
+  ) where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.IO
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Object
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
diff --git a/src/Codec/Wavefront/Element.hs b/src/Codec/Wavefront/Element.hs
new file mode 100644
index 0000000..846b603
--- /dev/null
+++ b/src/Codec/Wavefront/Element.hs
@@ -0,0 +1,29 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Element (
+    -- * Element
+    Element(..)
+  ) where
+
+import Data.Text ( Text )
+import Numeric.Natural ( Natural )
+
+-- |An element holds a value along with the user-defined object’s name (if any), the associated
+-- groups, the used material and the smoothing group the element belongs to (if any). Those values
+-- can be used to sort the data per object or per group and to lookup materials.
+data Element a = Element {
+    elObject :: Maybe Text
+  , elGroups :: [Text]
+  , elMtl :: Maybe Text
+  , elSmoothingGroup :: Natural
+  , elValue :: a
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Face.hs b/src/Codec/Wavefront/Face.hs
new file mode 100644
index 0000000..f055dd0
--- /dev/null
+++ b/src/Codec/Wavefront/Face.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Face where
+
+-- |A face index is a triplet of indices. @'FaceIndex' vi vti vni@ is a face that indexes the
+-- locations with @vi@, the texture coordinates with @vti@ and the normals with @vni@. An index set
+-- to 'Nothing' means /no information/. That is, if @vni == 'Nothing'@, then that 'FaceIndex'
+-- doesn’t have a normal associated with.
+data FaceIndex = FaceIndex {
+    faceLocIndex :: {-# UNPACK #-} !Int
+  , faceTexCoordIndex :: !(Maybe Int)
+  , faceNorIndex :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- |A face gathers several 'FaceIndex' to build up faces. It has a least three vertices
+data Face = Face FaceIndex FaceIndex FaceIndex [FaceIndex] deriving (Eq,Show)
+
+pattern Triangle :: FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Triangle a b c = Face a b c []
+
+pattern Quad :: FaceIndex -> FaceIndex -> FaceIndex -> FaceIndex -> Face
+pattern Quad a b c d = Face a b c [d]
diff --git a/src/Codec/Wavefront/IO.hs b/src/Codec/Wavefront/IO.hs
new file mode 100644
index 0000000..2bcf2b3
--- /dev/null
+++ b/src/Codec/Wavefront/IO.hs
@@ -0,0 +1,22 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.IO where
+
+import Codec.Wavefront.Lexer ( lexer )
+import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ )
+import Codec.Wavefront.Token ( tokenize )
+import Control.Monad.IO.Class ( MonadIO(..) )
+import qualified Data.Text.IO as T ( readFile )
+
+-- |Extract a 'WavefrontOBJ' from a Wavefront OBJ formatted file.
+fromFile :: (MonadIO m) => FilePath -> m (Either String WavefrontOBJ)
+fromFile fd = liftIO $ fmap (fmap (ctxtToWavefrontOBJ . lexer) . tokenize) (T.readFile fd)
diff --git a/src/Codec/Wavefront/Lexer.hs b/src/Codec/Wavefront/Lexer.hs
new file mode 100644
index 0000000..79b167a
--- /dev/null
+++ b/src/Codec/Wavefront/Lexer.hs
@@ -0,0 +1,106 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Lexer where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.Token
+import Codec.Wavefront.TexCoord
+import Data.DList ( DList, append, empty, fromList, snoc )
+import Data.Text ( Text )
+import Control.Monad.State ( State, execState, gets, modify )
+import Data.Foldable ( traverse_ )
+import Numeric.Natural ( Natural )
+
+-- |The lexer context. The result of lexing a stream of tokens is this exact type.
+data Ctxt = Ctxt {
+    -- |Locations.
+    ctxtLocations :: DList Location
+    -- |Texture coordinates.
+  , ctxtTexCoords :: DList TexCoord
+    -- |Normals.
+  , ctxtNormals :: DList Normal
+    -- |Points.
+  , ctxtPoints :: DList (Element Point)
+    -- |Lines.
+  , ctxtLines :: DList (Element Line)
+    -- |Faces.
+  , ctxtFaces :: DList (Element Face)
+    -- |Current object.
+  , ctxtCurrentObject :: Maybe Text
+    -- |Current groups.
+  , ctxtCurrentGroups :: [Text]
+    -- |Current material.
+  , ctxtCurrentMtl :: Maybe Text
+    -- |Material libraries.
+  , ctxtMtlLibs :: DList Text
+    -- |Current smoothing group.
+  , ctxtCurrentSmoothingGroup :: Natural
+  } deriving (Eq,Show)
+
+-- |The empty 'Ctxt'. Such a context exists at the beginning of the token stream and gets altered
+-- as we consume tokens.
+emptyCtxt :: Ctxt 
+emptyCtxt = Ctxt {
+    ctxtLocations = empty
+  , ctxtTexCoords = empty
+  , ctxtNormals = empty
+  , ctxtPoints = empty
+  , ctxtLines = empty
+  , ctxtFaces = empty
+  , ctxtCurrentObject = Nothing
+  , ctxtCurrentGroups = ["default"]
+  , ctxtCurrentMtl = Nothing
+  , ctxtMtlLibs = empty
+  , ctxtCurrentSmoothingGroup = 0
+  }
+
+-- |The lexer function, consuming tokens and yielding a 'Ctxt'.
+lexer :: TokenStream -> Ctxt
+lexer stream = execState (traverse_ consume stream) emptyCtxt
+  where
+    consume tk = case tk of
+      TknV v -> do
+        locations <- gets ctxtLocations
+        modify $ \ctxt -> ctxt { ctxtLocations = locations `snoc` v }
+      TknVN vn -> do
+        normals <- gets ctxtNormals
+        modify $ \ctxt -> ctxt { ctxtNormals = normals `snoc` vn }
+      TknVT vt -> do
+        texCoords <- gets ctxtTexCoords
+        modify $ \ctxt -> ctxt { ctxtTexCoords = texCoords `snoc` vt }
+      TknP p -> do
+        (pts,element) <- prepareElement ctxtPoints
+        modify $ \ctxt -> ctxt { ctxtPoints = pts `append` fmap element (fromList p) }
+      TknL l -> do
+        (lns,element) <- prepareElement ctxtLines
+        modify $ \ctxt -> ctxt { ctxtLines = lns `append` fmap element (fromList l) }
+      TknF f -> do
+        (fcs,element) <- prepareElement ctxtFaces
+        modify $ \ctxt -> ctxt { ctxtFaces = fcs `snoc` element f }
+      TknG g -> modify $ \ctxt -> ctxt { ctxtCurrentGroups = g }
+      TknO o -> modify $ \ctxt -> ctxt { ctxtCurrentObject = Just o }
+      TknMtlLib l -> do
+        libs <- gets ctxtMtlLibs
+        modify $ \ctxt -> ctxt { ctxtMtlLibs = libs `append` fromList l }
+      TknUseMtl mtl -> modify $ \ctxt -> ctxt { ctxtCurrentMtl = Just mtl }
+      TknS sg -> modify $ \ctxt -> ctxt { ctxtCurrentSmoothingGroup = sg }
+
+-- Prepare to create a new 'Element' by retrieving its associated list.
+prepareElement :: (Ctxt -> DList (Element a)) -> State Ctxt (DList (Element a),a -> Element a)
+prepareElement field = do
+  (aList,obj,grp,mtl,sg) <- gets $ (\ctxt -> (field ctxt,ctxtCurrentObject ctxt,ctxtCurrentGroups ctxt,ctxtCurrentMtl ctxt,ctxtCurrentSmoothingGroup ctxt))
+  pure (aList,Element obj grp mtl sg)
diff --git a/src/Codec/Wavefront/Line.hs b/src/Codec/Wavefront/Line.hs
new file mode 100644
index 0000000..d44e9e2
--- /dev/null
+++ b/src/Codec/Wavefront/Line.hs
@@ -0,0 +1,26 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Line where
+
+-- |A line index is a pair of indices. @'LineIndex' vi vti@. @vi@ references the locations and @vti@
+-- indexes the texture coordinates. If @vti == 'Nothing'@, then that 'LineIndex' doesn’t have
+-- texture coordinates associated with.
+data LineIndex = LineIndex {
+    lineLocIndex :: {-# UNPACK #-} !Int
+  , lineTexCoordIndex :: !(Maybe Int)
+  } deriving (Eq,Show)
+
+-- A line gathers two line indices accessible by pattern matching or 'lineIndexA' and 'lineIndexB'.
+data Line = Line {
+    lineIndexA :: LineIndex
+  , lineIndexB :: LineIndex
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Location.hs b/src/Codec/Wavefront/Location.hs
new file mode 100644
index 0000000..abdbc6a
--- /dev/null
+++ b/src/Codec/Wavefront/Location.hs
@@ -0,0 +1,26 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Location where
+
+-- |A location is a 4-floating vector. You can access to its components by pattern matching on them:
+--
+-- @
+--   let Location x y z w = Location 1 2 3 4
+-- @
+--
+-- That type is strict and unboxed.
+data Location = Location {
+    locX :: {-# UNPACK #-} !Float
+  , locY :: {-# UNPACK #-} !Float
+  , locZ :: {-# UNPACK #-} !Float
+  , locW :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Normal.hs b/src/Codec/Wavefront/Normal.hs
new file mode 100644
index 0000000..adf6221
--- /dev/null
+++ b/src/Codec/Wavefront/Normal.hs
@@ -0,0 +1,25 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Normal where
+
+-- |A normal is a 3-floating vector. You can access to its components by pattern matching on them:
+--
+-- @
+--   let Normal nx ny nz = Normal 0.1 0.2 0.3
+-- @
+--
+-- That type is strict and unboxed.
+data Normal = Normal {
+    norX :: {-# UNPACK #-} !Float
+  , norY :: {-# UNPACK #-} !Float
+  , norZ :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/Object.hs b/src/Codec/Wavefront/Object.hs
new file mode 100644
index 0000000..15557fe
--- /dev/null
+++ b/src/Codec/Wavefront/Object.hs
@@ -0,0 +1,55 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Object where
+
+import Codec.Wavefront.Element
+import Codec.Wavefront.Face
+import Codec.Wavefront.Lexer ( Ctxt(..) )
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
+import Data.DList ( DList, toList )
+import Data.Text ( Text )
+import Data.Vector ( Vector, fromList )
+
+data WavefrontOBJ = WavefrontOBJ {
+    -- |Locations.
+    objLocations :: Vector Location
+    -- |Texture coordinates.
+  , objTexCoords :: Vector TexCoord
+    -- |Normals.
+  , objNormals :: Vector Normal
+    -- |Points.
+  , objPoints :: Vector (Element Point)
+    -- |Lines.
+  , objLines :: Vector (Element Line)
+    -- |Faces.
+  , objFaces :: Vector (Element Face)
+    -- |Material libraries.
+  , objMtlLibs :: Vector Text
+  } deriving (Eq,Show)
+
+ctxtToWavefrontOBJ :: Ctxt -> WavefrontOBJ
+ctxtToWavefrontOBJ ctxt = WavefrontOBJ {
+    objLocations = fromDList (ctxtLocations ctxt)
+  , objTexCoords = fromDList (ctxtTexCoords ctxt)
+  , objNormals = fromDList (ctxtNormals ctxt)
+  , objPoints = fromDList (ctxtPoints ctxt)
+  , objLines = fromDList (ctxtLines ctxt)
+  , objFaces = fromDList (ctxtFaces ctxt)
+  , objMtlLibs = fromDList (ctxtMtlLibs ctxt)
+  }
+
+fromDList :: DList a -> Vector a
+fromDList = fromList . toList
diff --git a/src/Codec/Wavefront/Point.hs b/src/Codec/Wavefront/Point.hs
new file mode 100644
index 0000000..698aeca
--- /dev/null
+++ b/src/Codec/Wavefront/Point.hs
@@ -0,0 +1,18 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Point where
+
+-- |A point is a single index that references the locations. It’s a canonical type that truly
+-- represents a polygonal point.
+data Point = Point {
+    pointLocIndex :: {-# UNPACK #-} !Int
+  } deriving (Eq,Show)
diff --git a/src/Codec/Wavefront/TexCoord.hs b/src/Codec/Wavefront/TexCoord.hs
new file mode 100644
index 0000000..02e5c5a
--- /dev/null
+++ b/src/Codec/Wavefront/TexCoord.hs
@@ -0,0 +1,27 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.TexCoord where
+
+-- |A texture coordinate is a 3D-floating vector. You can access to its components by pattern
+-- matching on them:
+--
+-- @
+--   let TexCoord r s t = TexCoord 0.1 0.2 0.3
+-- @
+--
+-- That type is strcit and unboxed.
+data TexCoord = TexCoord {
+    texcoordR :: {-# UNPACK #-} !Float
+  , texcoordS :: {-# UNPACK #-} !Float
+  , texcoordT :: {-# UNPACK #-} !Float
+  } deriving (Eq,Show)
+
diff --git a/src/Codec/Wavefront/Token.hs b/src/Codec/Wavefront/Token.hs
new file mode 100644
index 0000000..76540c9
--- /dev/null
+++ b/src/Codec/Wavefront/Token.hs
@@ -0,0 +1,239 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   : (C) 2015 Dimitri Sabadie
+-- License     : BSD3
+--
+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
+-- Stability   : experimental
+-- Portability : portable
+--
+-----------------------------------------------------------------------------
+
+module Codec.Wavefront.Token where
+
+import Codec.Wavefront.Face
+import Codec.Wavefront.Line
+import Codec.Wavefront.Location
+import Codec.Wavefront.Normal
+import Codec.Wavefront.Point
+import Codec.Wavefront.TexCoord
+import Control.Applicative ( Alternative(..) )
+import Data.Attoparsec.Text as AP
+import Data.Char ( isSpace )
+import Data.Maybe ( catMaybes )
+import Data.Text ( Text, unpack, strip )
+import qualified Data.Text as T ( empty )
+import Numeric.Natural ( Natural )
+import Prelude hiding ( lines )
+
+----------------------------------------------------------------------------------------------------
+-- Token -------------------------------------------------------------------------------------------
+
+data Token
+  = TknV Location
+  | TknVN Normal
+  | TknVT TexCoord
+  | TknP [Point]
+  | TknL [Line]
+  | TknF Face
+  | TknG [Text]
+  | TknO Text
+  | TknMtlLib [Text]
+  | TknUseMtl Text
+  | TknS Natural
+    deriving (Eq,Show)
+
+-- |A stream of 'Token'.
+type TokenStream = [Token]
+
+tokenize :: Text -> Either String TokenStream
+tokenize = fmap cleanupTokens . analyseResult False . parse (untilEnd tokenizer)
+  where
+    tokenizer = choice
+      [
+        fmap (Just . TknV) location
+      , fmap (Just . TknVN) normal
+      , fmap (Just . TknVT) texCoord
+      , fmap (Just . TknP) points
+      , fmap (Just . TknL) lines
+      , fmap (Just . TknF) face
+      , fmap (Just . TknG) groups
+      , fmap (Just . TknO) object
+      , fmap (Just . TknMtlLib) mtllib
+      , fmap (Just . TknUseMtl) usemtl
+      , fmap (Just . TknS) smoothingGroup
+      , Nothing <$ comment
+      ]
+
+analyseResult :: Bool -> Result [Maybe Token] -> Either String [Maybe Token]
+analyseResult partial r = case r of
+  Done _ tkns -> Right tkns
+  Fail i _ e -> Left $ "`" ++ Prelude.take 10 (unpack i) ++ "` [...]: " ++ e
+  Partial p -> if partial then Left "not completely tokenized" else analyseResult True (p T.empty)
+
+cleanupTokens :: [Maybe Token] -> TokenStream
+cleanupTokens = catMaybes
+
+----------------------------------------------------------------------------------------------------
+-- Location ----------------------------------------------------------------------------------------
+
+location :: Parser Location
+location = skipSpace *> string "v " *> skipHSpace *> parseXYZW <* eol
+  where
+    parseXYZW = do
+      xyz <- float `sepBy1` skipHSpace
+      case xyz of
+        [x,y,z] -> pure (Location x y z 1)
+        [x,y,z,w] -> pure (Location x y z w)
+        [x,y,z,w,r,g] -> pure (Location x y z w) -- TODO: RG-colorspace
+        [x,y,z,w,r,g,b] -> pure (Location x y z w) -- TODO: RGB-colorspace
+        _ -> fail "wrong number of x, y and z arguments for location"
+
+----------------------------------------------------------------------------------------------------
+-- Normal ------------------------------------------------------------------------------------------
+
+normal :: Parser Normal
+normal = skipSpace *> string "vn " *> skipHSpace *> parseIJK <* eol
+  where
+    parseIJK = do
+      ijk <- float `sepBy1` skipHSpace
+      case ijk of
+        [i,j,k] -> pure (Normal i j k)
+        _ -> fail "wrong number of i, j and k arguments for normal"
+
+----------------------------------------------------------------------------------------------------
+-- Texture coordinates -----------------------------------------------------------------------------
+
+texCoord :: Parser TexCoord
+texCoord = skipSpace *> string "vt " *> skipHSpace *> parseUVW <* eol
+  where
+    parseUVW = do
+      uvw <- float `sepBy1` skipHSpace
+      case uvw of
+        [u,v] -> pure (TexCoord u v 0)
+        [u,v,w] -> pure (TexCoord u v w)
+        _ -> fail "wrong number of u, v and w arguments for texture coordinates"
+
+----------------------------------------------------------------------------------------------------
+-- Points ------------------------------------------------------------------------------------------
+
+points :: Parser [Point]
+points = skipSpace *> string "p " *> skipHSpace *> fmap Point decimal `sepBy1` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Lines -------------------------------------------------------------------------------------------
+lines :: Parser [Line]
+lines = do
+    skipSpace
+    _ <- string "l "
+    skipHSpace
+    pointIndices <- parsePointIndices
+    pts <- case pointIndices of
+      _:_:_ -> pure $ zipWith Line pointIndices (tail pointIndices)
+      _ -> fail "line doesn't have at least two points"
+    eol
+    pure pts
+  where
+    parsePointIndices = fmap (\(i,j) -> LineIndex i j) parseLinePair `sepBy1` skipHSpace
+    parseLinePair = do
+      v <- decimal
+      slashThenElse (fmap (\vt -> (v, Just vt)) decimal) (pure (v,Nothing))
+
+----------------------------------------------------------------------------------------------------
+-- Faces -------------------------------------------------------------------------------------------
+face :: Parser Face
+face = do
+    skipSpace
+    _ <- string "f "
+    skipHSpace
+    faceIndices <- parseFaceIndices
+    f <- case faceIndices of
+      a:b:c:s -> pure (Face a b c s)
+      _ -> fail "face doesn't have at least three points"
+    eol
+    pure f
+  where
+    parseFaceIndices = fmap (\(i,k,j) -> FaceIndex i k j) parseFaceTriple `sepBy1` skipHSpace
+    parseFaceTriple = do
+      v <- decimal
+      slashThenElse (parseVT v) (pure (v,Nothing,Nothing))
+    parseVT v = slashThenElse (parseVN v Nothing) $ do
+      vt <- decimal
+      slashThenElse (parseVN v $ Just vt) (pure (v,Just vt,Nothing))
+    parseVN v vt = do
+      vn <- decimal
+      pure (v,vt,Just vn)
+
+----------------------------------------------------------------------------------------------------
+-- Groups ------------------------------------------------------------------------------------------
+
+groups :: Parser [Text]
+groups = skipSpace *> string "g " *> skipHSpace *> name `sepBy` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Objects -----------------------------------------------------------------------------------------
+
+object :: Parser Text
+object = skipSpace *> string "o " *> skipHSpace *> spacedName <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Material libraries ------------------------------------------------------------------------------
+
+mtllib :: Parser [Text]
+mtllib = skipSpace *> string "mtllib " *> skipHSpace *> name `sepBy1` skipHSpace <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Using materials ---------------------------------------------------------------------------------
+
+usemtl :: Parser Text
+usemtl = skipSpace *> string "usemtl " *> skipHSpace *> spacedName <* eol
+
+----------------------------------------------------------------------------------------------------
+-- Smoothing groups --------------------------------------------------------------------------------
+smoothingGroup :: Parser Natural
+smoothingGroup = skipSpace *> string "s " *> skipHSpace *> offOrIndex <* skipHSpace <* eol
+  where
+    offOrIndex = string "off" *> pure 0 <|> decimal
+
+----------------------------------------------------------------------------------------------------
+-- Comments ----------------------------------------------------------------------------------------
+comment :: Parser ()
+comment = skipSpace *> string "#" *> (() <$ manyTill anyChar eol)
+
+----------------------------------------------------------------------------------------------------
+-- Special parsers ---------------------------------------------------------------------------------
+
+-- Read a slash ('/') and run the @thenP@ parser on success. Otherwise, call the @elseP@ parser.
+slashThenElse :: Parser a -> Parser a -> Parser a
+slashThenElse thenP elseP = do
+  c <- peekChar
+  case c of
+    Just '/' -> AP.take 1 *> thenP
+    _ -> elseP
+
+-- End of line.
+eol :: Parser ()
+eol = skipMany (satisfy isHorizontalSpace) *> (endOfLine <|> endOfInput)
+
+-- Parse a name (any character but space).
+name :: Parser Text
+name = takeWhile1 $ not . isSpace
+
+spacedName :: Parser Text
+spacedName = strip <$> AP.takeWhile (flip notElem ("\n\r" :: String))
+
+skipHSpace :: Parser ()
+skipHSpace = () <$ AP.takeWhile isHorizontalSpace
+
+float :: Parser Float
+float = fmap realToFrac double
+
+-- Loop a parser and collect its values until we hit the end of the stream. Fails on the first
+-- failure.
+untilEnd :: Parser a -> Parser [a]
+untilEnd p = go
+  where
+    go = do
+      a <- p
+      end <- atEnd
+      if end then pure [a] else fmap (a:) go
diff --git a/src/Graphics/Formats/Collada/ColladaTypes.hs b/src/Graphics/Formats/Collada/ColladaTypes.hs
new file mode 100644
index 0000000..ad78aa8
--- /dev/null
+++ b/src/Graphics/Formats/Collada/ColladaTypes.hs
@@ -0,0 +1,286 @@
+-- some of the Types are from http://hackage.haskell.org/package/GPipe-Collada

+-- adopted for possible future combination

+

+module Graphics.Formats.Collada.ColladaTypes

+(

+    Scene(..),

+    SceneNode(..), NodeType(..),

+    Transform(..),

+    Camera(..),

+    ViewSize(..),

+    Z(..),

+    

+    Light(..),

+    Attenuation(..),

+    Controller(..),

+    

+    Geometry(..),

+    Mesh(..),

+    Vertices(..),

+    LinePrimitive(..), Polygon(..),

+        -- Polylist(..), Spline(..), TriangleMesh(..), TriFan(..), TriStrip(..),

+    AnimChannel(..),

+    ID, SID,

+    Semantic,

+    Profile(..), NewParam(..), TechniqueCommon(..), Material, Effect,

+    C(..), Color(..),

+    Animation(..),

+    Fx_common_color_type(..), Fx_common_texture_type(..), Texture(..),

+        Interpolation(..),

+)

+where

+

+import Data.Tree

+import Data.Vector

+import Graphics.Rendering.OpenGL (TextureObject)

+import Graphics.Formats.Collada.Vector2D3D (V3(..), V4(..))

+

+type Mat44 = ((Float,Float,Float,Float),

+              (Float,Float,Float,Float),

+                          (Float,Float,Float,Float),

+                          (Float,Float,Float,Float))

+

+type Scene = Tree SceneNode

+

+data SceneNode = SceneNode {

+                nodeId :: ID,

+                nodeType :: NodeType,

+                nodeLayers :: [String],

+                nodeTransformations :: [(SID, Transform)],

+                nodeCameras :: [Camera],

+                nodeController :: [Controller],

+                nodeGeometries :: [Geometry],

+                nodeLights :: [Light]

+              } | EmptyRoot

+              deriving (Show, Eq)

+

+

+data NodeType = JOINT | NODE | NOTYPE deriving (Show, Eq)

+

+data Transform = LookAt {

+                    lookAtEye:: V3,

+                    lookAtInterest :: V3,

+                    lookAtUp :: V3

+                 }

+               | Matrix Mat44

+               | Rotate V3 Float V3 Float V3 Float

+               | Scale V3

+               | Skew {

+                    skewAngle :: Float,

+                    skewRotation :: V3,

+                    skewTranslation :: V3

+                 }

+               | Translate V3

+               deriving (Show, Eq)

+

+data Camera = Perspective {

+                perspectiveID :: ID,

+                perspectiveFov :: ViewSize,

+                perspectiveZ :: Z

+              }

+            | Orthographic {

+                orthographicID :: ID,

+                orthographicViewSize :: ViewSize,

+                orthographicZ :: Z

+              }

+              deriving (Show, Eq)

+

+data ViewSize = ViewSizeX Float

+              | ViewSizeY Float

+              | ViewSizeXY (Float,Float)

+              deriving (Show, Eq)

+

+data Z = Z { 

+            zNear :: Float, 

+            zFar :: Float

+           }

+           deriving (Show, Eq)

+

+data Light = Ambient {

+                ambientID :: ID,

+                ambientColor :: Color

+             }

+           | Directional {

+                directionalID :: ID,

+                directionalColor :: Color

+             }

+           | Point {

+                pointID :: ID,

+                pointColor :: Color,

+                pointAttenuation :: Attenuation

+             }

+           | Spot {

+                spotID :: ID,

+                spotColor :: Color,

+                spotAttenuation :: Attenuation,

+                spotFallOffAngle :: Float,

+                spotFallOffExponent :: Float

+             }

+              deriving (Show, Eq)

+

+data Attenuation = Attenuation {

+                attenuationConstant :: Float,

+                attenuationLinear :: Float,

+                attenuationQuadratic :: Float

+            }

+              deriving (Show, Eq)

+

+data Controller = Controller {

+                contrId :: ID,

+                skin :: [Skin],

+                morph :: [Morph]

+            }

+              deriving (Show, Eq)

+

+data Skin = Skin {

+                bindShapeMatrix :: [Mat44],

+                source :: [String],

+                joint :: [Joint],

+                vertexWeights :: String

+            }

+              deriving (Show, Eq)

+

+data Morph = Morph {

+                geometrySource :: String,

+                method :: MorphMethod,

+                morphSource :: String,

+                morphTargets :: [Input]

+            }

+              deriving (Show, Eq)

+

+data MorphMethod = Normalized | Relative deriving (Show, Eq)

+

+data Joint = Joint {

+                jointID :: String,

+                prismatic :: Prismatic,

+                revolute :: Revolute

+            }

+              deriving (Show, Eq)

+

+type Prismatic = String

+type Revolute = String

+

+data Input = Input {

+                offset :: Int,

+                semantic :: Semantic,

+                inputSource :: String,

+                set :: Int

+            }

+              deriving (Show, Eq)

+

+data Semantic = BINORMAL | COLOR | CONTINUITY | IMAGE | INPUT | IN_TANGENT | INTERPOLATION |

+                INV_BIND_MATRIX | ISJOINT | LINEAR_STEPS | MORPH_TARGET | MORPH_WEIGHT |

+                NORMAL | OUTPUT | OUT_TANGENT | POSITION | TANGENT | TEXBINORMAL |

+                TEXCOORD | TEXTANGENT | UV | VERTEX | WEIGHT

+                deriving (Show, Eq)

+

+data Geometry = Geometry {

+                meshID :: ID,

+                mesh :: [Mesh],

+                vertices :: Vertices

+--                convexMesh :: [Mesh],

+--                splines :: [Spline],

+--                breps :: [Brep]

+            }

+            deriving (Show)

+

+instance Eq Geometry where

+  (Geometry mid1 _ _) == (Geometry mid2 _ _) = mid1 == mid2

+

+data Mesh = LP LinePrimitive | -- ^Lines

+            LS LinePrimitive | -- ^LineStrips

+            P Polygon | -- ^Polygon: Contains polygon primitives which may contain holes.

+            PL LinePrimitive | -- ^PolyList: Contains polygon primitives that cannot contain holes.

+            Tr LinePrimitive | -- ^Triangles

+            Trf LinePrimitive | -- ^TriFans

+            Trs LinePrimitive | -- ^TriStrips

+            S LinePrimitive -- ^Splines

+            deriving (Show, Eq)

+

+data Vertices = Vertices {

+                  name :: ID,

+                  verts :: Vector V3,

+                  normals :: Vector V3

+            }

+            deriving (Show, Eq)

+

+data LinePrimitive = LinePrimitive {

+                lineP :: Vector (Vector Int), -- point indices

+                lineN :: Vector (Vector Int), -- normal indices

+                lineT :: Vector (Vector Int), -- texture indices

+                ms :: [Material]

+            }

+            deriving (Show, Eq)

+

+data Polygon = Polygon {

+                poylgonP :: Vector (Vector Int),

+                poylgonN :: Vector (Vector Int),

+                polygonPh :: (Vector Int, Vector Int), -- (indices, indices of a hole)

+                polygonMs :: [Material]

+            }

+            deriving (Show, Eq)

+

+type Material = (SID,Effect)

+

+type Effect = Profile

+

+type Animation = Tree (SID, AnimChannel)

+

+data AnimChannel = AnimChannel {

+                     input :: (ID,[Float],Accessor) , -- Accessor: i.e. "TIME"

+                     output :: (ID,[Float],Accessor),

+                     interp :: [Interpolation],

+                     -- target channels in Collada

+                     targets :: [(TargetID,AccessorName)] -- transfer values to several objects

+                   } | EmptyAnim

+                   deriving (Show, Eq)

+

+data Interpolation = Step | Linear | Bezier [Float] [Float] deriving (Show, Eq)

+

+type TargetID = String

+type Accessor = [[(AccessorName, AccessorType)]]

+type AccessorName = String

+type AccessorType = String

+

+data Profile = BRIDGE Asset Extra |

+               CG Asset Code Include NewParam TechniqueCG Extra |

+               COMMON Asset NewParam TechniqueCommon String |

+               GLES Asset NewParam TechniqueCG Extra |

+               GLES2 Asset Code Include NewParam TechniqueCG Extra |

+               GLSL Asset Code Include NewParam TechniqueCG Extra

+                           deriving (Show, Eq)

+

+type Asset = String

+type Code = String

+type Include = String

+data NewParam = Annotat | Semantic | Modifier | NoParam deriving (Show, Eq)

+data TechniqueCommon = Constant | LambertCol [Fx_common_color_type]

+                                | LambertTex [Fx_common_texture_type] [[Float]]

+                                | PhongCol [Fx_common_color_type]

+                                | PhongTex [Fx_common_texture_type] [[Float]]

+                                | Blinn

+                                deriving (Show, Eq)

+data TechniqueCG = IsAsset | IsAnnotate | Pass | Extra deriving (Show, Eq)

+data Extra = String deriving (Show, Eq) -- Asset | Technique

+data Technique = Profile deriving (Show, Eq) -- XML -- | Xmlns Schema

+data Fx_common_color_type = CEmission C | CAmbient C | CDiffuse C | CSpecular C |

+                            CShininess Float | CReflective C | CReflectivity Float |

+                            CTransparent C | CTransparency Float | CIndex_of_refraction Float

+                            deriving (Show, Eq)

+data Fx_common_texture_type = TEmission Texture | TAmbient Texture | TDiffuse Texture | TSpecular Texture |

+                              TShininess Float | TReflective Texture | TReflectivity Float |

+                              TTransparent Texture | TTransparency Float | TIndex_of_refraction Float

+                              deriving (Show, Eq)

+data C = Color V4 deriving (Show, Eq)

+

+data Texture = Texture {

+                   imageSID :: ID,

+                   path :: String, -- ToDo: better type

+                   texObj :: Maybe TextureObject -- force evalaution to generate a font cache

+            }

+            deriving (Show, Eq)

+

+type ID = String

+type SID = String -- Maybe

+

+data Color = RGB Float Float Float deriving (Eq, Show)

diff --git a/src/Graphics/Formats/Collada/GenerateObjects.hs b/src/Graphics/Formats/Collada/GenerateObjects.hs
new file mode 100644
index 0000000..c1dcae7
--- /dev/null
+++ b/src/Graphics/Formats/Collada/GenerateObjects.hs
@@ -0,0 +1,285 @@
+module Graphics.Formats.Collada.GenerateObjects

+where

+

+import Data.Enumerable

+import Data.Tree

+import Data.Tuple.Enum

+import Data.Word

+import qualified Data.Vector as V

+import Data.Vector (Vector)

+import Graphics.Formats.Collada.ColladaTypes

+import Graphics.Formats.Collada.Vector2D3D

+

+-- type Scene = Tree SceneNode

+n x = Node x []

+makeScene sid sceneNodes = Node (SceneNode sid NOTYPE [] tranrot [] [] [] []) (map n sceneNodes)

+

+-- | An animated cube

+animatedCube :: (Scene, [Animation])

+animatedCube = (aScene, animation)

+

+-- | Example scene with a cube

+aScene :: Scene

+aScene = makeScene "aCube" (cameraAndLight ++ [aCube])

+

+lightedGeometry :: [Geometry] -> Scene

+lightedGeometry g = makeScene "g" (cameraAndLight ++ (map ge g))

+

+lightedSceneNode :: SceneNode -> Scene

+lightedSceneNode node = makeScene "node" (cameraAndLight ++ [node])

+

+lightedScene :: Scene -> Scene

+lightedScene node = Node EmptyRoot ((map n cameraAndLight) ++ [node])

+

+-- | Every scene needs a camera and light

+cameraAndLight = [ aCamera,

+                   pointLight "pointLight" 3 4 10,

+                   pointLight "pointL" (-500) 1000 400 ]

+

+rot x y z = Rotate (V3 1 0 0) x

+                   (V3 0 1 0) y

+                   (V3 0 0 1) z

+

+tranrot = [ ("tran", Translate (V3 0 0 0)), ("rot", rot 0 0 0) ] -- there have to be values for an animation channel to access

+

+aCamera = SceneNode "camera0" NOTYPE []

+                       [("tran", Translate (V3 1000 2000 2500)),

+                         ("rot", rot (-22) 13 0)]

+                       -- [("lookat", LookAt (1000,1000,2500) (0,0,0) (0,1,0))]

+                       [(Perspective "Persp" (ViewSizeXY (37,37)) (Z 10 1000) )]

+                       [] [] []

+

+pointLight str x y z = SceneNode str NOTYPE []

+                         [("tran", Translate (V3 x y z)),

+                          ("rot", rot 0 0 0)]

+                         [] [] []

+                         [(Point "point" (RGB 1 1 1) (Attenuation 1 0 0) )]

+

+ambientLight = SceneNode "ambientLight" NOTYPE []

+                         [("tran", Translate (V3 (-500) 1000 400)),

+                          ("rot", rot 0 0 0)]

+                         [] [] []

+                         [(Ambient "ambient" (RGB 1 1 1) )]

+

+aCube :: SceneNode

+aCube = SceneNode "cube_geometry" NOTYPE [] tranrot [] [] [cube] []

+

+obj :: String -> [Geometry] -> V3 -> SceneNode

+obj name c tr = SceneNode name NOTYPE []

+                         [("tran", Translate tr),

+                          ("rot", rot 0 0 0)]

+                         [] []

+                         c -- geometries

+                         []

+

+-- | Example animation of the cube

+animation :: [Animation]

+animation = [Node ("cube_rotate", anim_channel) []]

+

+anim_channel = AnimChannel ("input", [0, 1, 2, 3], [[("name","TIME"), ("type","Float")]] )

+                           ("output",[0, 50, 100, 150], [[("name","ANGLE"), ("type","Float")]] )

+                           [ Bezier [-0.333333, 0] [2.5, 0], -- intangent outtangent

+                             Bezier [5,0] [7.916667, 0],

+                             Bezier [8.333333, 56] [9.166667, 56],

+                             Bezier [9.583333, 18.666666] [10.333333, -14.933331] ]

+                           [("cube_geometry/rotateY","ANGLE")]

+

+fl = V.fromList

+

+-- | A blue/textured cube

+cube :: Geometry

+cube = Geometry "cube"

+       [PL (LinePrimitive

+         (fl [fl [0,2,3,1], fl [0,1,5,4], fl [6,7,3,2], fl [0,4,6,2], fl [3,7,5,1], fl [5,7,6,4]]) -- indices to vertices

+         (fl [fl [0,0,0,0], fl [1,1,1,1], fl [2,2,2,2], fl [3,3,3,3], fl [4,4,4,4], fl [5,5,5,5]]) -- indices to normals

+         (fl [fl [0,1,2,3], fl [0,1,2,3], fl [0,1,2,3], fl [0,1,2,3], fl [0,1,2,3], fl [0,1,2,3]]) -- indices to texture coordinates, use an empty list when no texture

+         [logo]

+         -- [blue]

+       )]

+       (Vertices "cube_vertices"

+         (fl [(V3 (-10) 10 10), (V3 10 10 10), (V3 (-10) (-10) 10), (V3 10 (-10) 10), -- vertices

+              (V3 (-10) 10 (-10)),(V3 10 10 (-10)),(V3 (-10) (-10) (-10)),(V3 10 (-10) (-10))])

+         (fl [(V3 0 0 1), (V3 0 1 0), (V3 0 (-1) 0), (V3 (-1) 0 0), (V3 1 0 0), (V3 0 0 (-1))]) -- normals

+       )

+

+blue = ("blue", COMMON "" NoParam

+               (PhongCol [CEmission (Color (V4 0 0 0 1)),

+                          CAmbient  (Color (V4 0 0 0 1)),

+                          CDiffuse(Color (V4 0.137255 0.403922 0.870588 1)),

+                          CSpecular(Color (V4 0.5 0.5 0.5 1)),

+                          CShininess 16, 

+                          CReflective (Color (V4 0 0 0 1)),

+                          CReflectivity 0.5,

+                          CTransparent (Color (V4 0 0 0 1)),

+                          CTransparency 1,

+                          CIndex_of_refraction 0]

+               )

+               ""

+       )

+

+diffuse c str (a, COMMON asset NoParam (PhongCol cs) s) = ("color_" ++ str, COMMON asset NoParam (PhongCol (map (replaceDiff c) cs)) s)

+

+replaceDiff c (CDiffuse _) = CDiffuse (Color c)

+replaceDiff _ c = c

+

+ambient c str (a, COMMON asset NoParam (PhongCol cs) s) = ("color_" ++ str, COMMON asset NoParam (PhongCol (map (replaceAmb c) cs)) s)

+

+replaceAmb c (CAmbient _) = CAmbient (Color c)

+replaceAmb _ c = c

+

+

+getDiffuseColor ( CDiffuse  (Color c) ) = Just c

+getDiffuseColor _ = Nothing

+

+getAmbientColor ( CAmbient  (Color c) ) = Just c

+getAmbientColor _ = Nothing

+

+logo = ("haskell-logo", COMMON "" NoParam

+               (PhongTex [(TDiffuse tex)]

+                                     [[0,0,1,0,1,1,0,1]] -- [u0,v0,u1,v1,..] -coordinates (Floats between 0 and 1) that point into the texture

+               )

+               ""

+       )

+

+tex = Texture "logo" "Haskell-Logo-Variation.png" Nothing

+

+polys :: Vector V3 -> Vector V3 -> Vector (Vector Int) -> Vector (Vector Int) -> [Geometry]

+polys p n pi ni = [Geometry "polygons"

+  [PL (LinePrimitive pi -- indices to vertices

+                     ni -- indices to normals

+                     V.empty -- no texure

+                     [blue]

+         )]

+ (Vertices "polygons_vertices" p n)]

+

+

+lines :: Vector V3 -> Vector V3 -> Vector (Vector Int) -> Vector (Vector Int) -> [Geometry]

+lines p n pi ni = [Geometry "lines"

+  [LS (LinePrimitive pi -- indices to vertices

+                     ni -- indices to normals

+                     V.empty -- no texure

+                     [blue]

+         )]

+ (Vertices "lines_vertices" p n)]

+

+

+trifans :: Vector V3 -> Vector V3 -> Vector (Vector Int)-> Vector (Vector Int) -> [Geometry]

+trifans p n pi ni = [Geometry "trifans"

+  [Trf (LinePrimitive pi -- indices to vertices

+                      ni -- indices to normals

+                      V.empty -- no texure

+                      [blue]

+         )]

+ (Vertices "trifans_vertices" p n)]

+

+

+tristrips :: Vector V3 -> Vector V3 -> Vector (Vector Int) -> Vector (Vector Int) -> [Geometry]

+tristrips p n pi ni = [Geometry "tristrips"

+  [Trs (LinePrimitive pi -- indices to vertices

+                      ni -- indices to normals

+                      V.empty -- no texure

+                      [blue]

+         )]

+ (Vertices "trifans_vertices" p n)]

+

+

+ge :: Geometry -> SceneNode

+ge (Geometry name p v) = obj name [Geometry name p v] (V3 0 0 0)

+-- ------------------

+-- a bigger example

+-- ------------------

+animatedCubes = (scene2, animation2)

+animatedCubes2 = [(scene2, animation2)]

+

+scene2 :: Scene

+scene2 = Node EmptyRoot $ [ n aCamera, n (pointLight "pl" (-500) 1000 400) ] ++ (map n test_objs)

+

+-- | Animation of several cubes

+animation2 :: [Animation]

+animation2 = [Node ("cube_rotate", new_channels anim_channel test_objs) []]

+

+emptyAnimation :: [[Animation]]

+emptyAnimation = []

+

+emptyAnim :: [Animation]

+emptyAnim = []

+

+-- | generate an animation that points to the cubes

+new_channels :: AnimChannel -> [SceneNode] -> AnimChannel

+new_channels (AnimChannel i o interp _) nodes =

+              AnimChannel i o interp $ map (\obj -> ((obj_name obj) ++ "/rotateY","ANGLE")) nodes

+

+obj_name (SceneNode n _ _ _ _ _ _ _) = n

+

+-- | a helper function for xyz_grid

+tran :: SceneNode -> V3 -> String -> SceneNode

+tran (SceneNode _   typ layer tr                             cam contr geo light) v3 str =

+     (SceneNode str typ layer [("tr", Translate v3)] cam contr geo light)

+

+test_objs :: [SceneNode]

+test_objs = xyz_grid 10 10 10 150 aCube

+

+-- | Generate a 3 dimensional grid where an object (stored in a SceneNode) is repeated in along the grid

+xyz_grid :: Int -> Int -> Int -> Float -> SceneNode -> [SceneNode]

+xyz_grid x y z d obj = zipWith (tran obj)

+                       (concat (concat (x_line x (map (map (\(V3 a b c) -> (V3 (a+d) b c)))) $

+                                        x_line y (map (\(V3 a b c) -> (V3 a (b+d) c))) $

+                                        x_line z (\(V3 a b c) -> (V3 a b (c+d)))        (V3 0 0 0)) ))

+                       (enum_obj obj [1..(x*y*z)])

+

+enum_obj obj (i:is) = ((obj_name obj) ++ (show i)) : (enum_obj obj is)

+

+x_line 0 change value = []

+x_line n change value = value : ( x_line (n-1) change (change value) )

+

+-------------------------------------------------------------------

+-- visualizing a stream of positions with copies of a base object

+-------------------------------------------------------------------

+

+positions = map (\(x, y, z) -> (x*100, y*100, z*100) ) $

+ -- map (\(x,y,z) -> (fromIntegral x, fromIntegral y, fromIntegral z))

+ en

+

+en :: [(Float,Float,Float)]

+-- en :: [(Word8,Word8,Word8)]

+-- en = take 100 enumerate

+-- en = take 100 all3s

+

+en = map (\(V x y)->(x*20,y*20,0)) []

+

+base_objects = map (rename aCube) (map show [1..(length positions)])

+

+rename :: SceneNode -> String -> SceneNode

+rename (SceneNode str        typ layer tr cam contr geo light) s =

+       (SceneNode (str ++ s) typ layer tr cam contr geo light)

+

+getName (SceneNode str _ _ _ _ _ _ _) = str

+get_name (Geometry str _ _) = str

+

+animatedStream = (streamScene base_objects, streamAnimation positions base_objects)

+

+streamScene :: [SceneNode] -> Scene

+streamScene objects = Node EmptyRoot $ [ n aCamera,

+                                         n (pointLight "pl" (-500) 1000 400) ] ++

+                                         (map n $ objects)

+

+streamAnimation :: [(Float,Float,Float)] -> [SceneNode] -> [Animation]

+streamAnimation ps base_objects =

+       [Node ("cube_stream", EmptyAnim) (map n $ concat $

+             zipWith (\ind bo -> [tr_channel ind ((show ind) ++ "1") bo (length ps) s1 "X"] ++

+                                 [tr_channel ind ((show ind) ++ "2") bo (length ps) s2 "Y"] ++

+                                 [tr_channel ind ((show ind) ++ "3") bo (length ps) s3 "Z"])

+            [1..(length ps)] (map getName base_objects) )

+       ]

+  where

+    s1 = map (\(a,b,c) -> a) ps

+    s2 = map (\(a,b,c) -> b) ps

+    s3 = map (\(a,b,c) -> c) ps

+

+tr_channel ind name bname lps s c = ( "anim" ++ name,

+                           AnimChannel ("input", map (*0.3) (map fromIntegral [0..(lps-1)]), [[("name","TIME"), ("type","Float")]] )

+                                       ("output", (take ind s) ++ (take (lps-ind) (repeat (head (drop ind s)))),

+                                         [[("name",c), ("type","Float")]] )

+                                       (take lps (repeat Linear))

+                                       [(bname ++ "/tran",c)]

+                                  )

diff --git a/src/Graphics/Formats/Collada/Transformations.hs b/src/Graphics/Formats/Collada/Transformations.hs
new file mode 100644
index 0000000..9efa801
--- /dev/null
+++ b/src/Graphics/Formats/Collada/Transformations.hs
@@ -0,0 +1,97 @@
+module Graphics.Formats.Collada.Transformations where

+import Graphics.Formats.Collada.ColladaTypes

+import Graphics.Formats.Collada.GenerateObjects

+import Graphics.Formats.Collada.Vector2D3D

+import Data.Vector (Vector)

+import qualified Data.Vector as V

+import Data.Tuple.Select

+

+translate :: V3 -> Geometry -> Geometry

+translate v (Geometry name prims (Vertices vname ps ns)) = Geometry name prims (Vertices vname (V.map (+ v) ps) ns)

+

+-- |extrude a 2d polygon to 3d, the same points are added again with extrusion direction v

+extrude :: V3 -> Geometry -> Geometry

+extrude v (Geometry name prims (Vertices vname ps _)) = Geometry name

+                                                         (map addIndices prims)

+                                                         (Vertices vname (addNewPoints ps)

+                                                                         (fourN ns) )

+  where

+  addNewPoints :: Vector V3 -> Vector V3

+  addNewPoints vs | V.null vs   = V.empty

+                  | otherwise = V.cons (V.head vs) $ V.cons ((V.head vs)+v) (addNewPoints (V.tail vs))

+

+  fourN :: Vector V3 -> Vector V3

+  fourN vs | V.null vs = V.empty

+           | otherwise = V.cons (V.head vs) $

+                         V.cons (V.head vs) $

+                         V.cons (V.head vs) $ V.cons (V.head vs) (fourN (V.tail vs))

+

+  addIndices (LP (LinePrimitive points normals tex color)) = PL (LinePrimitive (p points) (p points) tex color)

+

+  ns = V.map (normalsFrom v) (cycleNeighbours ps)

+  p :: Vector (Vector Int) -> Vector (Vector Int)

+  p several_outlines = V.foldr (V.++) V.empty (V.map extr_outline several_outlines)

+

+extr_outline :: Vector Int -> Vector (Vector Int)

+extr_outline points = V.map quads (cycleNeighbours points)

+  where

+  quads xs = V.cons ((V.head xs)*2) $          -- [x*2,y*2,x*2+1,y*2+1]

+             V.cons ((V.head (V.tail xs))*2) $

+             V.cons ((V.head (V.tail xs))*2+1) $

+             V.singleton ((V.head xs)*2+1)

+

+normalsFrom (V3 x0 y0 z0) xs = crosspr (v1x-x0,v1y-y0,v1z-z0) (v1x-v2x,v1y-v2y,v1z-v2z)

+  where (V3 v1x v1y v1z ,V3 v2x v2y v2z) = (V.head xs, V.head (V.tail xs)) :: (V3,V3)

+        crosspr (v0,v1,v2) (w0,w1,w2) = (V3 (v1*w2-v2*w1) (v2*w0-v0*w2) (v0*w1-v1*w0))

+

+-- |return a list containing lists of every element with its neighbour

+-- i.e. [e1,e2,e3] -> [ [e1,e2], [e2,e3], [e3, e1] ]

+cycleNeighbours :: Vector a -> Vector (Vector a)

+cycleNeighbours xs | V.null xs = V.empty

+                   | otherwise = cycleN (V.head xs) xs

+

+cycleN :: a -> Vector a -> Vector (Vector a)

+cycleN f xs | V.length xs >= 2 = V.cons (V.fromList [V.head xs, V.head (V.tail xs)]) (cycleN f (V.tail xs))

+            | otherwise        = V.singleton (V.fromList [V.head xs, f ]) -- if the upper doesn't match close cycle

+

+

+atop :: Geometry -> Geometry -> Geometry

+atop (Geometry name0 prims0 (Vertices vname0 ps0 ns0))

+     (Geometry name1 prims1 (Vertices vname1 ps1 ns1)) = Geometry name0

+                                                         ( prims0 ++ (map (changeIndices l) prims1) )

+                                                         ( Vertices vname0 (ps0 V.++ ps1) (ns0 V.++ ns1) )

+  where changeIndices l (LP (LinePrimitive points                                  normals  texCoord mat)) =

+                         LP (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)

+        changeIndices l (LS (LinePrimitive points                                  normals  texCoord mat)) =

+                         LS (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)

+        changeIndices l (PL (LinePrimitive points                                  normals  texCoord mat)) =

+                         PL (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)

+        changeIndices l (Tr (LinePrimitive points                                  normals  texCoord mat)) =

+                         Tr (LinePrimitive (V.map (V.map (l+)) points) (V.map (V.map (l+)) normals) texCoord mat)

+        l = V.length ps0

+

+

+changeDiffuseColor :: String -> V4 -> Geometry -> Geometry

+changeDiffuseColor str color (Geometry name prims

+                               (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns))

+  where c col (LP (LinePrimitive ps ns texCoord mat)) =

+               LP (LinePrimitive ps ns texCoord (map (diffuse col str) mat))

+        c col (LS (LinePrimitive ps ns texCoord mat)) =

+               LS (LinePrimitive ps ns texCoord (map (diffuse col str) mat))

+        c col (PL (LinePrimitive ps ns texCoord mat)) =

+               PL (LinePrimitive ps ns texCoord (map (diffuse col str) mat))

+        c col (Tr (LinePrimitive ps ns texCoord mat)) =

+               Tr (LinePrimitive ps ns texCoord (map (diffuse col str) mat))

+

+changeAmbientColor :: String -> V4 -> Geometry -> Geometry

+changeAmbientColor str color (Geometry name prims

+                               (Vertices vname ps ns)) = (Geometry name (map (c color) prims) (Vertices vname ps ns))

+  where c col (LP (LinePrimitive ps ns texCoord mat)) =

+               LP (LinePrimitive ps ns texCoord (map (ambient col str) mat) ) 

+        c col (LS (LinePrimitive ps ns texCoord mat)) =

+               LS (LinePrimitive ps ns texCoord (map (ambient col str) mat) )

+        c col (PL (LinePrimitive ps ns texCoord mat)) =

+               PL (LinePrimitive ps ns texCoord (map (ambient col str) mat) )

+        c col (Tr (LinePrimitive ps ns texCoord mat)) =

+               Tr (LinePrimitive ps ns texCoord (map (ambient col str) mat) )

+

diff --git a/src/Graphics/Formats/Collada/Vector2D3D.hs b/src/Graphics/Formats/Collada/Vector2D3D.hs
new file mode 100644
index 0000000..d2868c5
--- /dev/null
+++ b/src/Graphics/Formats/Collada/Vector2D3D.hs
@@ -0,0 +1,215 @@
+-- most functions and data types are from https://github.com/cobbpg/sloth2d
+
+module Graphics.Formats.Collada.Vector2D3D
+    ( Angle
+    , V2(..), V3(..), V4(..)
+    , T2
+    , unit, (*.), dot, dot3, cross, cross3, perpL, perpR, mul, divide
+    , turn, turnL, turnNL, turnR, turnNR, parv
+    , square, mag, norm, dir, v_len, set_len
+    , inverse, (Graphics.Formats.Collada.Vector2D3D.<>)
+    , translate, rotate, scale
+    , translationOf, rotationOf, scaleOf
+    , withTranslation, withRotation, withScale
+    ) where
+
+import Data.Monoid
+
+infixl 7 `dot`, `cross`
+infixl 5 `turn`, `turnL`, `turnNL`, `turnR`, `turnNR`, `parv`
+
+-- | An angle is a number between -pi and pi.
+type Angle = Float
+
+-- | 2D vector: a pair of coordinates.
+data V2 = V {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+    deriving (Show, Eq, Ord)
+
+data V3 = V3 {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+    deriving (Show, Eq, Ord)
+
+data V4 = V4 {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+    deriving (Show, Eq, Ord)
+
+-- | 2D affine transformation. No shearing allowed, only translation,
+-- rotation, and scaling. Transformations can be chained with
+-- 'mappend', and 'mempty' is the identity transformation.
+data T2 = T
+    {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+    {-# UNPACK #-} !Float {-# UNPACK #-} !Float
+    deriving Show
+
+instance Num V2 where
+    V x1 y1 + V x2 y2 = V (x1+x2) (y1+y2)
+    V x1 y1 - V x2 y2 = V (x1-x2) (y1-y2)
+    V x1 y1 * V x2 y2 = V (x1*x2) (y1*y2)
+    negate (V x y) = V (negate x) (negate y)
+    abs (V x y) = V (abs x) (abs y)
+    signum (V x y) = V (signum x) (signum y)
+    fromInteger n = let n' = fromInteger n in V n' n'
+
+instance Num V3 where
+    V3 x1 y1 z1 + V3 x2 y2 z2 = V3 (x1+x2) (y1+y2) (z1+z2)
+    V3 x1 y1 z1 - V3 x2 y2 z2 = V3 (x1-x2) (y1-y2) (z1-z2)
+    V3 x1 y1 z1 * V3 x2 y2 z2 = V3 (x1*x2) (y1*y2) (z1*z2)
+    negate (V3 x y z) = V3 (negate x) (negate y) (negate z)
+    abs (V3 x y z) = V3 (abs x) (abs y) (abs z)
+    signum (V3 x y z) = V3 (signum x) (signum y) (signum z)
+    fromInteger n = let n' = fromInteger n in V3 n' n' n'
+
+-- | Unit vector with the given direction.
+unit :: Angle -> V2
+unit a = V (cos a) (sin a)
+
+-- | Multiplication with a scalar.
+(*.) :: V2 -> Float -> V2
+V x y *. m = V (x*m) (y*m)
+
+-- | Multiplication with a scalar.
+mul (V3 x y z) c = (V3  (x*c)  (y*c)  (z*c))
+
+-- | Division by a scalar.
+divide (V3 x y z) c = (V3  (x/c)  (y/c)  (z/c))
+
+-- | Dot product.
+dot :: V2 -> V2 -> Float
+V x1 y1 `dot` V x2 y2 = x1*x2+y1*y2
+
+-- | Dot product.
+dot3 :: V3 -> V3 -> Float
+V3 x1 y1 z1 `dot3` V3 x2 y2 z2 = x1*x2 + y1*y2 + z1*z2
+
+-- | Perp-dot product (2D cross product).
+cross :: V2 -> V2 -> Float
+V x1 y1 `cross` V x2 y2 = x1*y2-y1*x2
+
+-- | 3D cross product.
+cross3 :: V3 -> V3 -> V3
+V3 x1 y1 z1 `cross3` V3 x2 y2 z2 = V3 (y1*z2-z1*y2)  (z1*x2-x1*z2)  (x1*y2-y1*x2)
+
+-- | Vector rotated 90 degrees leftwards.
+perpL :: V2 -> V2
+perpL (V x y) = V (-y) x
+
+-- | Vector rotated 90 degrees rightwards.
+perpR :: V2 -> V2
+perpR (V x y) = V y (-x)
+
+-- | Relative direction of two vectors: @turn v1 v2@ equals @GT@ if
+-- @v2@ takes a left turn with respect to @v1@, @LT@ if it is a right
+-- turn, and @EQ@ if they are parallel.
+turn :: V2 -> V2 -> Ordering
+V x1 y1 `turn` V x2 y2 = compare (x1*y2) (y1*x2)
+
+-- | @turnL v1 v2 == (turn v1 v2 == GT)@
+turnL :: V2 -> V2 -> Bool
+V x1 y1 `turnL` V x2 y2 = x1*y2 > y1*x2
+
+-- | @turnNL v1 v2 == (turn v1 v2 /= GT)@
+turnNL :: V2 -> V2 -> Bool
+V x1 y1 `turnNL` V x2 y2 = x1*y2 <= y1*x2
+
+-- | @turnR v1 v2 == (turn v1 v2 == LT)@
+turnR :: V2 -> V2 -> Bool
+V x1 y1 `turnR` V x2 y2 = x1*y2 < y1*x2
+
+-- | @turnNR v1 v2 == (turn v1 v2 /= LT)@
+turnNR :: V2 -> V2 -> Bool
+V x1 y1 `turnNR` V x2 y2 = x1*y2 >= y1*x2
+
+-- | @parv v1 v2 == (turn v1 v2 == EQ)@
+parv :: V2 -> V2 -> Bool
+V x1 y1 `parv` V x2 y2 = x1*y2 == y1*x2
+
+-- | Vector length squared.
+square :: V2 -> Float
+square v = v `dot` v
+
+-- | 3d Vector length squared.
+square3 :: V3 -> Float
+square3 v = v `dot3` v
+
+-- | Vector length.
+mag :: V2 -> Float
+mag = sqrt . square
+
+-- | 3d Vector length.
+v_len = sqrt . square3
+
+-- | Set Vector length.
+set_len (V3 x y z) l = (V3  (x*c*l)  (y*c*l)  (z*c*l)) where c = 1 / v_len (V3 x y z)
+
+-- | The angle of a vector with respect to the X axis.
+dir :: V2 -> Angle
+dir (V x y) = atan2 y x
+
+-- | Vector normalisation.
+norm :: V2 -> V2
+norm v@(V x y) = V (x*m) (y*m)
+  where
+    m = recip (mag v)
+
+instance Semigroup T2 where (<>) = mappend
+instance Monoid T2 where
+    mempty = scale 1
+    T rx1 ry1 tx1 ty1 `mappend` T rx2 ry2 tx2 ty2 = T rx ry tx ty
+      where
+        rx = rx1*rx2-ry1*ry2
+        ry = ry1*rx2+rx1*ry2
+        tx = rx1*tx2-ry1*ty2+tx1
+        ty = ry1*tx2+rx1*ty2+ty1
+
+-- | Inverse transformation
+inverse :: T2 -> T2
+inverse (T rx ry tx ty) = T (rx*m) (-ry*m) tx' ty'
+  where
+    m = recip (rx*rx+ry*ry)
+    tx' = m*(-ry*ty-rx*tx)
+    ty' = m*(ry*tx-rx*ty)
+
+-- | Transformation applied to a vector.
+(<>) :: T2 -> V2 -> V2
+T rx ry tx ty <> V x y = V x' y'
+  where
+    x' = rx*x-ry*y+tx
+    y' = ry*x+rx*y+ty
+
+-- | Transformation representing a translation.
+translate :: V2 -> T2
+translate (V x y) = T 1 0 x y
+
+-- | Transformation representing a rotation.
+rotate :: Angle -> T2
+rotate a = T (cos a) (sin a) 0 0
+
+-- | Transformation representing a scaling.
+scale :: Float -> T2
+scale m = T m 0 0 0
+
+-- | The translation factor of a transformation.
+translationOf :: T2 -> V2
+translationOf (T _ _ tx ty) = V tx ty
+
+-- | The rotation factor of a transformation.
+rotationOf :: T2 -> Angle
+rotationOf (T rx ry _ _) = dir (V rx ry)
+
+-- | The scaling factor of a transformation.
+scaleOf :: T2 -> Float
+scaleOf (T rx ry _ _) = mag (V rx ry)
+
+-- | Replacing the translation factor of a transformation.
+withTranslation :: T2 -> V2 -> T2
+T rx ry _ _ `withTranslation` V x y = T rx ry x y
+
+-- | Replacing the rotation factor of a transformation.
+withRotation :: T2 -> Angle -> T2
+T rx ry tx ty `withRotation` a = T rx' ry' tx ty
+  where
+    V rx' ry' = unit a *. mag (V rx ry)
+
+-- | Replacing the scaling factor of a transformation.
+withScale :: T2 -> Float -> T2
+T rx ry tx ty `withScale` m = T (m'*rx) (m'*ry) tx ty
+  where
+    m' = m / mag (V rx ry)
diff --git a/src/Graphics/Triangulation/GJPTriangulation.hs b/src/Graphics/Triangulation/GJPTriangulation.hs
new file mode 100644
index 0000000..cb963c9
--- /dev/null
+++ b/src/Graphics/Triangulation/GJPTriangulation.hs
@@ -0,0 +1,360 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- Author: Gergely Patai
+-- from sloth2d: https://github.com/cobbpg/sloth2d/blob/master/Physics/Sloth2D/Geometry2D.hs
+-- based on Garey, Johnson, Preparata, runtime O(n log n)
+
+module Graphics.Triangulation.GJPTriangulation where
+
+import Data.List
+import Data.Ord
+import Data.Vector (Vector, (!))
+import qualified Data.Vector as V
+import qualified Data.Vector.Algorithms.Intro as V
+import Graphics.Formats.Collada.Vector2D3D
+
+data VertexType = TopCap | BottomCap | TopCup | BottomCup | Side
+    deriving Show
+
+data Vertex = Vtx
+    { idx :: Int
+    , prev :: Int
+    , next :: Int
+    , vtype :: VertexType
+    , px :: Float
+    , py :: Float
+    } deriving Show
+
+type MonotoneSegment = ([Int],[Int])
+
+-- | Descriptor for a pair of features. The ordering stands for the
+-- following configurations: @LT@ - V to E, @EQ@ - E to E, @GT - E to
+-- V, where E stands for edge and V stands for vertex (in other words,
+-- you can think of edges being greater than vertices). The integers
+-- are the indices of the features: the vertex itself or the first
+-- vertex (in ccw order) of the edge. For instance, @(LT,2,4)@ means
+-- the pair formed by vertex 2 of the first body and the edge between
+-- vertices 4 and 5 of the second body.
+type Separation = (Ordering, Int, Int)
+
+-- | Checking whether an angle is within a given interval.
+between :: Angle -> (Angle,Angle) -> Bool
+a `between` (a1,a2)
+    | a1 <= a2 = a >= a1 && a <= a2
+    | otherwise = a >= a1 || a <= a2
+
+infixl 6 +<
+
+-- | The sum of two angles.
+(+<) :: Angle -> Angle -> Angle
+a1 +< a2 = if a < -pi then a+2*pi
+           else if a > pi then a-2*pi
+                else a
+  where
+    a = a1+a2
+
+-- | Linear interpolation between two angles along the smaller arc.
+alerp :: Angle -> Angle -> Float -> Angle
+alerp a1 a2 t = a1+<(a2+<(-a1))*t
+
+-- | Applying a binary function to consecutive pairs in a vector with
+-- wrap-around.
+pairsWith :: (a -> a -> b) -> Vector a -> Vector b
+pairsWith f vs
+    | V.null vs = V.empty
+    | otherwise = V.zipWith f vs (V.snoc (V.tail vs) (V.head vs))
+
+-- | The edge vectors of a polygon given as a list of vertices.
+edges :: Vector V2 -> Vector V2
+edges vs = if V.length vs < 2 then V.empty else pairsWith (flip (-)) vs
+
+-- | The absolute angles (with respect to the x axis) of the edges of
+-- a polygon given as a list of vertices.
+angles :: Vector V2 -> Vector Angle
+angles = V.map dir . edges
+
+-- | The signed area of a simple polygon (positive if vertices are in
+-- counter-clockwise order).
+area :: Vector V2 -> Float
+area vs = 0.5 * V.sum (pairsWith cross vs)
+
+-- | The centroid of a simple polygon.
+centroid :: Vector V2 -> V2
+centroid vs
+    | V.null vs = V 0 0
+    | otherwise = divsum (V.foldl1' accum (pairsWith gen vs))
+  where
+    gen v1 v2 = let c = v1 `cross` v2 in (c,(v1+v2)*.c)
+    accum (!c1,!v1) (c2,v2) = (c1+c2,v1+v2)
+    divsum (c,v)
+        | c /= 0 = v*.(recip (3*c))
+        | otherwise = (V.minimum vs+V.maximum vs)*.0.5
+
+-- | The moment of inertia of a simple polygon with respect to the origin.
+moment :: Vector V2 -> Float
+moment vs
+    | V.length vs < 3 = 0
+    | otherwise = divsum (V.foldl1' accum (pairsWith gen vs))
+  where
+    gen v1 v2 = let c = v2 `cross` v1 in (c,(v1 `dot` (v1+v2) + square v2)*c)
+    accum (!s1,!s2) (p1,p2) = (s1+p1,s2+p2)
+    divsum (s1,s2)
+        | s1 /= 0 = s2/(6*s1)
+        | otherwise = 0
+
+-- | The convex hull of a collection of vertices in counter-clockwise
+-- order. (Andrew's Monotone Chain Algorithm)
+convexHull :: Vector V2 -> Vector V2
+convexHull vs = case compare (V.length vs) 2 of
+    LT -> vs
+    EQ -> V.fromList . nub . V.toList $ vs
+    GT -> V.fromList (avs' ++ bvs')
+  where
+    svs = V.modify V.sort vs
+    vmin = V.head svs
+    vmax = V.last svs
+    vd = vmax-vmin
+
+    (avs,bvs) = V.partition (\v -> vd `turnNR` v-vmax) . V.init . V.tail $ svs
+    avs' = if V.null avs then [vmin]
+           else tail . V.foldl' (flip addVertex) [V.head avs,vmin] $ V.snoc (V.tail avs) vmax
+    bvs' = if V.null bvs then [vmax]
+           else tail . V.foldr' addVertex [V.last bvs,vmax] $ V.cons vmin (V.init bvs)
+
+    addVertex v (v1:vs@(v2:_)) | v1-v2 `turnNR` v-v1 = addVertex v vs
+    addVertex v vs = v:vs
+
+-- | Monotone decomposition of a simple polygon.
+monotoneDecomposition :: Vector V2 -> [MonotoneSegment]
+monotoneDecomposition vs = (map getIndices . snd) (V.foldl' addVertex ([], []) scvs)
+  where
+    cw = area vs < 0
+    ovs = if cw then vs else V.reverse vs
+    getIndices (l,r) = if cw then (map idx l, map idx r)
+                       else (map idx' l, map idx' r)
+      where
+        idx' v = V.length vs - 1 - idx v
+    addVertex (mss, out) v = case vtype v of
+      -- open new monotone segment with this sole vertex
+      TopCap -> (([v], [v]) : mss, out)
+      -- split monotone segment: all vertices are added to left side,
+      -- only last two to right; this is the only case where we need
+      -- to check geometry to find the matching segment
+      BottomCap -> let (mss',(msl,msr):mss'') = break isContained mss
+                       ms' = (msl, v : msr)
+                       ms'' = ([v, head msr], [head msr])
+                   in (mss' ++ ms':ms'':mss'', out)
+      -- close the segment on the right side using the join vertex and
+      -- the next vertex on its other side
+      TopCup -> let ([(msl1,msr1),(msl2,msr2)], mssr) = partition isConnected mss
+                    (msl1',msr1',msl2',msr2') =
+                      if idx v == prev (head msr1)
+                      then let i = prev (head msr2)
+                               v' = cvs ! i
+                           in (msl1, v { prev = i } : msr1, v':v:msl2, v':msr2)
+                      else let i = prev (head msr1)
+                               v' = cvs ! i
+                           in (msl2, v { prev = i } : msr2, v':v:msl1, v':msr1)
+                in ((msl1',msr1'):mssr,(msl2',msr2'):out)
+      -- close monotone segment (stage for emission, remove from
+      -- active collection)
+      BottomCup -> let (mss',(msl,msr):mss'') = break isConnected mss
+                   in (mss' ++ mss'', (v:msl,v:msr):out)
+      -- add to the segment the upper neighbour belongs to
+      Side -> let (mss',(msl,msr):mss'') = break isConnected mss
+                  ms' = if idx v == next (head msl) then (v:msl, msr) else (msl, v:msr)
+              in (mss' ++ ms':mss'', out)
+      where
+        isConnected ((vl:_), (vr:_)) = idx v == next vl || idx v == prev vr
+        isConnected _ = error "isConnected"
+
+        isContained ((vl:_), (vr:_)) = px v > xl && px v <= xr
+          where
+            vl' = cvs ! (next vl)
+            vr' = cvs ! (prev vr)
+            xl = px vl + (px vl' - px vl) * (py v - py vl) / (py vl' - py vl)
+            xr = px vr + (px vr' - px vr) * (py v - py vr) / (py vr' - py vr)
+        isContained _ = error "isContained"
+
+    scvs = V.modify (V.sortBy (comparing py)) cvs
+    cvs = V.imap classify ovs
+    classify i1 v1@(V x1 y1) = Vtx i1 i0 i2 vty x1 y1
+      where
+        vty = case (compare y1 y0, compare y1 y2, v2-v1 `turn` v1-v0) of
+          (LT, LT, LT) -> BottomCap
+          (EQ, LT, LT) -> BottomCap
+          (LT, LT, GT) -> TopCap
+          (LT, EQ, GT) -> TopCap
+          (GT, GT, GT) -> BottomCup
+          (EQ, GT, GT) -> BottomCup
+          (GT, GT, LT) -> TopCup
+          (GT, EQ, LT) -> TopCup
+          _ -> Side
+        i0 = if i1 == 0 then V.length ovs - 1 else i1-1
+        i2 = if i1 == V.length ovs - 1 then 0 else i1+1
+        v0@(V _ y0) = ovs ! i0
+        v2@(V _ y2) = ovs ! i2
+
+-- | Triangulation of a monotone polygon.
+monotoneTriangulation :: Vector V2 -> MonotoneSegment -> [(Int,Int,Int)]
+monotoneTriangulation vs (msl,msr) = snd (foldl' addVertex ([si2,si1],[]) sis)
+  where
+    addVertex (si@(s,i):sis,ts) si'@(s',i')
+      | s /= s' = ([si',si], zipWith (if s' then tl else tr) (si:sis) sis ++ ts)
+      | concave = (si':si:sis,ts)
+      | otherwise = (si':si'':map snd si2s'', zipWith (if s' then tr else tl) sis' sis'' ++ ts)
+      where
+        concave = isConcave (snd (head sis)) i
+        (si2s',si2s'') = break visible (zip (si:sis) sis)
+          where
+            visible ((_,i1),(_,i2)) = isConcave i2 i1
+        (sis',sis'') = unzip si2s'
+        si'' = last sis''
+
+        tl (_,i1) (_,i2) = (i',i2,i1)
+        tr (_,i1) (_,i2) = (i',i1,i2)
+
+        isConcave i0 i1 = s' == v1-v0 `turnL` v2-v1
+          where
+            v0 = vs ! i0
+            v1 = vs ! i1
+            v2 = vs ! i'
+
+    addVertex _ _ = error "addVertex"
+
+    si1:si2:sis = merge msl (init (tail msr))
+    merge [] irs = map ((,) True) irs
+    merge ils [] = map ((,) False) ils
+    merge ils@(il:ils') irs@(ir:irs')
+      | y1 < y2 = (True,ir) : merge ils irs'
+      | otherwise = (False,il) : merge ils' irs
+      where
+        V _ y1 = vs ! il
+        V _ y2 = vs ! ir
+
+-- | Triangulation of a simple polygon.
+triangulation :: Vector V2 -> [(Int, Int, Int)]
+triangulation vs = [tri | ms <- monotoneDecomposition vs, tri <- monotoneTriangulation vs ms]
+
+-- | A 5-tuple @(d2,ds,sep,v1,v2)@ that provides distance information
+-- on two convex polygons, where @d2@ is the square of the distance,
+-- @ds@ is its sign (negative in case of penetration), @sep@ describes
+-- the opposing features, while @v1@ and @v2@ are the absolute
+-- coordinates of the deepest points within the opposite polygon. If
+-- the third parameter is @True@, only negative distances are
+-- reported, and the function yields @Nothing@ for non-overlapping
+-- polygons. This is more efficient if we are only interested in
+-- collisions, since the computation can be cancelled upon finding the
+-- first separating axis. If the third parameter is @False@, the
+-- result cannot be @Nothing@.
+convexSeparation
+    :: Vector V2 -- ^ The vertices of the first polygon (vs1)
+    -> Vector V2 -- ^ The vertices of the second polygon (vs2)
+    -> Bool -- ^ Whether we are only interested in overlapping
+    -> Maybe (Float, Float, Separation, V2, V2)
+convexSeparation vs1 vs2 onlyCollision
+    | onlyCollision = closestPenetratingPair firstValidPair
+    | otherwise = Just (closestPair firstValidPair)
+  where
+    l1 = V.length vs1
+    l2 = V.length vs2
+    succ1 n = let n' = succ n in if n' >= l1 then 0 else n'
+    succ2 n = let n' = succ n in if n' >= l2 then 0 else n'
+    pred1 n = if n == 0 then l1-1 else pred n
+    pred2 n = if n == 0 then l2-1 else pred n
+
+    firstValidPair = until validSeparation stepBackwards (GT,0,0)
+
+    -- Exhaustive search for the closest feature pair
+    closestPair s = go (l1+l2-1) (stepBackwards s) (s,v12) dst
+      where
+        (dst,v12) = separation s
+        go 0 _ (s,(v1,v2)) (sd,sgd) = (sd,-sgd,s,v1,v2)
+        go n s sep dst
+            | dst < dst' = go n' (stepBackwards s) sep dst
+            | otherwise = go n' (stepBackwards s) (s,v12) dst'
+          where
+            (dst',v12) = separation s
+            n' = n-1
+
+    -- Exhaustive search for the closest penetrating feature pair
+    closestPenetratingPair s = go (l1+l2-1) (stepBackwards s) (s,v12) dst
+      where
+        (dst,v12) = separation s
+        go 0 _ (s,(v1,v2)) (sd,sgd) = Just (sd,-sgd,s,v1,v2)
+        go n s sep dst@(_,sg)
+            | sg < 0 = Nothing
+            | dst < dst' = go n' (stepBackwards s) sep dst
+            | otherwise = go n' (stepBackwards s) (s,v12) dst'
+          where
+            (dst',v12) = separation s
+            n' = n-1
+{-
+-- Step towards the next feature pair counter-clockwise
+stepForward (rel,i1,i2) = case rel of
+LT -> (turn e1 e2',i1 ,i2')
+EQ -> (turn e1' e2',i1',i2')
+GT -> (turn e1' e2 ,i1',i2 )
+where
+i1' = succ1 i1
+i2' = succ2 i2
+e1 = vs1 ! i1' - vs1 ! i1
+e2 = vs2 ! i2 - vs2 ! i2'
+e1' = vs1 ! succ1 i1' - vs1 ! i1'
+e2' = vs2 ! i2' - vs2 ! succ2 i2'
+-}
+    -- Step towards the next feature pair clockwise
+    stepBackwards (_,i1,i2) = case turn e2 e1 of
+        LT -> (LT,i1 ,i2')
+        EQ -> (EQ,i1',i2')
+        GT -> (GT,i1',i2 )
+      where
+        i1' = pred1 i1
+        i2' = pred2 i2
+        e1 = vs1 ! i1 - vs1 ! i1'
+        e2 = vs2 ! i2' - vs2 ! i2
+
+    -- Check if the feature pair is valid (i.e. the edge lies within
+    -- the interval defined by the vertex, or the edges are parallel)
+    validSeparation (rel,i1,i2) = case rel of
+        LT -> turnNR e11 e22 && turnNR e22 e12
+        EQ -> parv e12 e22
+        GT -> turnNR e21 e12 && turnNR e12 e22
+      where
+        v1 = vs1 ! i1
+        v2 = vs2 ! i2
+        e11 = v1 - vs1 ! pred1 i1
+        e12 = vs1 ! succ1 i1 - v1
+        e21 = vs2 ! pred2 i2 - v2
+        e22 = v2 - vs2 ! succ2 i2
+
+    -- Distance information for a given feature pair
+    separation (rel,i1,i2) = case rel of
+        LT -> swap (s v2 v2' e2 sd2 v1)
+        GT -> s v1 v1' e1 sd1 v2
+        EQ | sd1 > sd2 -> min (s v1 v1' e1 sd1 v2) (s v1 v1' e1 sd1 v2')
+           | otherwise -> swap (min (s v2 v2' e2 sd2 v1) (s v2 v2' e2 sd2 v1'))
+      where
+        swap (d,(v1,v2)) = (d,(v2,v1))
+
+        v1 = vs1 ! i1
+        v2 = vs2 ! i2
+        v1' = vs1 ! succ1 i1
+        v2' = vs2 ! succ2 i2
+        e1 = v1'-v1
+        e2 = v2'-v2
+        sd1 = square e1
+        sd2 = square e2
+
+        -- The squared distance of the v1 to v2 segment and the v3 vertex
+        s v1 v2 e12 sd12 v3 = ((sd,signum cp),(v,v3))
+          where
+            e13 = v3-v1
+            e23 = v3-v2
+            sd12' = recip sd12
+            dp = e12 `dot` e13
+            -- negative: separation, positive: penetration
+            cp = e12 `cross` e13
+            (v,sd) | dp <= 0 = (v1,square e13)
+                   | dp >= sd12 = (v2,square e23)
+                   | otherwise = (v1+e12*.(dp*sd12'),cp*cp*sd12')
diff --git a/src/Graphics/Triangulation/KETTriangulation.hs b/src/Graphics/Triangulation/KETTriangulation.hs
new file mode 100644
index 0000000..b0f0759
--- /dev/null
+++ b/src/Graphics/Triangulation/KETTriangulation.hs
@@ -0,0 +1,64 @@
+-- |

+-- Module    : Graphics.Triangulation.KETTriangulation

+-- Copyright :(C) 1997, 1998, 2008 Joern Dinkla, www.dinkla.net

+--

+-- Triangulation of simple polygons after Kong, Everett, Toussaint 91

+-- with some changes by T.Vogt: return indices instead of coordinates of triangles and Data.Vector instead of lists

+--

+-- see

+--     Joern Dinkla, Geometrische Algorithmen in Haskell, Diploma Thesis,

+--     University of Bonn, Germany, 1998. 

+

+module Graphics.Triangulation.KETTriangulation (ketTri) where

+import Graphics.Triangulation.Triangulation (isLeftTurn, isRightTurnOrOn)

+import Data.List      ( (\\) )

+import Data.Vector (Vector)

+import qualified Data.Vector as V

+import Graphics.Formats.Collada.Vector2D3D (V2 (V))

+import Debug.Trace

+

+type V2i = (V2,Int)

+toV2 = V.map (\(x,i) -> x)

+

+ketTri :: Vector V2 -> [(Int,Int,Int)]

+ketTri points | (V.length vertices) > 3 = scan vs stack rs

+              | otherwise = []

+  where vertices = V.zip points (V.generate (V.length points) id)

+        [p1,p2,p3] = V.toList (V.take 3 vertices)

+        qs         = V.drop 3 vertices

+        vs         = qs V.++ (V.singleton p1)

+        stack      = V.fromList [p3, p2, p1, V.last vertices]

+        rs         = reflexVertices (angles vertices)

+

+scan :: Vector V2i -> Vector V2i -> Vector V2i -> [(Int,Int,Int)]

+scan vs stack rs | V.null vs            = []

+                 | V.length vs == 1     = [(snd (V.head stack), snd (V.head (V.tail stack)), snd (V.head vs))]

+                 | V.length stack == 3  = scan (V.tail vs) (V.cons (V.head vs) stack) rs

+                 | isEar rs x_m x_i x_p = (snd x_p, snd x_i, snd x_m) : (scan vs (V.cons x_p ss') rs')

+                 | otherwise            = scan (V.tail vs) (V.cons (V.head vs) stack) rs

+  where [x_p, x_i, x_m] = V.toList (V.take 3 stack)

+        ss' = V.drop 2 stack

+        rs'   = V.fromList $ (V.toList rs) \\ (isConvex x_m x_p (V.head vs) ++

+                                               isConvex (V.head (V.tail ss')) x_m x_p)

+        isConvex (im,_) (i,ii) (ip,_) = if isLeftTurn im i ip then [(i,ii)] else []

+

+isEar :: Vector V2i -> V2i -> V2i -> V2i -> Bool

+isEar rs (m,_) (x,_) (p,_) | V.null rs = True

+                           | otherwise = isLeftTurn m x p && not (V.any ( (m,x,p) `containsBNV`) (toV2 rs))

+

+reflexVertices  :: Vector (V2i,V2i,V2i) -> Vector V2i

+reflexVertices as | V.null as             = V.empty

+                  | isRightTurnOrOn m x p = V.cons (x,xi) $ reflexVertices (V.tail as)

+                  | otherwise             =                 reflexVertices (V.tail as)

+  where ((m,_),(x,xi),(p,_)) = V.head as

+

+containsBNV (s,t,v) p    = (a==b && b==c)

+  where a                = isLeftTurn s t p

+        b                = isLeftTurn t v p

+        c                = isLeftTurn v s p

+

+angles :: Vector a -> Vector (a,a,a)

+angles xs = V.zip3 (rotateR xs) xs (rotateL xs)

+

+rotateL xs = (V.tail xs) V.++ (V.singleton (V.head xs))

+rotateR xs = (V.singleton (V.last xs)) V.++ (V.init xs)

diff --git a/src/Graphics/Triangulation/Triangulation.hs b/src/Graphics/Triangulation/Triangulation.hs
new file mode 100644
index 0000000..9358ea5
--- /dev/null
+++ b/src/Graphics/Triangulation/Triangulation.hs
@@ -0,0 +1,183 @@
+module Graphics.Triangulation.Triangulation where
+import Graphics.Formats.Collada.ColladaTypes
+import Graphics.Formats.Collada.Transformations (cycleNeighbours,cycleN)
+import qualified Graphics.Triangulation.GJPTriangulation as T
+import Data.Tuple.Select
+import qualified Data.Vector as V
+import Data.Vector (Vector, (!))
+import Graphics.Formats.Collada.Vector2D3D (V2 (V), V3(V3))
+import Debug.Trace
+import Data.List
+
+type TriangulationFunction = Vector V2 -> [(Int,Int,Int)]
+data Tree = Node Int Int [Tree]
+
+instance Show Tree where
+         show (Node c p tree) = "Node " ++ (show c) ++ " " ++ (show p) ++ "[" ++ (concat(map show tree)) ++ "]"
+
+-- | since there are a lot of triangulation algorithms
+--   a triangulation function can be passed
+triangulate :: TriangulationFunction -> Geometry -> Geometry
+triangulate f (Geometry name prims (Vertices vname ps ns)) =
+               Geometry name (map triPoly prims) (Vertices vname ps ns)
+  where
+  triPoly (LP (LinePrimitive pIndices          nIndices                   tex col)) =
+           PL (LinePrimitive (tri 0 pIndices) (normals pIndices nIndices) tex col)
+  -- TO DO: other patterns
+  tri :: Int -> Vector (Vector Int) -> Vector (Vector Int)
+  tri i pIndices | V.null pIndices = V.empty
+                 | otherwise       = (g ( map (ind (V.head pIndices)) (f (v2s ps (V.head pIndices))))) V.++
+                                     (tri (i+(V.length (V.head pIndices))) (V.tail pIndices))
+  ind pIndices (i0,i1,i2) = (pIndices V.! i0, pIndices V.! i1, pIndices V.! i2)
+  g :: [(Int,Int,Int)] -> Vector (Vector Int)
+  g [] = V.empty
+  g ((i0,i1,i2):xs) = V.cons (V.cons i0 $ V.cons i1 $ V.singleton i2) (g xs)
+
+  normals pIndices nIndices = V.replicate (V.sum (V.map V.length pIndices)) (V.head nIndices)
+
+v2s :: Vector V3 -> Vector Int -> Vector V2
+v2s ps pIndices | V.null pIndices = V.empty
+                | otherwise = V.cons (V x z) (v2s ps (V.tail pIndices))
+  where (V3 x y z) = ps V.! i
+        i = (V.head pIndices)
+
+gjpTri :: Vector V2 -> [(Int,Int,Int)] 
+gjpTri = T.triangulation
+
+
+-- | some triangulation algorithms on't support polygons with holes
+-- These polygons with (nested) holes have to be cut so that they consist of only one outline
+-- I.e. the chars a,b,d,e,g,o,p,q contain holes tat have to be deleted.
+
+deleteHoles :: Geometry -> Geometry
+deleteHoles (Geometry name prims    (Vertices vname ps ns)) =
+             Geometry name newPrims (Vertices vname ps ns)
+  where
+  newPrims = zipWith3 (\pInd tex col -> LP (LinePrimitive pInd pInd tex col)) flattenedTrees (map t prims) (map c prims)
+  flattenedTrees = zipWith (flatten vs) trees vertices
+  trees = map (generateTrees ps insidePoly) vertices
+  pI (LP (LinePrimitive pIndices nIndices tex col)) = pIndices
+  t (LP (LinePrimitive pIndices nIndices tex col)) = tex
+  c (LP (LinePrimitive pIndices nIndices tex col)) = col
+  vertices :: [Vector (Vector Int)]
+  vertices = map pI prims
+  vs = V.map (\(V3 x y z) -> V x z) ps
+
+
+flatten :: Vector V2 -> [Tree] -> Vector (Vector Int) -> Vector (Vector Int)
+flatten _ []                      is = V.empty
+flatten vs ((Node c poly tts):ts) is
+          | null tts  = V.cons                               (alternate c (pdir poly) (is V.! poly))  (flatten vs ts is)
+          | otherwise = V.cons (embed vs (flatten vs tts is) (alternate c (pdir poly) (is V.! poly))) (flatten vs ts is)
+  where
+  pdir poly = polygonDirection $ V.map (vs V.!) (is V.! poly)
+
+-- |cut a polygon at a good position and insert the contained hole-polygon with opposite direction
+embed :: Vector V2 -> Vector (Vector Int) -> Vector Int -> Vector Int
+embed vs sub_polys poly | V.null sub_polys = poly
+                        | otherwise = embed vs (V.tail sub_polys) ((V.take (n+1) poly) V.++
+                                                                   (V.head sub_polys) V.++
+                                                                   (V.cons (V.head (V.head sub_polys)) (V.drop n poly)) )
+  where n = fst $ rotatePoly (vs V.! (V.head (V.head sub_polys))) (V.map (vs V.!) poly)
+
+-- |make sure that direction (clockwise or ccw) of polygons alternates depending on the nesting number c of poly
+alternate :: Int -> Bool -> Vector Int -> Vector Int
+alternate c b poly | (b && (even c)) || (not b && (odd c)) = poly
+                   | otherwise                             = V.reverse poly
+
+-- |f should be the funtion to test "contains"
+-- the trees then are the hierarchy of containedness of outlines
+generateTrees :: Vector V3 -> (Vector V2 -> Vector V2 -> Bool) -> Vector (Vector Int) -> [Tree]
+generateTrees vs f ps | V.null ps = []
+                      | otherwise = (treesList containedPolys []) ++
+                                 (map (\x -> Node 0 x []) separateOutlines)
+  where containedPolys = filter (\[p0,p1] -> f (pvs p0) (pvs p1)) (combi ++ (map reverse combi))
+        combi = combinationsOf 2 [0..((V.length ps)-1)] -- all 2-subsets i.e. [[0,1],[0,2],[1,2]]
+        -- separate outlines don't contain other outlines
+        separateOutlines = ([0..((V.length ps)-1)]) \\ (nub $ concat containedPolys)
+        pvs p = V.map (\(V3 x y z) -> V x z) $ V.map (vs V.!) (ps V.! p)
+
+treesList :: [[Int]] -> [Tree] -> [Tree]
+treesList [] trees = trees
+treesList ([x,y]:cs) trees = treesList cs (insertTrees [x,y] trees)
+
+insertTrees :: [Int] -> [Tree] -> [Tree]
+insertTrees [x,y] trees | or (map fst ins) = map snd ins
+                        | otherwise = (map snd ins) ++ [ Node 0 y [Node 1 x []] ]
+  where ins = map (insertTree [x,y]) trees
+
+insertTree :: [Int] -> Tree -> (Bool, Tree)
+insertTree [x,y] (Node c i []) | y == i = (True, Node c i [Node (c+1) x []] )
+                               | otherwise = (False, Node c i [])
+insertTree [x,y] (Node c i trees) | y == i = (True, Node c i ((Node (c+1) x []):trees) )
+                                  | otherwise = (b, Node c i (map snd subtrees))
+  where subtrees = map (insertTree [x,y]) trees
+        b = or (map fst subtrees)
+
+-- subsets of size k
+-- borrowed from David Amos' library: HaskellForMaths
+combinationsOf 0 _ = [[]]
+combinationsOf _ [] = []
+combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
+
+-- |how many positions to rotate a polygon until the start point is nearest to some other point
+-- call i.e. with nearest (3,4) [(0,0),(1,2), ... ] 0 0
+rotatePoly :: V2 -> Vector V2  -> (Int,Float)
+rotatePoly p poly = nearest p poly (-1) 0 0
+
+nearest :: V2 -> Vector V2 -> Float -> Int -> Int -> (Int,Float)
+nearest (V x0 y0) ps dist l ml | V.null ps = (ml,dist)
+                               | (newDist < dist) || (dist < 0) = nearest (V x0 y0) (V.tail ps) newDist (l+1) l
+                               | otherwise                      = nearest (V x0 y0) (V.tail ps) dist    (l+1) ml
+  where newDist = (x0-x1)*(x0-x1)+(y0-y1)*(y0-y1)
+        (V x1 y1) = V.head ps
+
+-- | returns True iff the first point of the first polygon is inside the second poylgon
+insidePoly :: Vector V2 -> Vector V2 -> Bool
+insidePoly poly1 poly2 | V.null poly1 = False
+                       | V.null poly2 = False
+                       | otherwise    = pointInside (V.head poly1) poly2
+
+-- | A point is inside a polygon if it has an odd number of intersections with the boundary (Jordan Curve theorem)
+pointInside :: V2 -> Vector V2 -> Bool
+pointInside (V x y) poly = (V.length intersectPairs) `mod` 2 == 1
+  where intersectPairs = V.filter (\p -> positiveXAxis p && aboveBelow p) allPairs --, specialCases p]
+        allPairs = cycleNeighbours poly
+        positiveXAxis p = (x0 p) > x || (x1 p) > x -- intersect with positive x-axis
+                                                   -- only lines with one point above + one point below can intersect
+        aboveBelow p = (((y0 p)> y && (y1 p)< y) || ((y0 p) < y && (y1 p) > y))
+        specialCases p = (((dir1 p) > 0 && (dir2 p) <= 0) || ((dir1 p) <= 0 && (dir2 p) > 0))-- cross product for special cases
+        dir1 p = cross ((x1 p)-(x0 p),(y1 p)-(y0 p)) (1,0)
+        dir2 p = cross ((x1 p)-(x0 p),(y1 p)-(y0 p)) (x-(x0 p),y-(y0 p))
+        cross (a0,b0) (a1,b1) = a0*b1 - a1*b0
+        x0 p = (\(V x y) -> x) (V.head p)
+        x1 p = (\(V x y) -> x) (V.last p)
+        y0 p = (\(V x y) -> y) (V.head p)
+        y1 p = (\(V x y) -> y) (V.last p)
+
+-- | the direction of a polygon can be obtained by looking at a maximal point
+-- returns True if counterclockwise
+--         False if clockwise
+polygonDirection :: Vector V2 -> Bool
+polygonDirection poly | dir > 0 = True
+                      | dir < 0 = False
+                      | dir ==0 = (x0 > x1) || (y0 < y1)
+  where p = V.fromList $ nub $ V.toList poly
+        (V x0 y0) = p V.! lminus
+        (V x1 y1) = p V.! lplus
+        dir = area2 (p!lminus) (p!l) (p!lplus)
+        l = maxim poly 0 0 (-1000000,-1000000)
+        lminus = (l-1) `mod` (V.length p)
+        lplus = (l+1) `mod` (V.length p)
+         -- the index of the right-/upmost point
+
+maxim :: Vector V2 -> Int -> Int -> (Float,Float) -> Int
+maxim xs count ml (mx,my) | V.null xs = ml
+                          | (x > mx) || (x >= mx && y > my) = maxim (V.tail xs) (count+1) count (x, y)
+                          | otherwise                       = maxim (V.tail xs) (count+1) ml (mx,my)
+  where (V x y) = V.head xs
+
+isRightTurnOrOn m x p = (area2 m x p) <= 0
+isLeftTurn :: V2 -> V2 -> V2 -> Bool
+isLeftTurn      m x p = (area2 m x p) > 0
+area2 (V x2 y2) (V x0 y0) (V x1 y1) = (x1-x0)*(y2-y0)-(x2-x0)*(y1-y0)
diff --git a/src/Graphics/WaveFront.hs b/src/Graphics/WaveFront.hs
new file mode 100644
index 0000000..c71966b
--- /dev/null
+++ b/src/Graphics/WaveFront.hs
@@ -0,0 +1,62 @@
+-- |
+-- Module      : Graphics.WaveFront
+-- Description : Re-exports public API
+-- Copyright   : (c) Jonatan H Sundqvist, 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+
+-- TODO | - Logging
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- TODO | - Decide on an API
+module Graphics.WaveFront (
+  -- * OBJ types
+  OBJToken(..), VertexIndices(..), OBJ,
+  
+  -- * MTL types
+  MTLToken(..), Illumination(..), MTL, MTLTable(..),
+  
+  -- * Model types
+  Face(..), Colour(..), Material(..), Model(..),
+  
+  -- * Lenses
+  module Lenses,
+  
+  -- * Parsing
+  module Graphics.WaveFront.Parse,
+  
+  -- * Model functions
+  createModel, tessellate, bounds, fromIndices, fromFaceIndices, diffuseColours, hasTextures, textures,
+
+  -- * Loading
+  module Load,
+
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Graphics.WaveFront.Types
+import Graphics.WaveFront.Parse
+import Graphics.WaveFront.Parse.Common
+import Graphics.WaveFront.Model
+import Graphics.WaveFront.Lenses as Lenses
+import qualified Graphics.WaveFront.Load as Load
diff --git a/src/Graphics/WaveFront/Foreign.hs b/src/Graphics/WaveFront/Foreign.hs
new file mode 100644
index 0000000..7722c07
--- /dev/null
+++ b/src/Graphics/WaveFront/Foreign.hs
@@ -0,0 +1,88 @@
+-- |
+-- Module      : Graphics.WaveFront.Foreign
+-- Description : Foreign function interface
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+
+-- February 24 2015
+
+-- TODO | - Possible to get rid of newtypes (?)
+--        - Decide on an API
+
+-- SPEC | -
+--        -
+
+
+
+-- TODO: Why do some extensions start with 'X'?
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Foreign where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- import System.IO.Unsafe (unsafePerformIO)
+-- import Foreign.Storable
+-- import qualified Foreign.C as C
+
+-- import Graphics.WaveFront.Types
+-- import qualified Graphics.WaveFront.Parse as Parse
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- -- |
+-- -- I feel dirty...
+-- parseOBJ :: C.CString -> COBJ
+-- parseOBJ = COBJ . Parsers.parseOBJ . unsafePerformIO . C.peekCString
+--
+-- -- |
+-- parseMTL :: C.CString -> CMTL
+-- parseMTL = CMTL . Parsers.parseMTL . unsafePerformIO . C.peekCString
+
+
+
+-- -- |
+-- newtype COBJ = COBJ OBJ
+--
+--
+-- -- |
+-- newtype CMTL = CMTL MTL
+--
+--
+-- -- | We
+-- instance Storable COBJ where
+--   sizeOf    = const 0
+--   alignment = const 0
+--   peek _    = error "Work in progress"
+--   poke _    = error "Work in progress"
+--
+--
+-- -- | We
+-- instance Storable CMTL where
+--   sizeOf    = const 0
+--   alignment = const 0
+--   peek _    = error "Work in progress"
+--   poke _    = error "Work in progress"
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Pure foreign function interface
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- I feel the urge to make a joke about 'Unacceptable argument in foreign declaration'
+-- foreign export ccall parseOBJ :: C.CString -> COBJ
+-- foreign export ccall parseMTL :: C.CString -> CMTL
diff --git a/src/Graphics/WaveFront/Lenses.hs b/src/Graphics/WaveFront/Lenses.hs
new file mode 100644
index 0000000..d507ef9
--- /dev/null
+++ b/src/Graphics/WaveFront/Lenses.hs
@@ -0,0 +1,54 @@
+-- |
+-- Module      : Graphics.WaveFront.Lenses
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 9 2016
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Pragmas
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances      #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Lenses where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Control.Lens (makeLensesWith, abbreviatedFields)
+
+import Graphics.WaveFront.Types
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Lenses
+--------------------------------------------------------------------------------------------------------------------------------------------
+makeLensesWith abbreviatedFields ''VertexIndices
+makeLensesWith abbreviatedFields ''Face
+makeLensesWith abbreviatedFields ''Colour
+makeLensesWith abbreviatedFields ''Material
+makeLensesWith abbreviatedFields ''Model
\ No newline at end of file
diff --git a/src/Graphics/WaveFront/Load.hs b/src/Graphics/WaveFront/Load.hs
new file mode 100644
index 0000000..6d65693
--- /dev/null
+++ b/src/Graphics/WaveFront/Load.hs
@@ -0,0 +1,108 @@
+-- |
+-- Module      : Graphics.WaveFront.Load
+-- Description : Loading (and perhaps writing) OBJ and MTL files
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created July 26 2015
+
+-- TODO | - Logging
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax #-}
+-- {-# LANGUAGE TupleSections #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- TODO | - Decide on an API
+module Graphics.WaveFront.Load (
+  obj, mtl, materials, model
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import System.FilePath (splitFileName, takeDirectory, (</>))
+
+import           Data.Text (Text)
+import qualified Data.Text    as T
+import qualified Data.Text.IO as T
+import           Data.Vector (Vector)
+
+import Control.Applicative ((<$>))
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Class (lift)
+
+import qualified Data.Attoparsec.Text as Atto
+
+import           Graphics.WaveFront.Types
+import qualified Graphics.WaveFront.Parse as Parse
+import qualified Graphics.WaveFront.Parse.Common as Parse
+import           Graphics.WaveFront.Model (createMTLTable, createModel)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions (IO)
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- Loading data ----------------------------------------------------------------------------------------------------------------------------
+
+-- |
+-- TODO | - Use bytestrings (?)
+--        - Deal with IO and parsing errors
+obj :: (Fractional f, Integral i) => String -> IO (Either String (OBJ f Text i []))
+obj fn = runExceptT $ do
+  lift $ putStrLn $ "Loading obj file: " ++ fn
+  ExceptT $ Atto.parseOnly (Parse.wholeFile Parse.obj) <$> T.readFile fn
+
+
+-- |
+-- TODO | - Use bytestrings (?)
+--        - Merge OBJ and MTL parsers (and plug in format-specific code as needed) (?)
+--        - Deal with IO and parsing errors
+mtl :: (Fractional f) => String -> IO (Either String (MTL f Text []))
+mtl fn = do
+  putStrLn $ "Loading mtl file: " ++ fn
+  Atto.parseOnly (Parse.wholeFile Parse.mtl) <$> T.readFile fn
+
+
+-- |
+-- TODO | - Better names (than 'mtls' and 'fns') (?)
+--        - Refactor, simplify
+--        - Improve path handling (cf. '</>')
+--        - Graceful error handling
+materials :: (Fractional f) => [FilePath] -> IO (Either String (MTLTable f Text))
+materials fns = runExceptT $ do
+  tokens <- mapM (ExceptT . mtl) fns
+  ExceptT . return $ createTableFromMTLs tokens
+  where
+    createTableFromMTLs :: [[MTLToken f Text]] -> Either String (MTLTable f Text)
+    createTableFromMTLs = createMTLTable . zip (map (T.pack . snd . splitFileName) fns)
+
+
+-- | Loads an OBJ model from file, including associated materials
+-- TODO | - Graceful error handling
+model :: (Fractional f, Integral i) => FilePath -> IO (Either String (Model f Text i Vector))
+model fn = runExceptT $ do
+  obj       <- ExceptT $ obj fn
+  materials <- ExceptT $ materials [ fst (splitFileName fn) </> T.unpack name | LibMTL name <- obj ]
+  ExceptT . return $ createModel obj materials (Just $ takeDirectory fn)
+  -- where loadWithName name = mtl name >>= return . (name,)
diff --git a/src/Graphics/WaveFront/Model.hs b/src/Graphics/WaveFront/Model.hs
new file mode 100644
index 0000000..96172a8
--- /dev/null
+++ b/src/Graphics/WaveFront/Model.hs
@@ -0,0 +1,345 @@
+-- |
+-- Module      : Graphics.WaveFront.Model
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : stable
+-- Portability : portable
+--
+
+-- TODO | - Single-pass (eg. consume all tokens only once) for additional performance (?)
+--        - 
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax     #-}
+{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+--{-# LANGUAGE OverloadedLists   #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Section
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- TODO | - Clean this up
+--        - Decide on API
+module Graphics.WaveFront.Model (
+  BoundingBox(..),
+  facesOf,  materialsOf,
+  tessellate, bounds,
+  hasTextures, textures,
+  createModel, createMTLTable,
+  fromIndices, fromFaceIndices, diffuseColours
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import qualified Data.Vector as V
+import           Data.Vector (Vector, (!?))
+
+import           Data.Text (Text)
+import qualified Data.Map  as M
+import           Data.Map (Map)
+import qualified Data.Set  as S
+import           Data.Set (Set)
+
+import Data.List   (groupBy)
+import Data.Maybe  (listToMaybe, catMaybes)
+
+import Linear (V2(..), V3(..))
+
+import Control.Lens ((^.), (.~), (%~), (&), _1, _2, _3)
+
+import Cartesian.Core (BoundingBox(..), fromExtents, x, y, z)
+
+import Graphics.WaveFront.Types
+import Graphics.WaveFront.Lenses
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- TODO | - Factor out these combinators
+
+-- | Performs a computation on adjacent pairs in a list
+-- TODO | - Factor out and make generic
+pairwise :: (a -> a -> b) -> [a] -> [b]
+pairwise f xs = zipWith f xs (drop 1 xs)
+
+
+-- | Convers an Either to a Maybe
+eitherToMaybe :: Either a b -> Maybe b
+eitherToMaybe (Right b) = Just b
+eitherToMaybe (Left _)  = Nothing
+
+
+-- | Converts a Maybe to an Either
+maybeToEither :: a -> Maybe b -> Either a b
+maybeToEither _ (Just b)  = Right b
+maybeToEither a (Nothing) = Left a
+
+-- Parser output churners (OBJ) ------------------------------------------------------------------------------------------------------------
+
+-- TODO | - Move to separate module (eg. WaveFront.Model)
+
+-- | Creates a mapping between group names and the corresponding bounds ([lower, upper)).
+--
+-- TODO | - Figure out how to deal with multiple group names (eg. "g mesh1 nose head")
+--        - Include not just face indices but vertex indices (makes it easier to 'slice' GPU buffers) (maybe in a separate function)
+groupsOf :: (Ord s, Integral i) => [OBJToken f s i m] -> Map (Set s) (i, i)
+groupsOf = buildIndexMapWith . filter notObject
+  where
+    notObject (Object _) = False
+    notObject  _         = True
+
+
+-- | Creates a mapping between object names and the corresponding bounds ([lower, upper)).
+objectsOf :: (Ord s, Integral i) => [OBJToken f s i m] -> Map (Set s) (i, i)
+objectsOf = buildIndexMapWith . filter notGroup
+  where
+    notGroup (Group _) = False
+    notGroup  _        = True
+
+
+-- | Creates a mapping between names (of groups or objects) to face indices
+--
+-- TODO | - Refactor, simplify
+--        - What happens if the same group or object appears multiple times (is that possible?)
+--        - Rename or add function parameter (the -With suffix implies a function parameter)
+buildIndexMapWith :: (Ord s, Integral i) => [OBJToken f s i m] -> Map (Set s) (i, i)
+buildIndexMapWith = M.fromList . pairwise zipIndices . update 0
+  where
+    zipIndices (names, low) (_, upp) = (names, (low, upp))
+    
+    -- TODO | - Separate Group and Object lists
+    --        - Rename (?)
+    --        - Factor out (might be useful for testing) (?)
+    update faceCount []                = [(S.empty, faceCount)]
+    update faceCount (Group names:xs)  = (names, faceCount) : update faceCount xs
+    update faceCount (Object names:xs) = (names, faceCount) : update faceCount xs
+    update faceCount (OBJFace _:xs)    = update (faceCount + 1) xs
+    update faceCount (_:xs)            = update faceCount xs
+
+
+-- | Filters out faces from a stream of OBJTokens and attaches the currently selected material,
+--   as defined by the most recent LibMTL and UseMTL tokens.
+facesOf :: forall f s i m. Ord s => MTLTable f s -> [OBJToken f s i m] -> [Either String (Face f s i m)]
+facesOf materials' = makeFaces Nothing Nothing
+  where 
+    -- | It's not always rude to make faces
+    -- TODO | - Keep refactoring...
+    --        - Rename (?)
+    makeFaces :: Maybe s -> Maybe s -> [OBJToken f s i m] -> [Either String (Face f s i m)]
+    makeFaces _                  _                  []              = []
+    makeFaces lib@(Just libName) mat@(Just matName) (OBJFace is:xs) = createFace materials' libName matName is : makeFaces lib mat xs
+
+    makeFaces lib@Nothing        mat                (OBJFace _:xs)  = Left "No library selected for face"      : makeFaces lib mat xs
+    makeFaces lib                mat@Nothing        (OBJFace _:xs)  = Left "No material selected for face"     : makeFaces lib mat xs
+
+    makeFaces _                  mat                (LibMTL  libName:xs)  = makeFaces (Just libName) mat xs
+    makeFaces lib                _                  (UseMTL  matName:xs)  = makeFaces lib (Just matName) xs
+
+    makeFaces lib                mat                (_:xs)                = makeFaces lib mat xs
+
+
+-- |
+createFace :: Ord s => MTLTable f s -> s -> s -> m (VertexIndices i) -> Either String (Face f s i m)
+createFace materials' libName matName indices' = do
+  material' <- lookupMaterial materials' libName matName
+  Right $ Face { fIndices=indices', fMaterial=material' }
+
+
+-- | Tries to find a given material in the specified MTL table
+-- TODO | - Specify missing material or library name (would require additional constraints on 's')
+--        - Refactor
+lookupMaterial :: Ord s => MTLTable f s -> s -> s -> Either String (Material f s)
+lookupMaterial materials' libName matName = do
+  library <- maybeToEither "No such library" (M.lookup libName materials')
+  maybeToEither "No such material" (M.lookup matName library)
+
+-- Parser output churners (MTL) ------------------------------------------------------------------------------------------------------------
+
+-- | Constructs an MTL table from a list of (libraryName, token stream) pairs.
+-- TODO | - Refactor, simplify
+createMTLTable :: Ord s => [(s, [MTLToken f s])] -> Either String (MTLTable f s)
+createMTLTable = fmap M.fromList . mapM (\(name, tokens) -> (name,) <$> materialsOf tokens)
+
+
+-- | Constructs a map between names and materials. Incomplete material definitions
+--   result in an error (Left ...).
+--
+-- TODO | - Debug information (eg. attributes without an associated material)
+--        - Pass in error function (would allow for more flexible error handling) (?)
+--        - Deal with duplicated attributes (probably won't crop up in any real situations)
+materialsOf :: Ord s => [MTLToken f s] -> Either String (Map s (Material f s))
+materialsOf = fmap M.fromList . mapM createMaterial . partitionMaterials
+
+
+-- | Creates a new (name, material) pair from a stream of MTL tokens.
+--   The first token should be a new material name.
+createMaterial :: [MTLToken f s] -> Either String (s, Material f s)
+createMaterial (NewMaterial name:attrs) = (name,) <$> fromAttributes attrs
+createMaterial  attrs                   = Left $ "Free-floating attributes"
+
+
+-- | Breaks a stream of MTL tokens into lists of material definitions
+-- TODO | - Rename (eg. groupMaterials) (?)
+partitionMaterials :: [MTLToken f s] -> [[MTLToken f s]]
+partitionMaterials = groupBy (\_ b -> not $ isNewMaterial b)
+  where
+    isNewMaterial (NewMaterial _) = True
+    isNewMaterial _               = False
+
+
+-- | Creates a material
+fromAttributes :: [MTLToken f s] -> Either String (Material f s)
+fromAttributes attrs = case colours' of
+  Nothing                -> Left  $ "Missing colour(s)" -- TODO: More elaborate message (eg. which colour)
+  Just (amb, diff, spec) -> Right $ Material { fAmbient=amb,fDiffuse=diff, fSpecular=spec, fTexture=texture' }
+  where
+    colours' = materialColours attrs
+    texture' = listToMaybe [ name | MapDiffuse name <- attrs ]
+
+
+-- | Tries to extract a diffuse colour, a specular colour, and an ambient colour from a list of MTL tokens
+-- TODO | - Should we really require all three colour types (?)
+--        - Rename (?)
+materialColours :: [MTLToken f s] -> Maybe (Colour f, Colour f, Colour f)
+materialColours attrs = (,,) <$>
+                          listToMaybe [ c | (Diffuse  c) <- attrs ] <*>
+                          listToMaybe [ c | (Specular c) <- attrs ] <*>
+                          listToMaybe [ c | (Ambient  c) <- attrs ]
+
+-- API functions ---------------------------------------------------------------------------------------------------------------------------
+
+-- | Constructs a model from a stream of OBJ tokens, a materials table and an optional path to root of the model (used for textures, etc.)
+--
+-- TODO | - Performance, how are 'copies' of coordinates handled (?)
+--        - Performance, one pass (with a fold perhaps)
+--
+-- I never knew pattern matching in list comprehensions could be used to filter by constructor
+createModel :: (Ord s, Integral i) => OBJ f s i [] -> MTLTable f s -> Maybe FilePath -> Either String (Model f s i Vector)
+createModel tokens materials root = do
+    faces' <- sequence $ facesOf materials tokens 
+    return $ Model { fVertices  = V.fromList [ vec | OBJVertex   vec <- tokens ],
+                     fNormals   = V.fromList [ vec | OBJNormal   vec <- tokens ],
+                     fTexcoords = V.fromList [ vec | OBJTexCoord vec <- tokens ],
+                     fFaces     = packFaces faces',
+                     fGroups    = groupsOf  tokens,
+                     fObjects   = objectsOf tokens,
+                     fMaterials = materials,
+                     fRoot      = root }
+  where
+    packFace :: Face f s i [] -> Face f s i Vector
+    packFace face@Face{fIndices} = face { fIndices=V.fromList fIndices } -- indices %~ (_) -- TODO: Type-changing lenses
+
+    packFaces :: [] (Face f s i []) -> Vector (Face f s i Vector)
+    packFaces = V.fromList . map (packFace . tessellate)
+
+
+-- |
+-- TODO | - Specialise to [[Face]] (?)
+--        - Check vertex count (has to be atleast three)
+--        - Better names (?)
+tessellate :: Face f s i [] -> Face f s i []
+tessellate = indices %~ triangles
+  where
+    triangles []       = []
+    triangles (a:rest) = concat $ pairwise (\b c -> [a, b, c]) rest
+
+
+-- | Finds the axis-aligned bounding box of the model
+-- TODO | - Deal with empty vertex lists (?)
+--        - Refactor
+--        - Folding over applicative (fold in parallel)
+--        - Make sure the order is right
+bounds :: (Num f, Ord f, Foldable m, HasVertices (Model f s i m) (m (V3 f))) => Model f s i m -> BoundingBox (V3 f)
+bounds model = fromExtents $ axisBounds (model^.vertices) <$> V3 x y z
+  where
+    -- TODO | - Factor out 'minmax'
+    minmaxBy :: (Ord o, Num o, Foldable m) => (a -> o) -> m a -> (o, o)
+    minmaxBy f values = foldr (\val' acc -> let val = f val' in (min val (fst acc), max val (snd acc))) (0, 0) values -- TODO: Factor out
+
+    axisBounds vs axis = minmaxBy (^.axis) vs
+
+-- Orphaned TODOs?
+
+-- TODO | - Deal with missing values properly
+--        - Indexing should be defined in an API function
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- TODO | - Polymorphic indexing and traversing
+--        - Profile, optimise
+--        - Index buffers
+
+
+-- | Takes a vector of data, an index function, a choice function, a vector of some type with indices
+--   and uses the indices to constructs a new Vector with the data in the original vector.
+--
+-- TODO | - Factor out the buffer-building logic
+--        - Rewrite the above docstring...
+fromIndices :: Vector v -> (Vector v -> i -> b) -> (a -> i) -> Vector a -> Vector b
+fromIndices data' index choose = V.map (index data' . choose)
+
+
+-- |
+fromFaceIndices :: Integral i => Vector (v f) -> (Vector (v f) -> a -> b) -> (VertexIndices i ->  a) -> Vector (Face f Text i Vector) -> Vector b
+fromFaceIndices data' index choose = V.concatMap (fromIndices data' index (choose) . (^.indices))
+
+
+-- |
+-- TODO: Factor out per-vertex logic so we don't have to redefine this function entirely for each colour type
+diffuseColours :: Vector (Face f s i Vector) -> Vector (Colour f)
+diffuseColours faces' = V.concatMap (\f -> V.replicate (V.length $ f^.indices) (f^.material.diffuse)) faces'
+
+-- TODO | - Do not create intermediate vectors (automatic fusion?)
+--        - Allow fallback values (or function), or use Either
+--        - Add docstrings
+
+-- |
+unindexedVertices :: Model f Text Int Vector -> Maybe (Vector (V3 f))
+unindexedVertices model = sequence $ fromFaceIndices (model^.vertices) (index) (^.ivertex) (model^.faces)
+  where
+    index coords i = coords !? (i-1)
+
+unindexedNormals :: Model f Text Int Vector -> Maybe (Vector (V3 f))
+unindexedNormals model = sequence $ fromFaceIndices (model^.normals) (index) (^.inormal) (model^.faces)
+  where
+    index coords mi = mi >>= \i -> coords !? (i-1)
+
+unindexedTexcoords :: Model f Text Int Vector -> Maybe (Vector (V2 f))
+unindexedTexcoords model = sequence $ fromFaceIndices (model^.texcoords) (index) (^.itexcoord) (model^.faces)
+  where
+    index coords mi = mi >>= \i -> coords !? (i-1)
+
+-- Model queries ---------------------------------------------------------------------------------------------------------------------------
+
+-- TODO: Turn into Lenses/Getters/Isos (?)
+
+-- | Does the model have textures?
+hasTextures :: Ord s => Model f s i m -> Bool
+hasTextures =  not . S.null . textures
+
+
+-- | The set of all texture names
+textures :: Ord s => Model f s i m -> S.Set s
+textures = S.fromList . catMaybes . map (^.texture) . concatMap M.elems . M.elems . (^.materials)
diff --git a/src/Graphics/WaveFront/Parse.hs b/src/Graphics/WaveFront/Parse.hs
new file mode 100644
index 0000000..a98f404
--- /dev/null
+++ b/src/Graphics/WaveFront/Parse.hs
@@ -0,0 +1,88 @@
+-- |
+-- Module      : Graphics.WaveFront.Parse
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, February 8 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+-- Created February 8 2015
+-- Wavefront - Parsers.hs
+-- Migrated to separate project on February 21 2015
+
+-- TODO | - Appropriate container types (eg. bytestring, vector)
+--        - Grammar specification
+--        - Incremental parsing (?)
+--        - Improve naming scheme
+--          -- Remove 'parse-' prefix, import qualified (eg. 'Parse.obj')
+--
+--        - Separate MTL and OBJ parsers (?) (...)
+--        - Separate parsing, processing, logging, IO and testing (...)
+--          -- Proper path handling (eg. include root in MTLTable or not)
+--
+--        - Additional attributes (lighting, splines, etc.)
+--        - FFI (...)
+--        - Debugging information (line number, missing file, missing values, etc.) (...)
+--        - Proper Haddock coverage, including headers (...)
+--        - Model type (✓)
+--        - Caching (?)
+--        - Performance, profiling, optimisations
+--          -- Strict or lazy (eg. with Data.Map) (?)
+--          -- Multi-threading
+--          -- Appropriate container types
+--
+--        - PrintfArg instances for the types defined in this module
+--        - Reconciling Cabal and hierarchical modules
+--        - Dealing with paths in lib statements (requires knowledge of working directories)
+--        - Move comments and specification to separate files (eg. README)
+--        - Inline comments (for internals, implementation)
+--
+--        - Full OBJ spec compliance
+--          -- Do the usemtl and libmtl statements affect vertices or faces (?)
+--
+--        - Parser bugs
+--          -- Negative coordinates enclosed in parentheses (✓)
+--
+--        - Decide on a public interface (exports) (API)
+--          -- Model will be the main API type
+--          -- Processing utils (eg. iterating over model faces; withModelFaces :: ((Material, [(Vertex, Maybe Normalcoords, Maybe Texcoords)]) -> b) -> Model -> [b])
+--          -- Export functions for working with the output data (eg. unzipIndices :: [(Int, Int, Int)] -> ([Int], [Int], [Int]))
+--          -- Export certain utilities (eg. second, perhaps in another module) (?)
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax     #-}
+{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- TODO | - Clean this up
+--        - Decide on API
+module Graphics.WaveFront.Parse (
+  module Graphics.WaveFront.Types, -- TODO: Don't export internal types (duh)
+  obj, mtl,
+  comment, lineSeparator
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Graphics.WaveFront.Parse.Common
+import Graphics.WaveFront.Parse.OBJ (obj)
+import Graphics.WaveFront.Parse.MTL (mtl)
+
+import Graphics.WaveFront.Types
\ No newline at end of file
diff --git a/src/Graphics/WaveFront/Parse/Common.hs b/src/Graphics/WaveFront/Parse/Common.hs
new file mode 100644
index 0000000..bfeb2d8
--- /dev/null
+++ b/src/Graphics/WaveFront/Parse/Common.hs
@@ -0,0 +1,166 @@
+-- |
+-- Module      : Graphics.WaveFront.Parse.Common
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, October 2 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+
+-- TODO | - Fully polymorphic (even in the string and list types) (?)
+--        - 
+
+-- SPEC | - 
+--        - 
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Section
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Parse.Common where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import           Data.Text (Text, pack)
+import qualified Data.Attoparsec.Text as Atto
+
+import Control.Applicative (pure, liftA2, (<$>), (<*>), (<*), (*>), (<|>))
+import Linear (V2(..), V3(..))
+
+import Graphics.WaveFront.Types
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions (pure)
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- Jon's little helpers --------------------------------------------------------------------------------------------------------------------
+
+-- | Consumes all input, including any leading or trailing comments and whitespace
+-- TODO | - Rename (?)
+wholeFile :: Atto.Parser a -> Atto.Parser a
+wholeFile p = cutToTheChase *> p <* cutToTheChase <* Atto.endOfInput
+
+
+-- | Skips any leading comments, line breaks and empty lines
+-- TODO | - Rename (?)
+--        - Skip whitespace
+cutToTheChase :: Atto.Parser ()
+cutToTheChase = Atto.skipMany ((comment *> pure ()) <|> (Atto.satisfy isLinearSpace *> pure ()) <|> Atto.endOfLine)
+
+
+-- | OBJ rows may be separated by one or more lines of comments and whitespace, or empty lines.
+-- TODO | - Make sure this is right
+lineSeparator :: Atto.Parser ()
+lineSeparator = Atto.skipMany1 $ ignore space *> ignore comment *> Atto.endOfLine
+
+
+-- | Parses a comment (from the '#' to end of the line), possibly preceded by whitespace
+-- TODO | - Break out the whitespace part (?)
+comment :: Atto.Parser Text
+comment = Atto.skipSpace *> Atto.char '#' *> Atto.takeTill (\c -> (c == '\r') || (c == '\n')) -- TODO: Is the newline consumed (?)
+
+
+-- | Tries the given parser, falls back to 'Nothing' if it fails
+-- TODO | - Use 'try' to enforce backtracking (?)
+optional :: Atto.Parser a -> Atto.Parser (Maybe a)
+optional p = Atto.option Nothing (Just <$> p)
+
+
+-- | Like Atto.skipMany, except it skips one match at the most
+ignore :: Atto.Parser a -> Atto.Parser ()
+ignore p = optional p *> pure ()
+
+
+-- | 
+atleast :: Int -> Atto.Parser a -> Atto.Parser [a]
+atleast n p = liftA2 (++) (Atto.count n p) (Atto.many' p)
+
+
+-- | Skips atleast one white space character (not including newlines and carriage returns)
+space :: Atto.Parser ()
+space = Atto.skipMany1 (Atto.satisfy isLinearSpace)
+
+
+-- | Predicate for linear space (eg. whitespace besides newlines)
+-- TODO | - Unicode awareness (cf. Data.Char.isSpace)
+--        - Come up with a better name (?)
+isLinearSpace :: Char -> Bool
+isLinearSpace c = (c == ' ') || (c == '\t')
+
+
+-- | One or more letters (cf. 'Atto.letter' for details)
+word :: Atto.Parser Text
+word = pack <$> Atto.many1 Atto.letter
+
+
+-- | Used for texture, material, object and group names (and maybe others that I have yet to think of)
+-- TODO | - Use Unicode groups, make more robust (?)
+name :: Atto.Parser Text
+name = pack <$> Atto.many1 (Atto.satisfy $ \c -> (c /= ' ') && (c /= '\t') && (c /= '\r') && (c /= '\n'))
+
+
+-- | Parses the strings "off" (False) and "on" (True)
+toggle :: Atto.Parser Bool
+toggle = (Atto.string "off" *> pure False) <|> (Atto.string "on" *> pure True)
+
+
+-- | Wraps a parser in a '(' and a ')', with no whitespace in between
+parenthesised :: Atto.Parser a -> Atto.Parser a
+parenthesised p = Atto.char '(' *> p <* Atto.char ')'
+
+
+-- TODO | - Allow scientific notation (?)
+
+-- |
+coord :: Fractional f => Atto.Parser f
+coord = space *> (parenthesised Atto.rational <|> Atto.rational)
+
+
+-- | A single colour channel
+-- TODO | - Clamp to [0,1] (cf. partial from monadplus) (?)
+--        - Can channels be parenthesised (?)
+channel :: Fractional f => Atto.Parser f
+channel = space *> (parenthesised Atto.rational <|> Atto.rational)
+
+
+-- | A colour with three or four channels (RGB[A])
+colour :: Fractional f => Atto.Parser (Colour f)
+colour = Colour <$> channel <*> channel <*> channel <*> Atto.option 1 channel
+
+
+-- | A point in 3D space
+point3D :: Fractional f => Atto.Parser (V3 f)
+point3D = V3 <$> coord <*> coord <*> coord
+
+
+-- | A point in 2D space
+point2D :: Fractional f => Atto.Parser (V2 f)
+point2D = V2 <$> coord <*> coord
+
+
+-- |
+clamp :: Ord n => n -> n -> n -> Atto.Parser n
+clamp lower upper n
+  | between lower upper n = pure n
+  | otherwise             = fail "Number not in range"
+  where
+    between lw up n = (lower <= n) && (n <= upper)
+    -- between 0 <. n <. 5
+
+-- |
+-- TODO | - Clean up and generalise
+clamped :: Integral i => i -> i -> Atto.Parser i
+clamped lower upper = Atto.decimal >>= clamp lower upper
\ No newline at end of file
diff --git a/src/Graphics/WaveFront/Parse/MTL.hs b/src/Graphics/WaveFront/Parse/MTL.hs
new file mode 100644
index 0000000..060952f
--- /dev/null
+++ b/src/Graphics/WaveFront/Parse/MTL.hs
@@ -0,0 +1,142 @@
+-- |
+-- Module      : Graphics.WaveFront.Parse.MTL
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, October 2 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+
+-- TODO | - 
+--        - 
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax     #-}
+{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Parse.MTL (
+  mtl, row, token,
+  ambient, diffuse, specular,
+  mapDiffuse, newMaterial
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- import qualified Data.Map  as M
+-- import qualified Data.Set  as S
+-- import qualified Data.Vector as V
+import Data.Text (Text)
+
+import qualified Data.Attoparsec.Text as Atto
+
+import Control.Applicative ((<$>), (<*), (*>), (<|>))
+
+import Graphics.WaveFront.Parse.Common
+
+import Graphics.WaveFront.Types hiding (ambient, diffuse, specular)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- MTL parsing -----------------------------------------------------------------------------------------------------------------------------
+
+-- | Produces a list of MTL tokens
+mtl :: (Fractional f) => Atto.Parser (MTL f Text [])
+mtl = Atto.sepBy row lineSeparator
+
+
+-- | Parses a single MTL row.
+row :: (Fractional f) => Atto.Parser (MTLToken f Text)
+row = token <* ignore comment
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- | Parse an MTL token
+-- TODO: How to deal with common prefix (Ka, Kd, Ks) (backtrack?)
+token :: (Fractional f) => Atto.Parser (MTLToken f Text)
+token = (Atto.string "Ka"     *> ambient)     <|>
+        (Atto.string "Kd"     *> diffuse)     <|>
+        (Atto.string "Ks"     *> specular)    <|>
+        (Atto.string "Ns"     *> specExp)     <|>
+        (Atto.string "illum"  *> illum)       <|>
+        (Atto.string "Ni"     *> refraction)  <|>
+        (Atto.string "d"      *> dissolve)    <|> -- TODO: Handle inverse as well (cf. 'Tr' attribute)
+        (Atto.string "map_Kd" *> mapDiffuse)  <|>
+        (Atto.string "map_Ka" *> mapAmbient)  <|>
+        (Atto.string "newmtl" *> newMaterial)
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- TODO: Expose these parsers for testing purposes (?)
+
+-- TODO | - Change definition of 'colour' and 'Colour' to only allow three channels (alpha is handled by the 'dissolve' attribute)
+--        - Change the definition of 'Colour' or use the one defined in the colour package
+
+-- | Three or four channel values (RGB[A])
+ambient :: (Fractional f) => Atto.Parser (MTLToken f s)
+ambient = Ambient <$> colour
+
+
+-- | Three or four channel values (RGB[A])
+diffuse :: (Fractional f) => Atto.Parser (MTLToken f s)
+diffuse = Diffuse <$> colour
+
+
+-- | Three or four channel values (RGB[A])
+specular :: (Fractional f) => Atto.Parser (MTLToken f s)
+specular = Specular <$> colour
+
+
+-- | A rational number, preceded by whitespace (specular exponent)
+specExp :: (Fractional f) => Atto.Parser (MTLToken f s)
+specExp = space *> (SpecularExponent <$> Atto.rational)
+
+
+-- | A number between 0 and 10 (inclusive) (illumination model)
+illum :: Atto.Parser (MTLToken f s)
+illum = space *> (Illum <$> clamped 0 10)
+
+
+-- | A rational number, preceded by whitespace (refraction index)
+refraction :: (Fractional f) => Atto.Parser (MTLToken f s)
+refraction = space *> (Refraction <$> Atto.rational)
+
+
+-- | A rational number, preceded by whitespace (doss)
+dissolve :: (Fractional f) => Atto.Parser (MTLToken f s)
+dissolve = space *> (Dissolve <$> Atto.rational)
+
+
+-- | A texture name, preceded by whitespace
+mapDiffuse :: Atto.Parser (MTLToken f Text)
+mapDiffuse = space *> (MapDiffuse <$> name)
+
+
+-- | A texture name, preceded by whitespace
+mapAmbient :: Atto.Parser (MTLToken f Text)
+mapAmbient = space *> (MapAmbient <$> name)
+
+
+-- | A material name, preceded by whitespace
+newMaterial :: Atto.Parser (MTLToken f Text)
+newMaterial = space *> (NewMaterial <$> name)
\ No newline at end of file
diff --git a/src/Graphics/WaveFront/Parse/OBJ.hs b/src/Graphics/WaveFront/Parse/OBJ.hs
new file mode 100644
index 0000000..37aa5a0
--- /dev/null
+++ b/src/Graphics/WaveFront/Parse/OBJ.hs
@@ -0,0 +1,173 @@
+-- |
+-- Module      : Graphics.WaveFront.Parse.OBJ
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, October 2 2016
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+
+-- TODO | - Fully polymorphic (even in the string and list types) (?)
+--        - 
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Extensions
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE UnicodeSyntax     #-}
+{-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Parse.OBJ (
+  obj, row, face,
+  normal, texcoord, vertex, object, group,
+  lib, use,
+  vertexIndices,
+) where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Data.Text (Text)
+-- import qualified Data.Vector as V
+import qualified Data.Set as S
+
+import qualified Data.Attoparsec.Text as Atto
+
+import Control.Applicative ((<$>), (<*>), (<*), (*>), (<|>))
+
+-- import Linear (V2(..), V3(..))
+
+import Graphics.WaveFront.Parse.Common
+import Graphics.WaveFront.Types hiding (texture)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- OBJ parsing -----------------------------------------------------------------------------------------------------------------------------
+
+-- | This function creates an OBJToken or error for each line in the input data
+obj :: (Fractional f, Integral i) => Atto.Parser (OBJ f Text i [])
+obj = Atto.sepBy row lineSeparator -- <* Atto.endOfInput
+
+
+-- | Parses a token given a single valid OBJ row
+--
+-- TODO | - Correctness (total function, no runtime exceptions)
+--        - Handle invalid rows (how to deal with mangled definitions w.r.t indices?)
+--        - Use ListLike or Monoid (or maybe Indexable, since that's the real requirement) (?)
+row :: (Fractional f, Integral i) => Atto.Parser (OBJToken f Text i [])
+row = token <* ignore comment -- TODO: Let the separator handle comments (?)
+
+
+-- |
+-- Parses an OBJ token
+token :: (Fractional f, Integral i) => Atto.Parser (OBJToken f Text i [])
+token = (Atto.string "f"  *> face)     <|>
+        (Atto.string "l"  *> line)     <|>
+        -- TODO: How to deal with common prefix (v, vn, vt) (backtrack?) (doesn't seem to be a problem)
+        (Atto.string "vn" *> normal)   <|>
+        (Atto.string "vt" *> texcoord) <|>
+        (Atto.string "v"  *> vertex)   <|>
+        (Atto.string "o"  *> object)   <|>
+        (Atto.string "g"  *> group)    <|>
+        (Atto.string "s"  *> smooth)   <|>
+        (Atto.string "mtllib" *> lib)  <|>
+        (Atto.string "usemtl" *> use)
+
+    
+-- TODO: Expose these parsers for testing purposes (?)
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- | Three or more vertex definitions (cf. 'vertexIndices' for details)
+face :: Integral i => Atto.Parser (OBJToken f Text i [])
+face = OBJFace <$> vertexIndices
+
+
+-- | A single vertex definition with indices for vertex position, normal, and texture coordinates
+--
+-- TODO: | - Should the slashes be optional?
+--         - Allowed trailing slashes (I'll have to check the spec again) (?)
+--
+-- f Int[/((Int[/Int])|(/Int))]
+vertexIndices :: Integral i => Atto.Parser [VertexIndices i]
+vertexIndices = atleast 3 (space *> (ivertex <*> index   <*> index))     <|> -- vi/ti/ni
+                atleast 3 (space *> (ivertex <*> nothing <*> skipIndex)) <|> -- vi//ni
+                atleast 3 (space *> (ivertex <*> index   <*> nothing))   <|> -- vi/ti
+                atleast 3 (space *> (ivertex <*> nothing <*> nothing))       -- vi
+  where
+    ivertex :: Integral i => Atto.Parser (Maybe i -> Maybe i -> VertexIndices i)
+    ivertex = VertexIndices <$> Atto.decimal
+
+    index :: Integral i => Atto.Parser (Maybe i)
+    index = Just <$> (Atto.char '/' *> Atto.decimal)
+    
+    skipIndex :: Integral i => Atto.Parser (Maybe i)
+    skipIndex = Atto.char '/' *> index
+
+    nothing :: Atto.Parser (Maybe i)
+    nothing = pure Nothing
+
+-- Geometry primitives ---------------------------------------------------------------------------------------------------------------------
+
+-- | Two integers, separated by whitespace
+line :: Integral i => Atto.Parser (OBJToken f Text i m)
+line = Line <$> (space *> Atto.decimal) <*> (space *> Atto.decimal)
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- | Three cordinates, separated by whitespace
+normal :: (Fractional f) => Atto.Parser (OBJToken f Text i m)
+normal = OBJNormal <$> point3D
+
+
+-- | Two coordinates, separated by whitespace
+texcoord :: (Fractional f) => Atto.Parser (OBJToken f Text i m)
+texcoord = OBJTexCoord <$> point2D
+
+
+-- | Three coordinates, separated by whitespace
+vertex :: (Fractional f) =>  Atto.Parser (OBJToken f s i m)
+vertex  = OBJVertex <$> point3D
+
+
+-- | Object names, separated by whitespace
+object :: Atto.Parser (OBJToken f Text i m)
+object = Object . S.fromList <$> atleast 1 (space *> name)
+
+
+-- | Group names, separated by whitespace
+group :: Atto.Parser (OBJToken f Text i m)
+group = Group . S.fromList <$> atleast 1 (space *> name)
+
+
+-- | Smoothing group
+-- TODO: Refactor
+smooth :: Atto.Parser (OBJToken f Text i m)
+smooth = SmoothGroup <$> (((Atto.string "off" <|> Atto.string "0") *> pure Nothing) <|> (space *> (Just <$> name)))
+
+
+-- | An MTL library name
+lib :: Atto.Parser (OBJToken f Text i m)
+lib = LibMTL <$> (space *> name)
+
+
+-- | An MTL material name
+use :: Atto.Parser (OBJToken f Text i m)
+use = UseMTL <$> (space *> name)
\ No newline at end of file
diff --git a/src/Graphics/WaveFront/Types.hs b/src/Graphics/WaveFront/Types.hs
new file mode 100644
index 0000000..ccd1425
--- /dev/null
+++ b/src/Graphics/WaveFront/Types.hs
@@ -0,0 +1,254 @@
+-- |
+-- Module      : Graphics.WaveFront.Types
+-- Description :
+-- Copyright   : (c) Jonatan H Sundqvist, 2015
+-- License     : MIT
+-- Maintainer  : Jonatan H Sundqvist
+-- Stability   : experimental|stable
+-- Portability : POSIX (not sure)
+--
+
+-- Created October 30 2015
+
+-- TODO | -
+--        -
+
+-- SPEC | -
+--        -
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- GHC Pragmas
+--------------------------------------------------------------------------------------------------------------------------------------------
+{-# LANGUAGE DuplicateRecordFields #-} -- I love GHC 8.0
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE DeriveFoldable        #-}
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- API
+--------------------------------------------------------------------------------------------------------------------------------------------
+module Graphics.WaveFront.Types where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Data.Functor.Classes (Show1) --Eq1, Show1, showsPrec1, eq1)
+import Data.Map as M (Map)
+import Data.Set as S (Set)
+import Linear (V2(..), V3(..))
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- OBJ parser types ------------------------------------------------------------------------------------------------------------------------
+
+-- TODO | - Add strictness annotations (?)
+
+
+-- | Represents a single (valid) OBJ token
+--
+-- TODO | - Polymorphic numerical types (?)
+--        - Add context, metadata (eg. line numbers, filename) (?)
+--        - Naming scheme (added OBJ prefix to prevent name clashes; cf. Face type)
+--        - Comment token (preserve comments in parser output or remove them) (?)
+--
+--        - Cover the entire spec (http://www.martinreddy.net/gfx/3d/OBJ.spec)
+--          (and handle unimplemented attributes gracefully)
+data OBJToken f s i m = OBJVertex   (V3 f) |
+                        OBJNormal   (V3 f) |
+                        OBJTexCoord (V2 f) |
+                        OBJFace (m (VertexIndices i)) | -- TODO: Associate material with each face, handle absent indices
+
+                        Line i i | -- Line (I'm assuming the arguments are indices to the endpoint vertices)
+
+                        UseMTL s | -- TODO: Rename (eg. 'UseMaterial') (?)
+                        LibMTL s | --
+
+                        SmoothGroup (Maybe s) | -- Smooth shading group, or Nothing if it is disabled
+
+
+                        -- TODO: Use OBJ prefix (?)
+                        Group  (Set s) | -- TODO: Do grouped faces have to be consecutive?
+                        Object (Set s)   -- TODO: What is the difference between group and object?
+                        -- deriving (Show, Eq) -- TODO: Derive Read (?)
+
+
+-- |
+-- TODO: Rename (?)
+-- TODO: Use union instead of Maybe (?)
+data VertexIndices i = VertexIndices {
+  fIvertex   :: i,
+  fItexcoord :: Maybe i,
+  fInormal   :: Maybe i
+} deriving (Show, Eq)
+
+
+-- | Output type of the OBJ parser.
+--
+-- TODO | - Rename (?)
+--        - Use Integral for line number (?)
+--
+type OBJ f s i m = m (OBJToken f s i m)
+
+-- MTL parser types ------------------------------------------------------------------------------------------------------------------------
+
+-- | Represents a single (valid) MTL token
+--
+-- TODO | - Is the alpha channel optional, ignored, disallowed?
+--        - Include support for ('Ns', 'Ni', 'd', 'Tr', 'illum')
+--        - Assume no colours have an alpha channel, since transparency is handled by the 'd' attribute (?)
+data MTLToken f s = Ambient  (Colour f) | -- Ka
+                    Diffuse  (Colour f) | -- Kd
+                    Specular (Colour f) | -- Ks
+
+                    SpecularExponent f  | -- Ns (TODO: Find out exactly what this entails)
+
+                    Illum Illumination  | -- illum (TODO: Find out what this means)
+
+                    Dissolve f          | -- d (Dissolve; transparency)
+                    Refraction f        | -- Ni (Index of refraction; optical_density)
+
+                    MapDiffuse  s | -- map_Kd
+                    MapAmbient  s | -- map_Ka
+                    NewMaterial s   -- newmtl
+                    deriving (Show, Eq)
+
+
+-- |
+-- 0. Color on and Ambient off
+-- 1. Color on and Ambient on
+-- 2. Highlight on
+-- 3. Reflection on and Ray trace on
+-- 4. Transparency: Glass on, Reflection: Ray trace on
+-- 5. Reflection: Fresnel on and Ray trace on
+-- 6. Transparency: Refraction on, Reflection: Fresnel off and Ray trace on
+-- 7. Transparency: Refraction on, Reflection: Fresnel on and Ray trace on
+-- 8. Reflection on and Ray trace off
+-- 9. Transparency: Glass on, Reflection: Ray trace off
+-- 10. Casts shadows onto invisible surfaces
+type Illumination = Int
+
+
+-- | Output type of the MTL parser. Currently a list of line number and token (or error string) pairs
+-- TODO | - Add type for processed MTL (eg. a map between names and materials)
+type MTL f s m = m (MTLToken f s) -- (line number, MTL token, comment)
+
+
+-- |
+type MTLTable f s = Map s (Map s (Material f s))
+
+-- Model -----------------------------------------------------------------------------------------------------------------------------------
+
+type Vertices  f m   = m (V3 f)
+type TexCoords f m   = m (Maybe (V2 f))
+type Normals   f m   = m (Maybe (V3 f))
+type Materials f s m = m (Material f s)
+
+-- API types -------------------------------------------------------------------------------------------------------------------------------
+
+-- |
+-- TODO | - Validation (eg. length ivertices == length == ivertices == length itextures if length isn't 0)
+--        - Pack indices in a tuple (eg. indices :: [(Int, Int, Int)]) (?)
+--        - Use (String, String) for the names of the mtl file and material instead of Material (?)
+--        - Use types so as not to confuse the indices (eg. newtype INormal, newtype ITexcoord)
+data Face f s i m = Face {
+  fIndices  :: m (VertexIndices i),
+  fMaterial :: Material f s
+} --deriving (Show, Eq)
+
+
+-- |
+-- TODO | - Use a type from the colour package instead (?)
+data Colour f = Colour {
+  fRed   :: f,
+  fGreen :: f,
+  fBlue  :: f,
+  fAlpha :: f
+} deriving (Show, Eq, Functor, Foldable)
+
+
+-- |
+-- TODO | - Do all materials have an ambient, a diffuse and a specular colour (?)
+--        - Support more attributes (entire spec) (?)
+--        - Lenses (?)
+data Material f s = Material {
+  fAmbient  :: Colour f,
+  fDiffuse  :: Colour f,
+  fSpecular :: Colour f,
+  fTexture  :: Maybe s
+} deriving (Show, Eq)
+
+
+-- | Abstract representation of an OBJ model with associated MTL definitions.
+--
+-- TODO | - Rename (?)
+--        - Include metadata, comments, rejected data (?)
+--        - Separate type for processed OBJTokens (ie. token + context)
+--        - Perform index lookups (?)
+--        - Reconsider the types (especially of the materials)
+--        - Rename accessor functions (eg. texcoords instead of textures) (?)
+--
+-- fTextures  :: Set s,
+-- data Model f s i m = Model {
+data Model f s i m = Model {
+  fVertices  :: m (V3 f),
+  fNormals   :: m (V3 f),
+  fTexcoords :: m (V2 f),
+  fFaces     :: m (Face f s i m),
+  fMaterials :: MTLTable f s,         -- TODO: Type synonym (?)
+  fGroups    :: Map (Set s) (i, i), -- TODO: Type synonym
+  fObjects   :: Map (Set s) (i, i), -- TODO: Type synonym
+  fRoot      :: Maybe FilePath        -- This is where we should look for related assets
+} -- deriving (Show, Eq)
+
+-- Monomorphic defaults --------------------------------------------------------------------------------------------------------------------
+
+
+-- Instances -------------------------------------------------------------------------------------------------------------------------------
+
+-- TODO: Use Show1, Eq1, etc. (?)
+-- deriving instance (Show1 m) => Show1 (m a)
+-- deriving instance (Show1 m) => Show1 (m a)
+-- deriving instance (Show1 m) => Show1 (m a)
+
+-- TODO: Clean this up
+
+-- showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
+deriving instance (Show1 m,
+                   Show (m f),
+                   Show (m (V2 f)),
+                   Show (m (V3 f)),
+                   Show (m (Face f s i m)),
+                   Show (m s),
+                   Show f,
+                   Show s,
+                   Show i) => Show (Model f s i m) --   where showsPrec = showsPrec1
+
+deriving instance (Show1 m,
+                   Show (m f),
+                   Show (m (VertexIndices i)),
+                   Show (m (V3 f)),
+                   Show (m s),
+                   Show f,
+                   Show s,
+                   Show i) => Show (Face  f s i m) --   where showsPrec = _
+
+deriving instance (Show1 m,
+                   Show (m f),
+                   Show (m (VertexIndices i)), 
+                   Show (m (V3 f)),
+                   Show (m s),
+                   Show f,
+                   Show s,
+                   Show i) => Show (OBJToken f s i m) -- where showsPrec = _
\ No newline at end of file
diff --git a/test/Checks.hs b/test/Checks.hs
new file mode 100644
index 0000000..67cc586
--- /dev/null
+++ b/test/Checks.hs
@@ -0,0 +1,125 @@
+--
+-- Graphics.Wavefront.Checks
+-- Executable containing checks and tests for the modules in this package
+--
+-- Jonatan H Sundqvist
+-- February 24 2015
+--
+
+-- TODO | - Use QuickCheck (?)
+--        - Full coverage
+--        - Benchmarking
+
+-- SPEC | -
+--        -
+
+
+
+module Graphics.WaveFront.Checks where
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- We'll need these
+--------------------------------------------------------------------------------------------------------------------------------------------
+import Text.Printf (printf)
+import Data.Either (lefts)
+import Data.Char (toLower)
+import System.IO (hFlush, stdout)
+
+import Control.Monad (forM_, when)
+
+import Graphics.WaveFront.Parsers (MTL, OBJ, OBJNoParse(..), MTLNoParse(..), MTLToken(..))
+import Graphics.WaveFront.Load    (loadOBJ, loadMTL)
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Functions (IO)
+--------------------------------------------------------------------------------------------------------------------------------------------
+
+-- IO utilities ----------------------------------------------------------------------------------------------------------------------------
+
+-- | 
+promptContinue :: String -> IO ()
+promptContinue prompt = do
+  putStr prompt
+  hFlush stdout
+  getChar
+  putChar '\n'
+
+
+
+-- | 
+-- 
+-- TODO: Refactor (cf. untilM)
+-- TODO: Allow flexible feedback
+-- TODO: Default return value for invalid replies (?)
+-- TODO: Customisable validation (eg. for other languages than English)
+--
+askYesNo :: String -> IO Bool
+askYesNo q = do
+  putStr q
+  hFlush stdout
+  answer <- getLine
+  affirmed $ map toLower answer
+  where affirmed answer | answer `elem` ["yes", "y", "yeah"] = return True
+                        | answer `elem` ["no", "n", "nah"]   = return False
+                        | otherwise                          = askYesNo "I don't understand. Answer 'yes' or 'no': "
+  -- return [(`elem` ["yes", "y", "yeah"]), (`elem` "no", "n", "nah")]
+
+
+-- |
+askPerformAction :: String -> IO () -> IO ()
+askPerformAction q action = do
+  affirmed <- askYesNo q
+  when affirmed action
+
+
+-- |
+showTokens :: Show a => [(Int, Either MTLNoParse a, String)] -> IO ()
+showTokens materials = mapM_ (uncurry $ printf "[%d] %s\n") [ (n, show token) | (n, Right token, comment) <- materials ] -- TODO: cf. line 65
+
+
+
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- Entry point
+--------------------------------------------------------------------------------------------------------------------------------------------
+-- | 
+--
+-- TODO: Print culprit lines (✓)
+--
+main :: IO ()
+main = do
+  putStrLn "This is where the checks should be."
+
+  let path = "C:/Users/Jonatan/Desktop/Python/experiments/WaveFront/"
+
+  forM_ ["queen", "cube"] $ \ fn -> do
+    printf "\nParsing OBJ file: %s.obj\n" fn
+    model <- loadOBJ $ printf (path ++ "data/%s.obj") fn
+    -- TODO: Utility for partioning a list based on several predicates ([a] -> [a -> Bool] -> [[a]])
+    -- TODO: Utilities for displaying output and asking for input
+    -- TODO: Oh, the efficiency!
+    -- TODO: Less ugly naming convention for monadic functions which ignore the output (cf. mapM_, forM_, etc.)
+    let unparsed = lefts $ map second model
+    let comments = [ c | c@(OBJComment _) <- unparsed ]
+    let blanks   = [ c | c@(OBJEmpty)     <- unparsed ]
+    let errors   = length unparsed - (length comments + length blanks)
+    printf "Found %d invalid rows in OBJ file (%d comments, %d blanks, %d errors).\n" (length unparsed) (length comments) (length blanks) errors
+    when (length unparsed > 0) . askPerformAction "Would you like to see view them (yes/no)? " $ putStrLn "Ok, here they are:" >> mapM_ print unparsed
+
+    promptContinue "Press any key to continue..."
+
+    mapM (uncurry $ printf "[%d] %s\n") [ (n, show token) | (n, Right token, comment) <- model ]
+    -- TODO: Print culprit lines (✓)
+
+    promptContinue "Press any key to continue..."
+
+    printf "\nParsing MTL file: %s.mtl\n" fn
+    materials <- loadMTL $ printf "%sdata/%s.mtl" path fn
+    printf "Found %d invalid rows in MTL file (n comments, m blanks, o errors).\n" . length . lefts $ map second materials
+    showTokens materials
+
+    promptContinue "Press any key to continue..."
+    where second (_, b, _) = b
\ No newline at end of file
diff --git a/upstream/.collada-types b/upstream/.collada-types
new file mode 100644
index 0000000..7611918
--- /dev/null
+++ b/upstream/.collada-types
@@ -0,0 +1,27 @@
+Name:               collada-types

+Version:            0.3

+Synopsis:           Data exchange between graphic applications

+Description:        Collada is the standard graphics format for data exchange between 3d tools. As well as the file format also its representation as an algebraic data type could be used to make libraries more composable. Please propose changes.

+category:           graphics

+License:            BSD3

+License-file:       LICENSE

+Author:             Tillmann Vogt

+Maintainer:         tillk.vogt@googlemail.com

+Build-Type:         Simple

+Cabal-Version:    >=1.6

+

+Library

+    hs-source-dirs: src

+    build-depends:

+        base ==4.*,

+        containers,

+        OpenGL >= 2.2.3.0,

+        enumerable,

+        tuple-gen,

+        vector,

+        tuple

+    exposed-modules:

+        Graphics.Formats.Collada.ColladaTypes

+        Graphics.Formats.Collada.GenerateObjects

+        Graphics.Formats.Collada.Transformations

+        Graphics.Formats.Collada.Vector2D3D

diff --git a/upstream/CHANGELOG.md.wavefront b/upstream/CHANGELOG.md.wavefront
new file mode 100644
index 0000000..8458aec
--- /dev/null
+++ b/upstream/CHANGELOG.md.wavefront
@@ -0,0 +1,96 @@
+#### 0.7.1.3
+
+  - Add support for GHC.8.6.1.
+
+#### 0.7.1.2
+
+  - Add support for GHC.8.4.1.
+
+#### 0.7.1.1
+
+  - Add support for GHC 8.2.1.
+
+### 0.7.1
+
+  - Allow missing group names.
+  - Spaced object and material names are now supported.
+
+#### 0.7.0.2
+
+  - Add support for `vector-0.12.0.0`.
+
+#### 0.7.0.2
+
+  - Add support for GHC 8.
+
+#### 0.7.0.1
+
+  - Add support for `dlist-0.8`.
+
+## 0.7
+
+  - Change `Element` constructor by adding `elSmoothingGroup`.
+
+## 0.6
+
+  - `Face` has just a single constructor now; pattern synonmys are available to pattern match against
+    `Triangle` and `Quad`.
+
+## 0.5.1
+
+  - Export all useful constructors and symbols.
+
+# 0.5
+
+#### Breaking changes
+
+  - `objFaces` now contain structured faces of type `Face`. A `Face` can be:
+    * a `Triangle` ;
+    * a `Quad` ;
+    * an arbritrary `Polygon`.
+    Whatever the shape of the face, it holds several `FaceIndex` used to reference locations, normals
+    and texture coordinates.
+  - Ditto for `objLines`.
+
+### 0.4.0.1
+
+  - Fix a bug in the implementation of `untilEnd`.
+
+# 0.4
+
+  - Remove most modules from the exposed interface. Everything can be found in Codec.Wavefront.
+  - Change internal structures of a few types. The structure of those types shouldn’t be used in the
+    interface, so a few functions to access them was provided.
+
+# 0.3
+
+#### Breaking changes
+
+  - Change the interface to manipulate `WavefrontOBJ`. It’s now a dedicated type with `Vector`
+    instead of `DList`, which is way better.
+
+# 0.2
+
+#### Non-breaking changes
+
+  - Add more verbose documentation everywhere.
+
+#### Breaking changes
+
+  - Remove `ctxtName`. It was an old function used to implement user-defined
+    objects, but since we have `Element`, we don’t need those anymore.
+
+### 0.1.0.2
+
+  - Change the loop of `tokenize` from `many1` to `untilEnd` (internal parser in Token.hs). That’s
+    due to the fact `many1` silently ignores failures while `untilEnd` does not.
+  - Change implementation of `tokenize` to use `choice`, which is implemented exactly as we had.
+  - Remove `identifier` and use `name` instead to relax conditions on formatting names.
+
+### 0.1.0.1
+
+  - Add forgotten Codec.Wavefront.
+
+# 0.1
+
+  - Initial revision.
diff --git a/upstream/LICENSE.collada-types b/upstream/LICENSE.collada-types
new file mode 100644
index 0000000..ceedb12
--- /dev/null
+++ b/upstream/LICENSE.collada-types
@@ -0,0 +1,11 @@
+Copyright (c) 2010, Tillmann Vogt

+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.

+The names of its 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 HOLDER 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.

+

+

diff --git a/upstream/LICENSE.md.3DWaves b/upstream/LICENSE.md.3DWaves
new file mode 100644
index 0000000..dfde98e
--- /dev/null
+++ b/upstream/LICENSE.md.3DWaves
@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c)  2015 Jonatan H Sundqvist
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
\ No newline at end of file
diff --git a/upstream/LICENSE.triangulation b/upstream/LICENSE.triangulation
new file mode 100644
index 0000000..ceedb12
--- /dev/null
+++ b/upstream/LICENSE.triangulation
@@ -0,0 +1,11 @@
+Copyright (c) 2010, Tillmann Vogt

+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.

+The names of its 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 HOLDER 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.

+

+

diff --git a/upstream/LICENSE.wavefront b/upstream/LICENSE.wavefront
new file mode 100644
index 0000000..7625764
--- /dev/null
+++ b/upstream/LICENSE.wavefront
@@ -0,0 +1,30 @@
+Copyright (c) 2015, Dimitri Sabadie <dimitri.sabadie@gmail.com>
+
+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 Dimitri Sabadie <dimitri.sabadie@gmail.com> 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.
diff --git a/upstream/README.md.3DWaves b/upstream/README.md.3DWaves
new file mode 100644
index 0000000..e927579
--- /dev/null
+++ b/upstream/README.md.3DWaves
@@ -0,0 +1,44 @@
+3DWaves
+=======
+
+This is a personal project, still in its infancy, and I don't expect anybody else to use it. Should somehow happen upon this site, I would however welcome their support and feedback.
+
+## Contents
+Wavefront OBJ parsers and related amenities. Includes purely functional parsers
+and IO utilities for loading models from files.
+
+Supports the basic MTL and OBJ attributes. My ambition is to add full support for the entire specification.
+
+Please note that this package is *completely unaware of rendering and graphics*. The data structures generated by the parsers are oblivious to technologies such as Direct3D and OpenGL; creating eg. GPU buffers is up to the client.
+
+I may at some point implement the FFI and add direct OpenGL support, in separate modules.
+
+## Examples
+
+
+## Maintainers
+Jonatan H Sundqvist
+
+## TODO
+
+See source files (.hs) for additional items.
+
+- [ ] Performance (currently, it's atrocious) (...)
+      - Parallelism (...)
+- [ ] Add sample models and demos (...)
+- [ ] Add profiling and checks (cf. QuickCheck)
+      - Travis-CI integration
+- [x] GHCi support (added .ghci file, works quite well)
+- [x] Proper ticket system ([here](https://github.com/SwiftsNamesake/3DWaves/issues/))
+- [ ] Polymorphism (...)
+- [ ] Querying
+      - Asking questions about a particular model (bounds, storage, number of faces, material types, etc.)
+      - Asking questions about the OBJ and MTL formats (eg. 'what does the various illum values mean')
+      - Screenshots (maybe in the wavefront-render package)
+- [ ] Serialising (eg. writing to OBJ and MTL)
+- [ ] Rendering
+      - Create a separate package (wavefront-render) with an OpenGL backend
+- [ ] Executables
+      - OBJ viewer (...)
+      - Command line tool (?)
+- [ ] Foreign function interface
\ No newline at end of file
diff --git a/upstream/Setup.hs.3DWaves b/upstream/Setup.hs.3DWaves
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/upstream/Setup.hs.3DWaves
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/upstream/Setup.hs.collada-types b/upstream/Setup.hs.collada-types
new file mode 100644
index 0000000..9ea3a9e
--- /dev/null
+++ b/upstream/Setup.hs.collada-types
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell

+import Distribution.Simple

+main = defaultMain
\ No newline at end of file
diff --git a/upstream/Setup.hs.triangulation b/upstream/Setup.hs.triangulation
new file mode 100644
index 0000000..9ea3a9e
--- /dev/null
+++ b/upstream/Setup.hs.triangulation
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell

+import Distribution.Simple

+main = defaultMain
\ No newline at end of file
diff --git a/upstream/Setup.hs.wavefront b/upstream/Setup.hs.wavefront
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/upstream/Setup.hs.wavefront
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/upstream/WaveFront2.cabal.3DWaves b/upstream/WaveFront2.cabal.3DWaves
new file mode 100644
index 0000000..e2a54dc
--- /dev/null
+++ b/upstream/WaveFront2.cabal.3DWaves
@@ -0,0 +1,110 @@
+-- Initial WaveFront.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name:                WaveFront2
+
+-- The package version.  See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.5.0.0
+
+-- A short (one-line) description of the package.
+synopsis:            Parsers and utilities for the OBJ WaveFront 3D model format
+
+-- A longer description of the package.
+-- description:
+
+-- The license under which the package is released.
+license:             MIT
+
+-- The file containing the license text.
+license-file:        LICENSE.md
+
+-- The package <div class=""><s></s></div>
+author:              Jonatan H Sundqvist
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer:          jonatanhsundqvist@gmail.com
+
+-- A copyright notice.
+-- copyright:
+
+category:            Graphics
+
+build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+extra-source-files:  README.md
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.10
+
+
+flag pedantic
+  description: Enable warnings
+  default:     True
+
+
+flag optimise
+  description: Enable optimisations
+  -- TODO: Should probably be True
+  default:     False
+
+
+flag profile
+  description: Enable profiling options
+  default:     False
+
+
+source-repository head
+  type:     git
+  -- TODO: Rename the GitHub repo (?)
+  location: https://github.com/swiftsnamesake/3DWaves
+
+
+library
+  -- Modules exported by the library.
+  exposed-modules:     Graphics.WaveFront,
+                       Graphics.WaveFront.Types,
+                       Graphics.WaveFront.Lenses,
+                       Graphics.WaveFront.Parse,
+                       Graphics.WaveFront.Load,
+                       Graphics.WaveFront.Foreign,
+                       Graphics.WaveFront.Model
+
+  -- Modules included in this library but not exported.
+  other-modules:       Graphics.WaveFront.Parse.Common,
+                       Graphics.WaveFront.Parse.OBJ,
+                       Graphics.WaveFront.Parse.MTL
+
+  -- Compiler arguments
+  ghc-options:         -Wall -ddump-splices
+
+  -- LANGUAGE extensions used by modules in this package.
+  -- TODO: This list is incomplete
+  other-extensions:    UnicodeSyntax, TupleSections, ForeignFunctionInterface
+
+  -- Other library packages from which modules are imported.
+  build-depends:         base == 4.*
+                       , lens
+                       , transformers
+                       , linear
+                       , vector
+                       , text
+                       , attoparsec
+                       , filepath
+                       , containers
+                       , QuickCheck
+                       , Cartesian
+
+  -- Directories containing source files.
+  hs-source-dirs:      src
+
+  -- Base language which the package is written in.
+  default-language:    Haskell2010
diff --git a/upstream/collada-types.cabal.collada-types b/upstream/collada-types.cabal.collada-types
new file mode 100644
index 0000000..7611918
--- /dev/null
+++ b/upstream/collada-types.cabal.collada-types
@@ -0,0 +1,27 @@
+Name:               collada-types

+Version:            0.3

+Synopsis:           Data exchange between graphic applications

+Description:        Collada is the standard graphics format for data exchange between 3d tools. As well as the file format also its representation as an algebraic data type could be used to make libraries more composable. Please propose changes.

+category:           graphics

+License:            BSD3

+License-file:       LICENSE

+Author:             Tillmann Vogt

+Maintainer:         tillk.vogt@googlemail.com

+Build-Type:         Simple

+Cabal-Version:    >=1.6

+

+Library

+    hs-source-dirs: src

+    build-depends:

+        base ==4.*,

+        containers,

+        OpenGL >= 2.2.3.0,

+        enumerable,

+        tuple-gen,

+        vector,

+        tuple

+    exposed-modules:

+        Graphics.Formats.Collada.ColladaTypes

+        Graphics.Formats.Collada.GenerateObjects

+        Graphics.Formats.Collada.Transformations

+        Graphics.Formats.Collada.Vector2D3D

diff --git a/upstream/stack.yaml.3DWaves b/upstream/stack.yaml.3DWaves
new file mode 100644
index 0000000..e556138
--- /dev/null
+++ b/upstream/stack.yaml.3DWaves
@@ -0,0 +1,7 @@
+flags: {}
+packages:
+- '.'
+- location: C:/Users/Jonatan/Desktop/Haskell/modules/Cartesian
+- location: C:/Users/Jonatan/Desktop/Haskell/modules/Leibniz
+extra-deps: []
+resolver: lts-7.0
diff --git a/upstream/stack.yaml.wavefront b/upstream/stack.yaml.wavefront
new file mode 100644
index 0000000..67e6a64
--- /dev/null
+++ b/upstream/stack.yaml.wavefront
@@ -0,0 +1,10 @@
+resolver: nightly-2018-10-16
+
+packages:
+- '.'
+
+extra-deps: []
+
+flags: {}
+
+extra-package-dbs: []
diff --git a/upstream/triangulation.cabal.triangulation b/upstream/triangulation.cabal.triangulation
new file mode 100644
index 0000000..9cfb8c5
--- /dev/null
+++ b/upstream/triangulation.cabal.triangulation
@@ -0,0 +1,26 @@
+Name:             triangulation

+Version:          0.3

+Synopsis:         triangulation of polygons

+Description:      An implementation of a simple triangulation algorithm for polygons without crossings (holes are possible). The code is explained her: <www.dinkla.net/download/GeomAlgHaskell.pdf>.

+category:         Graphics

+License:          BSD3

+License-file:     LICENSE

+Author:           Joern Dinkla, Tillmann Vogt

+Maintainer:       tillk.vogt@googlemail.com

+Homepage:         http://www.dinkla.net/

+Build-Type:       Simple

+Cabal-Version:    >=1.6

+

+Library

+    hs-source-dirs: src

+    build-depends:

+        base == 4.*,

+        array,

+        collada-types >= 0.3,

+        vector,

+        vector-algorithms,

+        tuple

+    exposed-modules:

+        Graphics.Triangulation.Triangulation

+        Graphics.Triangulation.KETTriangulation

+        Graphics.Triangulation.GJPTriangulation

diff --git a/upstream/wavefront.cabal.wavefront b/upstream/wavefront.cabal.wavefront
new file mode 100644
index 0000000..95f5118
--- /dev/null
+++ b/upstream/wavefront.cabal.wavefront
@@ -0,0 +1,54 @@
+name:                wavefront
+version:             0.7.1.3
+synopsis:            Wavefront OBJ loader
+description:         A Wavefront OBJ loader. Currently supports polygonal information. More could
+                     be added if needed (like curves and surface) if people contribute. Feel free
+                     to help!
+homepage:            https://github.com/phaazon/wavefront
+bug-reports:         https://github.com/phaazon/wavefront/issues
+license:             BSD3
+license-file:        LICENSE
+author:              Dimitri Sabadie <dimitri.sabadie@gmail.com>
+maintainer:          Dimitri Sabadie <dimitri.sabadie@gmail.com>
+copyright:           Dimitri Sabadie
+
+category:            Codec
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+cabal-version:       >= 1.10
+
+source-repository head
+  type:     git
+  location: git://github.com/phaazon/wavefront.git
+
+library
+  ghc-options:         -W -Wall
+
+  exposed-modules:     Codec.Wavefront
+                     , Codec.Wavefront.Element
+                     , Codec.Wavefront.Face
+                     , Codec.Wavefront.IO
+                     , Codec.Wavefront.Location
+                     , Codec.Wavefront.Line
+                     , Codec.Wavefront.Normal
+                     , Codec.Wavefront.Object
+                     , Codec.Wavefront.Point
+                     , Codec.Wavefront.TexCoord
+
+  other-modules:       Codec.Wavefront.Token
+                     , Codec.Wavefront.Lexer
+
+  default-extensions:  OverloadedStrings
+
+  build-depends:       base         >= 4.8  && < 4.13
+                     , attoparsec   >= 0.13 && < 0.14
+                     , dlist        >= 0.7  && < 0.9
+                     , filepath     >= 1.4  && < 1.5
+                     , mtl          >= 2.2  && < 2.3
+                     , text         >= 1.2  && < 1.3
+                     , transformers >= 0.4  && < 0.6
+                     , vector       >= 0.11 && < 0.13
+
+  hs-source-dirs:      src
+
+  default-language:    Haskell2010