obj 0.1.1 → 0.1.2
raw patch · 5 files changed
+82/−61 lines, 5 files
Files
- obj.cabal +1/−2
- src/Graphics/Formats/Mtl/Contents.hs +37/−0
- src/Graphics/Formats/Obj/Contents.hs +29/−43
- src/Graphics/Formats/Obj/ObjModel.hs +14/−14
- src/Graphics/Formats/Obj/ParserBits.hs +1/−2
obj.cabal view
@@ -1,6 +1,6 @@ Name: obj Cabal-Version: >= 1.2-Version: 0.1.1+Version: 0.1.2 Synopsis: Reads and writes obj models. Description: Reads and writes obj models. License: BSD3@@ -34,7 +34,6 @@ Codec-Image-DevIL >= 0.1, InfixApplicative >= 1.0 Hs-Source-Dirs: src- Ghc-Options: -O2 Exposed-Modules: Graphics.Formats.Obj Other-Modules: Graphics.Formats.Obj.Parse Graphics.Formats.Obj.ParserBits
src/Graphics/Formats/Mtl/Contents.hs view
@@ -23,6 +23,10 @@ import qualified Data.Traversable as T import Data.List +import Foreign hiding (newArray)++import Data.Array.Unboxed+ import Graphics.Rendering.OpenGL import Control.Applicative import Control.Monad@@ -109,6 +113,39 @@ loadTexture :: FilePath -> IO TextureObject loadTexture f = buildTexture =<< readImage f++{- Andy Gill's hacky texture loading code -}+buildTexture :: UArray (Int,Int,Int) Word8 -> IO TextureObject+buildTexture arr =+ do let (width,height,mindepth) =+ case bounds arr of+ ((mw,mh,md),(w,h,_)) -> (w + 1 - mw,h + 1 - mh, md)+ p <- mallocBytes (width * height * 4)+ sequence_+ [ do pokeElemOff p (off+0) (arr ! (w,h,mindepth ))+ pokeElemOff p (off+1) (arr ! (w,h,mindepth+1))+ pokeElemOff p (off+2) (arr ! (w,h,mindepth+2))+ pokeElemOff p (off+3) (arr ! (w,h,mindepth+3))+ | (off,(w,h)) <- zip [0,4 ..] [ (w,h) | w <- [ 0 .. width - 1 ]+ , h <- [ 0 .. height - 1 ]]+ ]+ + texName <- liftM head (genObjectNames 1)+ textureBinding Texture2D $= Just texName+ textureFilter Texture2D $= ((Linear', Nothing), Linear')+ + textureWrapMode Texture2D S $= (Repeated, Repeat)+ textureWrapMode Texture2D T $= (Repeated, Repeat) + + let pd = PixelData RGBA UnsignedByte p+ texImage2D Nothing+ NoProxy+ 0+ RGBA'+ (TextureSize2D (fromIntegral width) (fromIntegral height))+ 0+ pd+ return texName setName :: Material -> CBS.ByteString -> Material setName m n = m {name = n}
src/Graphics/Formats/Obj/Contents.hs view
@@ -31,17 +31,17 @@ deriving (Show,Eq) instance Arbitrary ObjFile where- arbitrary = liftM OF arbitrary+ arbitrary = OF <$> arbitrary coarbitrary (OF x) = coarbitrary x -data Statement = V !Float !Float !Float !Float- | VN !Float !Float !Float- | VT !Float !Float !Float- | P ![Int]- | L ![VDouble]- | F ![VTriple]- | G ![Group]- | SG !Int+data Statement = V !Float !Float !Float !Float+ | VN !Float !Float !Float+ | VT !Float !Float !Float+ | P ![Int]+ | L ![VDouble]+ | F ![VTriple]+ | G ![Group]+ | SG !Int | MtlLib ![CBS.ByteString] | UseMtl !CBS.ByteString deriving (Show,Read,Eq)@@ -81,43 +81,29 @@ coarbitrary (VTr v t n) = coarbitrary v . coarbitrary t . coarbitrary n instance Arbitrary VDouble where- arbitrary = VD <$> positive <*> maybeGen positive+ arbitrary = VD <$> positive <*> maybeGen positive coarbitrary (VD v t) = coarbitrary v . coarbitrary t -isNormal :: Statement -> Bool-isNormal (VN _ _ _) = True-isNormal _ = False--isTexCoord :: Statement -> Bool-isTexCoord (VT _ _ _) = True-isTexCoord _ = False--isVertex :: Statement -> Bool-isVertex (V _ _ _ _) = True-isVertex _ = False--isPoints :: Statement -> Bool-isPoints (P _) = True-isPoints _ = False--isLines :: Statement -> Bool-isLines (L _) = True-isLines _ = False--isFace :: Statement -> Bool-isFace (F _) = True-isFace _ = False--isObject :: Statement -> Bool-isObject = isFace <^(||)^> isLines <^(||)^> isPoints--isUseMtl :: Statement -> Bool-isUseMtl (UseMtl _) = True-isUseMtl _ = False+isNormal, isTexCoord, isVertex, isPoints , isLines :: Statement -> Bool+isFace , isObject , isUseMtl, isSmoothG :: Statement -> Bool -isSmoothG :: Statement -> Bool-isSmoothG (SG _) = True-isSmoothG _ = False+isNormal (VN _ _ _ ) = True+isNormal _ = False+isTexCoord (VT _ _ _ ) = True+isTexCoord _ = False+isVertex (V _ _ _ _) = True+isVertex _ = False+isPoints (P _ ) = True+isPoints _ = False+isLines (L _ ) = True+isLines _ = False+isFace (F _ ) = True+isFace _ = False+isUseMtl (UseMtl _ ) = True+isUseMtl _ = False+isSmoothG (SG _ ) = True+isSmoothG _ = False+isObject = isFace <^(||)^> isLines <^(||)^> isPoints contentsTests :: IO () contentsTests = return ()
src/Graphics/Formats/Obj/ObjModel.hs view
@@ -108,8 +108,10 @@ texturedGroups = groupBy ((==) `on` texID) . sortBy (compare `on` texID) $ textured- in do colorMaterial $= Just (Front, AmbientAndDiffuse)- mapM_ (renderOs bs) (unTextured:texturedGroups)+ in preservingAttrib+ [AllServerAttributes]+ (do colorMaterial $= Just (Front, AmbientAndDiffuse)+ mapM_ (renderOs bs) (unTextured:texturedGroups)) renderOs :: BufferSet -> [FObject] -> IO () renderOs bs os =@@ -300,7 +302,7 @@ -> IObject -> ([FObject],[Normal3 GLfloat],Int) objectNormals loff vb (os,ns,nns) o =- (go : os, gns ++ ns, nns + vl)+ (go : os, gns ++ ns, nns + vl) where go = applyNormals normalMap o normalMap = IM.fromList $ zip vs [(loff - nns - vl)..]@@ -320,13 +322,13 @@ -> [IObject] -> ([FObject],[Normal3 GLfloat],Int) smoothGroup loff vb (os,ns,nns) g =- (gos ++ os,gns ++ ns, nns + lgn)+ (gos ++ os, gns ++ ns, nns + lgn) where- gos = map (applyNormals normalMap) g+ gos = map (applyNormals normalMap) g normalMap = IM.fromList $ zip vs [(loff - nns - lgn)..]- gns = map (makeNormal vb g) vs- lgn = length gns- vs = concatMap objVerticies g+ gns = map (makeNormal vb g) vs+ lgn = length gns+ vs = concatMap objVerticies g applyNormals :: IntMap Int -> IObject -> FObject applyNormals m (OFace mat vs) = OFace mat (appNorms m vs)@@ -447,8 +449,7 @@ (t >>= return . ((flip (-)) to)) (n-no)) ts offsetObj vo _ to (OLine ts) =- OLine $ map (\(VD v t) -> VD (v-vo)- (t >>= return . ((flip (-)) to))) ts+ OLine $ map (\(VD v t) -> VD (v-vo) (t >>= return . ((flip (-)) to))) ts offsetObj vo _ _ (OPoint ts) = OPoint $ map ((flip (-)) vo) ts @@ -460,8 +461,7 @@ ,map writeObject (offsetObjects (-1) (-1) (-1) os)] where writeBuffer :: (a -> Statement) -> Array Int a -> [Statement]- writeBuffer f b =- map f $ elems b+ writeBuffer f = map f . elems writeObject :: FObject -> Statement writeObject (OFace _ fs) = F (map nvToVTriple fs) writeObject (OTriangle _ fs) = F (map nvToVTriple fs)@@ -484,10 +484,10 @@ vToVertex _ = error "Obj statement was not a vertex." vertexToV :: Vertex4 GLfloat -> Statement-vertexToV (Vertex4 x y z w) = V x y z w+vertexToV (Vertex4 x y z w) = V x y z w normalToVN :: Normal3 GLfloat -> Statement-normalToVN (Normal3 i j k) = VN i j k+normalToVN (Normal3 i j k) = VN i j k texCoordToVT :: TexCoord2 GLfloat -> Statement texCoordToVT (TexCoord2 u v) = VT u v 0.0
src/Graphics/Formats/Obj/ParserBits.hs view
@@ -73,8 +73,7 @@ consumeWS = CBS.dropWhile ((==' ') <^(||)^> (=='\t')) firstWord :: CBS.ByteString -> CBS.ByteString-firstWord = CBS.takeWhile ( not- . anyOf [(==' '), (=='\t'), (=='\n'), (=='\r')])+firstWord = CBS.takeWhile (not . anyOf [(==' '), (=='\t'), (=='\n'), (=='\r')]) parseName :: CBS.ByteString -> CBS.ByteString parseName = firstWord . consumeWS