module Data.WavefrontObj.Types (
WavefrontParser
, runWavefrontParser
, debugWavefrontParser
, WavefrontVertex(..)
, WavefrontFace'(..)
, WavefrontFace
, WavefrontModel'(..)
, WavefrontModel
, getVertexPoint
, appendVertexPoint
, getTextureCoordinate
, appendTextureCoordinate
, getVertexNormal
, appendVertexNormal
) where
import Control.Applicative
import Control.Monad.Trans.State.Strict
import Data.Attoparsec.Text
import Data.Sequence ((|>))
import qualified Data.Sequence as S
import qualified Data.Text as T
import Linear.Affine
import Linear.V2
import Linear.V3
type WavefrontParser a = StateT WavefrontState Parser a
runWavefrontParser :: WavefrontParser a -> T.Text -> Either String a
runWavefrontParser p = parseOnly (evalStateT p emptyWavefrontState)
debugWavefrontParser :: WavefrontParser a -> T.Text -> Either String (a, WavefrontState)
debugWavefrontParser p = parseOnly (runStateT p emptyWavefrontState)
data WavefrontState = WavefrontState {
_vertexPoints :: !(S.Seq (Point V3 Double))
, _textureCoordinates :: !(S.Seq (Point V2 Double))
, _vertexNormals :: !(S.Seq (V3 Double))
}
deriving (Show, Eq)
emptyWavefrontState :: WavefrontState
emptyWavefrontState = WavefrontState (S.empty) (S.empty) (S.empty)
data WavefrontVertex = WavefrontVertex {
_vertexPoint :: !(Point V3 Double)
, _textureCoordinate :: !(Maybe (Point V2 Double))
, _vertexNormal :: !(Maybe (V3 Double))
}
deriving (Show, Eq)
newtype WavefrontFace' a = WavefrontFace [a]
deriving (Show, Eq, Functor, Foldable)
type WavefrontFace = WavefrontFace' WavefrontVertex
newtype WavefrontModel' a = WavefrontModel [a]
deriving (Show, Eq, Functor, Foldable)
type WavefrontModel = WavefrontModel' WavefrontFace
getVertexPoint :: (Monad m) => Int -> StateT WavefrontState m (Point V3 Double)
getVertexPoint idx' = do
vertexPoints <- _vertexPoints <$> get
let idx = if idx' > 0
then idx'
else idx' + (S.length vertexPoints) + 1
if (idx > S.length vertexPoints) || (idx <= 0)
then fail $ "Invalid model! Vertex point at index " ++ show idx' ++ " doesn't exist."
else return $ S.index vertexPoints (idx 1)
appendVertexPoint :: (Monad m) => Point V3 Double -> StateT WavefrontState m ()
appendVertexPoint p = do
curState <- get
put $ curState { _vertexPoints = (_vertexPoints curState) |> p }
getTextureCoordinate :: (Monad m) => Int -> StateT WavefrontState m (Point V2 Double)
getTextureCoordinate idx' = do
textureCoordinates <- _textureCoordinates <$> get
let idx = if idx' > 0
then idx'
else idx' + (S.length textureCoordinates) + 1
if (idx > S.length textureCoordinates) || (idx <= 0)
then fail $ "Invalid model! Texture coordinate at index " ++ show idx' ++ " doesn't exist."
else return $ S.index textureCoordinates (idx 1)
appendTextureCoordinate :: (Monad m) => Point V2 Double -> StateT WavefrontState m ()
appendTextureCoordinate t = do
curState <- get
put $ curState { _textureCoordinates = (_textureCoordinates curState) |> t }
getVertexNormal :: (Monad m) => Int -> StateT WavefrontState m (V3 Double)
getVertexNormal idx' = do
vertexNormals <- _vertexNormals <$> get
let idx = if idx' > 0
then idx'
else idx' + (S.length vertexNormals) + 1
if (idx > S.length vertexNormals) || (idx <= 0)
then fail $ "Invalid model! Vertex normal at index " ++ show idx' ++ " doesn't exist."
else return $ S.index vertexNormals (idx 1)
appendVertexNormal :: (Monad m) => V3 Double -> StateT WavefrontState m ()
appendVertexNormal n = do
curState <- get
put $ curState { _vertexNormals = (_vertexNormals curState) |> n }