MOre or less working obj translator
Getty Ritter
8 years ago
| 4 | 4 |
module Utmyen.Model.Type where
|
| 5 | 5 |
|
| 6 | 6 |
import Data.Bits
|
| 7 | |
import Data.Serialize
|
| 7 |
import Data.ByteString
|
| 8 |
import Data.Serialize hiding (encode)
|
| 8 | 9 |
import Data.Vector (Vector)
|
| 9 | 10 |
import qualified Data.Vector as V
|
| 10 | 11 |
import Data.Word
|
|
| 21 | 22 |
match :: Bits t => t -> t -> Bool
|
| 22 | 23 |
match mask el = mask .&. el == mask
|
| 23 | 24 |
|
| 25 |
encode :: Model -> ByteString
|
| 26 |
encode m = runPut (rModel m)
|
| 27 |
|
| 24 | 28 |
rInt :: Word64 -> Put
|
| 25 | 29 |
rInt n
|
| 26 | 30 |
| 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"
|
| 28 | 39 |
|
| 29 | 40 |
pInt :: Get Word64
|
| 30 | 41 |
pInt = do
|
|
| 84 | 95 |
return (fromIntegral b1 - 32.0)
|
| 85 | 96 |
|
| 86 | 97 |
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
|
| 88 | 108 |
|
| 89 | 109 |
pU :: Get Float
|
| 90 | 110 |
pU = do
|
| 1 | |
name: gdritter
|
| 1 |
name: utmyen
|
| 2 | 2 |
version: 0.1.0.0
|
| 3 | 3 |
-- synopsis:
|
| 4 | 4 |
-- description:
|
|
| 17 | 17 |
build-depends: base >=4.7 && <4.9
|
| 18 | 18 |
, cereal
|
| 19 | 19 |
, vector
|
| 20 |
, bytestring
|
| 20 | 21 |
default-language: Haskell2010
|
| 21 | 22 |
default-extensions: OverloadedStrings,
|
| 22 | 23 |
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)
|