module Graphics.GPipe.Collada
(
Scene,
Node(..),
nodeMat,
nodeAABB,
Transform(..),
transformMat,
transformsMat,
Camera(..),
cameraMat,
ViewSize(..),
Z(..),
Light(..),
Attenuation(..),
Geometry(..),
Mesh(..),
ID,
SID,
Semantic,
AABB(..)
)
where
import Data.Tree
import Data.Map (Map)
import Data.Maybe
import Data.Monoid
import Graphics.GPipe.Stream.Primitive
import Graphics.GPipe.Format
import qualified Data.Vec as Vec
import Data.Vec (Vec2, Vec3, Mat44, Mat33, (:.)(..), )
import Data.Vec.LinAlg
import Data.Vec.AABB
import Data.Vec.LinAlg.Transform3D
import Data.Typeable
import Data.Dynamic
type Scene = Tree (SID, Node)
data Node = Node {
nodeId :: Maybe ID,
nodeLayers :: [String],
nodeTransformations :: [(SID, Transform)],
nodeCameras :: [(SID, Camera)],
nodeLights :: [(SID, Light)],
nodeGeometries :: [(SID, Geometry)]
}
deriving (Show)
data Transform = LookAt {
lookAtEye:: Vec3 Float,
lookAtInterest :: Vec3 Float,
lookAtUp :: Vec3 Float
}
| Matrix (Mat44 Float)
| Rotate (Vec3 Float) Float
| Scale (Vec3 Float)
| Skew {
skewAngle :: Float,
skewRotation :: Vec3 Float,
skewTranslation :: Vec3 Float
}
| Translate (Vec3 Float)
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 (Vec2 Float)
deriving (Show, Eq)
data Z = Z {
zNear :: Float,
zFar :: Float
}
deriving (Show, Eq)
data Light = Ambient {
ambientID :: ID,
ambientColor :: Color RGBFormat Float
}
| Directional {
directionalID :: ID,
directionalColor :: Color RGBFormat Float
}
| Point {
pointID :: ID,
pointColor :: Color RGBFormat Float,
pointAttenuation :: Attenuation
}
| Spot {
spotID :: ID,
spotColor :: Color RGBFormat Float,
spotAttenuation :: Attenuation,
spotFallOffAngle :: Float,
spotFallOffExponent :: Float
}
deriving (Show, Eq)
data Attenuation = Attenuation {
attenuationConstant :: Float,
attenuationLinear :: Float,
attenuationQuadratic :: Float
}
deriving (Show, Eq)
data Geometry = Mesh {
meshID :: ID,
meshPrimitives :: [Mesh]
}
deriving (Show)
data Mesh = TriangleMesh {
meshMaterial :: String,
meshDescription :: Map Semantic TypeRep,
meshPrimitiveStream :: PrimitiveStream Triangle (Map Semantic Dynamic),
meshAABB :: AABB
}
instance Show Mesh where
show (TriangleMesh a b _ d) = "TriangleMesh {meshMaterial = " ++ show a ++ ", meshDescription = " ++ show b ++ ", meshPrimitiveStream = PrimitiveStream Triangle (Map String Dynamic), meshAABB = " ++ show d ++"}"
type ID = String
type SID = Maybe String
type Semantic = String
deriving instance Typeable1 Vertex
deriving instance Typeable2 (:.)
toRadians :: Floating a => a -> a
toRadians d = d * pi / 180
cameraMat :: Float -> Camera -> Mat44 Float
cameraMat asp (Perspective _ (ViewSizeX x) (Z near far)) = perspective near far (toRadians x / asp) asp
cameraMat asp (Perspective _ (ViewSizeY y) (Z near far)) = perspective near far (toRadians y) asp
cameraMat _ (Perspective _ (ViewSizeXY (x:.y:.())) (Z near far)) = perspective near far (toRadians y) (x/y)
cameraMat asp (Orthographic _ (ViewSizeX x) (Z near far)) = orthogonal near far (x :. (x/asp) :. ())
cameraMat asp (Orthographic _ (ViewSizeY y) (Z near far)) = orthogonal near far ((y*asp) :. y :. ())
cameraMat _ (Orthographic _ (ViewSizeXY s) (Z near far)) = orthogonal near far s
transformMat :: Transform -> Mat44 Float
transformMat (LookAt e i u) = rotationLookAt u e i
transformMat (Matrix m) = m
transformMat (Rotate v a) = rotationVec v (toRadians a)
transformMat (Scale v) = scaling v
transformMat (Skew a r t) = skew (toRadians a) r t
transformMat (Translate v) = translation v
transformsMat :: [Transform] -> Mat44 Float
transformsMat = foldl multmm identity . map transformMat
skew :: Float -> Vec3 Float -> Vec3 Float -> Mat44 Float
skew angle a b = Vec.map homVec m `Vec.snoc` homPoint 0
where
n2 = normalize b
a1 = Vec.map (* (a `dot` n2)) n2
a2 = aa1
n1 = normalize a2
an1 = a `dot` n1
an2 = a `dot` n2
rx = an1 * cos angle an2 * sin angle
ry = an1 * sin angle + an2 * cos angle
alpha = if abs an1 < 0.000001 then 0 else ry/rxan2/an1
m = outerProd n1 (Vec.map (* alpha) n2) + identity
outerProd :: Vec3 Float -> Vec3 Float -> Mat33 Float
outerProd a b = Vec.map (* b) $ Vec.map Vec.vec a
nodeMat :: Node -> Mat44 Float
nodeMat = transformsMat . map snd . nodeTransformations
nodeAABB :: Node -> AABB
nodeAABB = mconcat . map (mconcat . map meshAABB . meshPrimitives . snd) . nodeGeometries