gdritter repos model-utm / c2c0071
MOre or less working obj translator Getty Ritter 7 years ago
3 changed file(s) with 65 addition(s) and 4 deletion(s). Collapse all Expand all
44 module Utmyen.Model.Type where
55
66 import Data.Bits
7 import Data.Serialize
7 import Data.ByteString
8 import Data.Serialize hiding (encode)
89 import Data.Vector (Vector)
910 import qualified Data.Vector as V
1011 import Data.Word
2122 match :: Bits t => t -> t -> Bool
2223 match mask el = mask .&. el == mask
2324
25 encode :: Model -> ByteString
26 encode m = runPut (rModel m)
27
2428 rInt :: Word64 -> Put
2529 rInt n
2630 | n <= 0x7f = putWord8 (fromIntegral n)
27 | otherwise = undefined
31 | n <= 0x3fff = do
32 putWord8 (fromIntegral (n `shift` (-8)) .|. 0x80)
33 putWord8 (fromIntegral n)
34 | n <= 0x1fffff = do
35 putWord8 (fromIntegral (n `shift` (-16)) .|. 0xc0)
36 putWord8 (fromIntegral (n `shift` (-8)))
37 putWord8 (fromIntegral n)
38 | otherwise = error "XXX finish me"
2839
2940 pInt :: Get Word64
3041 pInt = do
8495 return (fromIntegral b1 - 32.0)
8596
8697 rF :: Float -> Put
87 rF _ = putWord8 0
98 rF f
99 | truncate (f * 100) == (truncate f :: Int) * 100
100 && f >= -32.0 && f <= 95.0 =
101 putWord8 (truncate (f + 32.0))
102 | otherwise = do
103 let ws :: Word16 = truncate ((f + 128.0) * 102.0)
104 l1 = fromIntegral (ws `shift` (-8)) .|. 0x80
105 l2 = fromIntegral ws
106 putWord8 l1
107 putWord8 l2
88108
89109 pU :: Get Float
90110 pU = do
1 name: gdritter
1 name: utmyen
22 version: 0.1.0.0
33 -- synopsis:
44 -- description:
1717 build-depends: base >=4.7 && <4.9
1818 , cereal
1919 , vector
20 , bytestring
2021 default-language: Haskell2010
2122 default-extensions: OverloadedStrings,
2223 ScopedTypeVariables
24
25 executable obj2utm
26 ghc-options: -Wall
27 default-language: Haskell2010
28 build-depends: base, utmyen, wavefront, vector, bytestring
29 hs-source-dirs: obj2utm
30 main-is: Main.hs
1 {-# LANGUAGE RecordWildCards #-}
2
3 module Main where
4
5 import Codec.Wavefront
6 import qualified Data.ByteString as BS
7 import Data.Vector ((!))
8 import qualified Data.Vector as V
9 import System.Environment (getArgs)
10 import qualified Utmyen.Model.Type as U
11
12 main :: IO ()
13 main = do
14 args <- getArgs
15 case args of
16 [] -> putStrLn "Usage: obj2utm [file]"
17 (f:_) -> do
18 Right WavefrontOBJ { .. } <- fromFile f
19 let mkPoly (FaceIndex { faceLocIndex = i
20 , faceTexCoordIndex = Just j
21 , faceNorIndex = Just k }) =
22 U.Point x y z a b c u v
23 where Location x y z _ = objLocations ! (i - 1)
24 TexCoord u v _ = objTexCoords ! (j - 1)
25 Normal a b c = objNormals ! (k - 1)
26 let polys = [ [ mkPoly a, mkPoly b, mkPoly c ]
27 | Element { elValue = Face a b c [] } <- V.toList objFaces
28 ]
29 polys' = concat polys
30 let model = U.Model { U.modelPoints = V.fromList polys'
31 , U.modelTris = V.fromList [0..fromIntegral (length polys') - 1]
32 }
33 BS.putStr (U.encode model)