assimp (empty) → 0.1
raw patch · 8 files changed
+1563/−0 lines, 8 filesdep +basedep +haskell98dep +vectsetup-changed
Dependencies added: base, haskell98, vect
Files
- C2HS.hs +220/−0
- Graphics/Formats/Assimp.hs +22/−0
- Graphics/Formats/Assimp/Fun.chs +337/−0
- Graphics/Formats/Assimp/Storable.hsc +417/−0
- Graphics/Formats/Assimp/Types.chs +445/−0
- LICENSE +30/−0
- Setup.hs +17/−0
- assimp.cabal +75/−0
+ C2HS.hs view
@@ -0,0 +1,220 @@+-- C->Haskell Compiler: Marshalling library+--+-- Copyright (c) [1999...2005] Manuel M T Chakravarty+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+-- +-- 1. Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer. +-- 2. Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution. +-- 3. The name of the author may not be used to endorse or promote products+-- derived from this software without specific prior written permission. +--+-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+-- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED+-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--+--- Description ---------------------------------------------------------------+--+-- Language: Haskell 98+--+-- This module provides the marshaling routines for Haskell files produced by +-- C->Haskell for binding to C library interfaces. It exports all of the+-- low-level FFI (language-independent plus the C-specific parts) together+-- with the C->HS-specific higher-level marshalling routines.+--++module C2HS (++ -- * Re-export the language-independent component of the FFI + module Foreign,++ -- * Re-export the C language component of the FFI+ module CForeign,++ -- * Composite marshalling functions+ withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,+ peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,++ -- * Conditional results using 'Maybe'+ nothingIf, nothingIfNull,++ -- * Bit masks+ combineBitMasks, containsBitMask, extractBitMasks,++ -- * Conversion between C and Haskell types+ cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum+) where +++import Foreign+ hiding (Word)+ -- Should also hide the Foreign.Marshal.Pool exports in+ -- compilers that export them+import CForeign++import Monad (when, liftM)+++-- Composite marshalling functions+-- -------------------------------++-- Strings with explicit length+--+withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)++-- Marshalling of numerals+--++withIntConv :: (Storable b, Integral a, Integral b) + => a -> (Ptr b -> IO c) -> IO c+withIntConv = with . cIntConv++withFloatConv :: (Storable b, RealFloat a, RealFloat b) + => a -> (Ptr b -> IO c) -> IO c+withFloatConv = with . cFloatConv++peekIntConv :: (Storable a, Integral a, Integral b) + => Ptr a -> IO b+peekIntConv = liftM cIntConv . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) + => Ptr a -> IO b+peekFloatConv = liftM cFloatConv . peek++-- Passing Booleans by reference+--++withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b+withBool = with . fromBool++peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool+peekBool = liftM toBool . peek+++-- Passing enums by reference+--++withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c+withEnum = with . cFromEnum++peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a+peekEnum = liftM cToEnum . peek+++-- Storing of 'Maybe' values+-- -------------------------++instance Storable a => Storable (Maybe a) where+ sizeOf _ = sizeOf (undefined :: Ptr ())+ alignment _ = alignment (undefined :: Ptr ())++ peek p = do+ ptr <- peek (castPtr p)+ if ptr == nullPtr+ then return Nothing+ else liftM Just $ peek ptr++ poke p v = do+ ptr <- case v of+ Nothing -> return nullPtr+ Just v' -> new v'+ poke (castPtr p) ptr+++-- Conditional results using 'Maybe'+-- ---------------------------------++-- Wrap the result into a 'Maybe' type.+--+-- * the predicate determines when the result is considered to be non-existing,+-- ie, it is represented by `Nothing'+--+-- * the second argument allows to map a result wrapped into `Just' to some+-- other domain+--+nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b+nothingIf p f x = if p x then Nothing else Just $ f x++-- |Instance for special casing null pointers.+--+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b+nothingIfNull = nothingIf (== nullPtr)+++-- Support for bit masks+-- ---------------------++-- Given a list of enumeration values that represent bit masks, combine these+-- masks using bitwise disjunction.+--+combineBitMasks :: (Enum a, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++-- Tests whether the given bit mask is contained in the given bit pattern+-- (i.e., all bits set in the mask are also set in the pattern).+--+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm+ in+ bm' .&. bits == bm'++-- |Given a bit pattern, yield all bit masks that it contains.+--+-- * This does *not* attempt to compute a minimal set of bit masks that when+-- combined yield the bit pattern, instead all contained bit masks are+-- produced.+--+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]+extractBitMasks bits = + [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]+++-- Conversion routines+-- -------------------++-- |Integral conversion+--+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv = fromIntegral++-- |Floating conversion+--+cFloatConv :: (RealFloat a, RealFloat b) => a -> b+cFloatConv = realToFrac+-- As this conversion by default goes via `Rational', it can be very slow...+{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;+ "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x+ #-}++-- |Obtain C value from Haskell 'Bool'.+--+cFromBool :: Num a => Bool -> a+cFromBool = fromBool++-- |Obtain Haskell 'Bool' from C value.+--+cToBool :: Num a => a -> Bool+cToBool = toBool++-- |Convert a C enumeration to Haskell.+--+cToEnum :: (Integral i, Enum e) => i -> e+cToEnum = toEnum . cIntConv++-- |Convert a Haskell enumeration to C.+--+cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum = cIntConv . fromEnum
+ Graphics/Formats/Assimp.hs view
@@ -0,0 +1,22 @@+-- |+-- Module : Graphics.Formats.Assimp.Storable+-- Copyright : (c) Joel Burget 2011+-- License BSD3+--+-- Maintainer : Joel Burget <joelburget@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Import this module to use assimp. Please excuse the lack of documentation.+-- Everything should nearly directly mirror the original assimp,+-- documentation available here: <http://assimp.sourceforge.net/lib_html/>++module Graphics.Formats.Assimp (+ module Graphics.Formats.Assimp.Types+ , module Graphics.Formats.Assimp.Storable+ , module Graphics.Formats.Assimp.Fun+ ) where++import Graphics.Formats.Assimp.Types+import Graphics.Formats.Assimp.Storable+import Graphics.Formats.Assimp.Fun
+ Graphics/Formats/Assimp/Fun.chs view
@@ -0,0 +1,337 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Graphics.Formats.Assimp.Fun+-- Copyright : (c) Joel Burget 2011+-- License BSD3+--+-- Maintainer : Joel Burget <joelburget@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Defines functions for interacting with assimp++module Graphics.Formats.Assimp.Fun (+ -- * Basics+ importFile+ , applyPostProcessing+ -- * Version information+ , getVersionMinor+ , getVersionMajor+ , getVersionRevision+ , isExtensionSupported+ -- * Accessing materials+ , get+ , getArray+ -- * Currently unused+ , getErrorString+ , setImportPropertyInteger+ , setImportPropertyFloat+ ) where++import C2HS+import Foreign.Storable ()+import Control.Monad (liftM)+import Unsafe.Coerce (unsafeCoerce)+import Data.Vect (Vec3(Vec3), Vec4(Vec4))+import Data.List (foldl1')++import Graphics.Formats.Assimp.Types+import Graphics.Formats.Assimp.Storable ()++#include "assimp.h"+#include "aiVersion.h"+#include "aiMaterial.h"+#include "typedefs.h"++--withT = with -- http://blog.ezyang.com/2010/06/call-and-fun-marshalling-redux/+with' :: (Storable a) => a -> (Ptr b -> IO c) -> IO c+with' x y = with x (y . castPtr)++peek' :: (Storable b) => Ptr a -> IO b+peek' = peek . castPtr++-- aiImportFileEx+-- aiImportFileFromMemory++{#fun unsafe aiApplyPostProcessing as applyPostProcessing + {with'* `Scene', cFromEnum `PostProcessSteps'} -> `Scene' peek'*#}++--{#fun aiGetPredefinedLogStream as ^+-- {cFromEnum `DefaultLogStream', `String'} -> `LogStream' id#}++-- aiAttachLogStream+-- aiEnableVerboseLogging+-- aiDetachLogStream+-- aiDetachAllLogStreams++importFile :: String -> [PostProcessSteps] -> IO (Either String Scene)+importFile str psteps = do + let psteps' = foldl1' (.|.) $ map cFromEnum psteps+ sceneptr <- withCString str $ \x -> {#call unsafe aiImportFile#} x psteps'+ if sceneptr == nullPtr+ then liftM Left getErrorString+ else do+ scene <- peek' sceneptr+ {#call unsafe aiReleaseImport#} sceneptr+ return $ Right scene++{#fun unsafe aiGetErrorString as getErrorString+ {} -> `String'#}++{#fun unsafe aiIsExtensionSupported as isExtensionSupported+ {`String'} -> `Bool'#}++-- {#fun unsafe aiGetExtensionList as getExtensionList+-- {alloca- `AiString' peek'*} -> `()'#}++-- aiGetMemoryRequirements++{#fun unsafe aiSetImportPropertyInteger as setImportPropertyInteger+ {`String', `Int'} -> `()'#}++{#fun unsafe aiSetImportPropertyFloat as setImportPropertyFloat + {`String', `Float'} -> `()'#}++--{# fun aiSetImportPropertyString as ^+-- {`String', `String'} -> `()'#}++{#fun unsafe aiGetLegalString as getLegalString+ {} -> `String'#}++{#fun unsafe aiGetVersionMinor as getVersionMinor+ {} -> `CUInt' unsafeCoerce#}++{#fun unsafe aiGetVersionMajor as getVersionMajor+ {} -> `CUInt' unsafeCoerce#}++{#fun unsafe aiGetVersionRevision as getVersionRevision+ {} -> `CUInt' unsafeCoerce#}++{#fun unsafe aiGetCompileFlags as getCompileFlags+ {} -> `CompileFlags' convert#}+ where convert = toEnum . cIntConv++class ArrayGetter a where+ getArray :: Material -> MatKey -> CUInt -> IO (Either String [a])++class SingleGetter a where+ get :: Material -> MatKey -> IO (Either String a)++instance ArrayGetter Float where+ getArray = getMaterialFloatArray++instance ArrayGetter Int where+ getArray = getMaterialIntArray++instance SingleGetter Float where+ get = getMaterialFloat++instance SingleGetter Int where+ get = getMaterialInt++instance SingleGetter Vec3 where+-- Also another case?+ get mat key = (liftM . liftM) (\(Vec4 r g b a) -> Vec3 r g b) + (getMaterialColor mat key)++instance SingleGetter Vec4 where+ get = getMaterialColor++instance SingleGetter String where+ get = getMaterialString++mCUInt = fromInteger . toInteger+mRet = toEnum . fromInteger . toInteger++-------------------------------------------------------------------------------++{- |+ - Retrieve a material property with a specific key from the material+ -}+getMaterialProperty :: Material -- ^ The material+ -> MatKey -- ^ A key+ -> IO (Either String MaterialProperty)+getMaterialProperty mat key = do+ let (mKey, mType, mIndex) = matKeyToTuple key+ (ret, prop) <- getMaterialProperty' mat mKey mType mIndex+ case ret of+ ReturnSuccess -> peekM prop+ ReturnFailure -> return $ Left "Failed"+ ReturnOutOfMemory -> return $ Left "Out of memory."+ where+ peekM :: Ptr MaterialProperty -> IO (Either String MaterialProperty)+ peekM p = + if p == nullPtr+ then return $ Left "No property found"+ else liftM Right $ peek p++{#fun unsafe aiGetMaterialProperty as getMaterialProperty'+ {with'* `Material',+ `String' ,+ mCUInt `CUInt' ,+ mCUInt `CUInt' ,+ alloca- `Ptr MaterialProperty' peek'*} -> `Return' mRet#}++-------------------------------------------------------------------------------+{- |+ - Retrieve an array of float values with a specific key from the material+ - Example:+ - > getMaterialFloatArray mat (KeyUvTransform Diffuse 0) 4+ -}+getMaterialFloatArray :: Material -- ^ The material+ -> MatKey -- ^ A key+ -> CUInt -- ^ Max number of values to retrieve+ -> IO (Either String [Float])+getMaterialFloatArray mat key max = do+ let (mKey, mType, mIndex) = matKeyToTuple key+ (ret, arr, max) <- getMaterialFloatArray' mat mKey mType mIndex max+ case ret of+ ReturnSuccess -> liftM (Right . (map unsafeCoerce)) + $ peekArray (fromIntegral max) arr + ReturnFailure -> return $ Left "Failed"+ ReturnOutOfMemory -> return $ Left "Out of memory."++{#fun unsafe aiGetMaterialFloatArray as getMaterialFloatArray'+ {with'* `Material' ,+ `String' ,+ mCUInt `CUInt' ,+ mCUInt `CUInt' ,+ alloca- `Ptr CFloat' id,+ with'* `CUInt' peek'*} -> `Return' mRet#}++-------------------------------------------------------------------------------++getMaterialFloat :: Material -> MatKey -> IO (Either String Float)+getMaterialFloat mat key = do+ arr <- getMaterialFloatArray mat key 1+ return $ case arr of+ Left err -> Left err+ Right ans -> Right $ head ans++-------------------------------------------------------------------------------++getMaterialIntArray :: Material -> MatKey -> CUInt -> IO (Either String [Int])+getMaterialIntArray mat key max = do+ let (mKey, mType, mIndex) = matKeyToTuple key+ (ret, arr, max) <- getMaterialIntArray' mat mKey mType mIndex max+ case ret of+ ReturnSuccess -> liftM (Right . (map unsafeCoerce)) + $ peekArray (fromIntegral max) arr + ReturnFailure -> return $ Left "Failed"+ ReturnOutOfMemory -> return $ Left "Out of memory."++{#fun unsafe aiGetMaterialIntegerArray as getMaterialIntArray'+ {with'* `Material' ,+ `String' ,+ mCUInt `CUInt' ,+ mCUInt `CUInt' ,+ alloca- `Ptr CInt' id,+ with'* `CUInt' peek'*} -> `Return' mRet#}++-------------------------------------------------------------------------------++getMaterialInt :: Material -> MatKey -> IO (Either String Int)+getMaterialInt mat key = do+ arr <- getMaterialIntArray mat key 1+ return $ case arr of+ Left err -> Left err+ Right ans -> Right $ head ans++-------------------------------------------------------------------------------++getMaterialColor :: Material -> MatKey -> IO (Either String Vec4)+getMaterialColor mat key = do+ let (mKey, mType, mIndex) = matKeyToTuple key+ (ret, vec) <- getMaterialColor' mat mKey mType mIndex+ return $ case ret of+ ReturnSuccess -> Right vec+ ReturnFailure -> Left "Failed"+ ReturnOutOfMemory -> Left "Out of memory."++-- Can't get this to work :(+-- {#fun unsafe aiGetMaterialColor as getMaterialColor'+-- {with'* `Material',+-- `String' ,+-- mCUInt `CUInt' ,+-- mCUInt `CUInt' ,+-- alloca- `Vec4' peek'*} -> `Return' mRet#}++getMaterialColor' :: Material -> String -> CUInt -> CUInt -> IO (Return, Vec4)+getMaterialColor' a1 a2 a3 a4 =+ with a1 $ \a1' -> + withCString a2 $ \a2' -> + alloca $ \a5' -> + getMaterialColor''_ a1' a2' (mCUInt a3) (mCUInt a4) a5' >>= \res ->+ peek a5' >>= \a5'' -> + return (mRet res, a5'')++foreign import ccall unsafe "Graphics/Formats/Assimp/Fun.chs.h aiGetMaterialColor"+ getMaterialColor''_ :: Ptr Material -> Ptr CChar -> CUInt -> CUInt -> Ptr Vec4 -> IO CInt++-------------------------------------------------------------------------------++getMaterialString :: Material -> MatKey -> IO (Either String String)+getMaterialString mat key = do+ let (mKey, mType, mIndex) = matKeyToTuple key+ (ret, (AiString str)) <- getMaterialString' mat mKey mType mIndex+ return $ case ret of+ ReturnSuccess -> Right str+ ReturnFailure -> Left "Failed"+ ReturnOutOfMemory -> Left "Out of memory."+ +-- {#fun unsafe aiGetMaterialString as getMaterialString+-- {with'* `Material',+-- `String' ,+-- mCUInt `CUInt' ,+-- mCUInt `CUInt' ,+-- alloca- `AiString' peek'*} -> `Return' mRet#}++getMaterialString' :: Material -> String -> CUInt -> CUInt -> IO (Return, AiString)+getMaterialString' a1 a2 a3 a4 =+ with a1 $ \a1' -> + withCString a2 $ \a2' -> + alloca $ \a5' -> + getMaterialString''_ a1' a2' (mCUInt a3) (mCUInt a4) a5' >>= \res ->+ peek a5' >>= \a5'' -> + return (mRet res, a5'')++foreign import ccall unsafe "Graphics/Formats/Assimp/Fun.chs.h aiGetMaterialString"+ getMaterialString''_ :: Ptr Material -> Ptr CChar -> CUInt -> CUInt -> Ptr AiString -> IO CInt++-------------------------------------------------------------------------------++{#fun unsafe aiGetMaterialTextureCount as getTextureCount+ {with'* `Material',+ f `TextureType'} -> `CUInt' unsafeCoerce#}+ where+ f :: TextureType -> CInt+ f = cIntConv . fromEnum++-------------------------------------------------------------------------------++-- getTexture :: ++-- {#fun unsafe aiGetMaterialTexture as getTexture'+-- {with'* `Material' ,+-- f `TextureType',+-- mCUInt `CUInt'+-- `String' ,+-- alloca- `CUInt' peek'*} -> `Return' mRet#}++-- I'm not sure whether or not I will implement these or not. I guess I'll+-- check the source to see if they're pure. They could easily be implemented in+-- pure haskell.++-- aiCreateQuaternionFromMatrix+-- aiDecomposeMatrix+-- aiTransposematrix4+-- aiTransposematrix3+-- aiTransformVecByMatrix3+-- aiTransformVecByMatrix4+-- aiMultiplyMatrix3+-- aiMultiplyMatrix4+-- aiIdentityMatrix3+-- aiIdentityMatrix4
+ Graphics/Formats/Assimp/Storable.hsc view
@@ -0,0 +1,417 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module : Graphics.Formats.Assimp.Storable+-- Copyright : (c) Joel Burget 2011+-- License BSD3+--+-- Maintainer : Joel Burget <joelburget@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Storable instances for all data types, we leave @poke@ undefined because+-- it is not ever used++module Graphics.Formats.Assimp.Storable where++import C2HS+import Prelude hiding (replicate)+import Foreign.Storable+import Control.Monad (liftM, liftM2, join)+import Control.Applicative ((<$>), (<*>))+import Data.Vect.Float (Vec2(..), Vec3(..), Vec4(..), Mat3(..), Mat4(..))++import Graphics.Formats.Assimp.Types++#include "assimp.h" // Plain-C interface+#include "aiScene.h" // Output data structure+#include "aiPostProcess.h" // Post processing flags+#include "./typedefs.h"++#include <stddef.h>+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++-- Same as peekArray but checks for a null pointer+peekArray' :: Storable a => Int -> Ptr a -> IO [a]+peekArray' n ptr = if ptr == nullPtr+ then return []+ else peekArray n ptr++peekArrayPtr :: (Storable a) => Int -> (Ptr (Ptr a)) -> IO [a]+peekArrayPtr n p = peekArray' (fromIntegral n) p >>= mapM peek++instance Storable Plane3d where+ sizeOf _ = #size aiPlane+ alignment _ = #alignment aiPlane+ peek p = Plane3d <$> (#peek aiPlane, a) p+ <*> (#peek aiPlane, b) p+ <*> (#peek aiPlane, c) p+ <*> (#peek aiPlane, d) p+ poke = undefined++instance Storable Ray where+ sizeOf _ = #size aiRay+ alignment _ = #alignment aiRay+ peek p = do+ (Vec3F pos) <- (#peek aiRay, pos) p+ (Vec3F dir) <- (#peek aiRay, dir) p+ return $ Ray pos dir+ poke = undefined++instance Storable Vec2F where+ sizeOf _ = #size aiVector2D+ alignment _ = #alignment aiVector2D+ peek p = Vec2F <$> (Vec2 <$> (#peek aiVector2D, x) p+ <*> (#peek aiVector2D, y) p)+ poke = undefined++instance Storable Vec3F where+ sizeOf _ = #size aiVector3D+ alignment _ = #alignment aiVector3D+ peek p = Vec3F <$> (Vec3 <$> (#peek aiVector3D, x) p+ <*> (#peek aiVector3D, y) p+ <*> (#peek aiVector3D, z) p)+ poke = undefined++instance Storable Color3F where+ sizeOf _ = #size aiColor3D+ alignment _ = #alignment aiColor3D+ peek p = Color3F <$> (Vec3 <$> (#peek aiColor3D, r) p+ <*> (#peek aiColor3D, g) p+ <*> (#peek aiColor3D, b) p)+ poke = undefined++instance Storable Color4F where+ sizeOf _ = #size aiColor4D+ alignment _ = #alignment aiColor4D+ peek p = Color4F <$> (Vec4 <$> (#peek aiColor4D, r) p+ <*> (#peek aiColor4D, g) p+ <*> (#peek aiColor4D, b) p+ <*> (#peek aiColor4D, a) p)+ poke = undefined++instance Storable MemoryInfo where+ sizeOf _ = #size aiMemoryInfo+ alignment _ = #alignment aiMemoryInfo+ peek p = do+ text <- (#peek aiMemoryInfo, textures) p+ materials <- (#peek aiMemoryInfo, materials) p+ meshes <- (#peek aiMemoryInfo, meshes) p+ nodes <- (#peek aiMemoryInfo, nodes) p+ animations <- (#peek aiMemoryInfo, animations) p+ cameras <- (#peek aiMemoryInfo, cameras) p+ lights <- (#peek aiMemoryInfo, lights) p+ total <- (#peek aiMemoryInfo, total) p+ return $ MemoryInfo text materials meshes nodes animations cameras lights + total+ poke = undefined++instance Storable Quaternion where+ sizeOf _ = #size aiQuaternion+ alignment _ = #alignment aiQuaternion+ peek p = Quaternion <$> (#peek aiQuaternion, w) p+ <*> (#peek aiQuaternion, w) p+ <*> (#peek aiQuaternion, w) p+ <*> (#peek aiQuaternion, w) p+ poke = undefined++instance Storable AiString where+ sizeOf _ = #size aiString+ alignment _ = #alignment aiString+ peek p = do+ start <- ((#peek aiString, data) p) :: IO (Ptr CChar)+ if start == nullPtr+ then return $ AiString ""+ else do+ len <- (#peek aiString, length) p+ -- So the string is stored as an array, we need to pass a pointer to+ -- peekCStringLen, so we can't just (#peek aiString, data) because that+ -- would give us the value of the first word of the string instead of+ -- the pointer, so we have to create a pointer.+ str <- peekCStringLen (p `plusPtr` (#offset aiString, data), len)+ return $ AiString str+ poke = undefined++aiStringToString :: AiString -> String+aiStringToString (AiString s) = s++instance Storable Mat3F where+ sizeOf _ = #size aiMatrix3x3+ alignment _ = #alignment aiMatrix3x3+ peek p = do+ a1 <- (#peek aiMatrix3x3, a1) p+ a2 <- (#peek aiMatrix3x3, a2) p+ a3 <- (#peek aiMatrix3x3, a3) p+ b1 <- (#peek aiMatrix3x3, b1) p+ b2 <- (#peek aiMatrix3x3, b2) p+ b3 <- (#peek aiMatrix3x3, b3) p+ c1 <- (#peek aiMatrix3x3, c1) p+ c2 <- (#peek aiMatrix3x3, c2) p+ c3 <- (#peek aiMatrix3x3, c3) p+ return $ Mat3F $ Mat3+ (Vec3 a1 a2 a3)+ (Vec3 b1 b2 b3)+ (Vec3 c1 c2 c3)+ poke = undefined++instance Storable Mat4F where+ sizeOf _ = #size aiMatrix4x4+ alignment _ = #alignment aiMatrix4x4+ peek p = do+ a1 <- (#peek aiMatrix4x4, a1) p+ a2 <- (#peek aiMatrix4x4, a2) p+ a3 <- (#peek aiMatrix4x4, a3) p+ a4 <- (#peek aiMatrix4x4, a4) p+ b1 <- (#peek aiMatrix4x4, b1) p+ b2 <- (#peek aiMatrix4x4, b2) p+ b3 <- (#peek aiMatrix4x4, b3) p+ b4 <- (#peek aiMatrix4x4, b4) p+ c1 <- (#peek aiMatrix4x4, c1) p+ c2 <- (#peek aiMatrix4x4, c2) p+ c3 <- (#peek aiMatrix4x4, c3) p+ c4 <- (#peek aiMatrix4x4, c4) p+ d1 <- (#peek aiMatrix4x4, d1) p+ d2 <- (#peek aiMatrix4x4, d2) p+ d3 <- (#peek aiMatrix4x4, d3) p+ d4 <- (#peek aiMatrix4x4, d4) p+ return $ Mat4F $ Mat4+ (Vec4 a1 a2 a3 a4)+ (Vec4 b1 b2 b3 b4)+ (Vec4 c1 c2 c3 c4)+ (Vec4 d1 d2 d3 d4)+ poke = undefined++instance Storable Node where+ sizeOf _ = #size aiNode+ alignment _ = #alignment aiNode+ peek p = do+ mName <- liftM aiStringToString $ (#peek aiNode, mName) p+ mTransformation <- (#peek aiNode, mTransformation) p+ -- mParent <- if mParentPtr == nullPtr + -- then return Nothing + -- else (#peek aiNode, mParent) p+ -- Temporary workaround so we don't end up in an infinite loop+ let mParent = Nothing + mNumChildren <- (#peek aiNode, mNumChildren) p :: IO CUInt+ mChildrenP'' <- (#peek aiNode ,mChildren) p >>=+ peekArray' (fromIntegral mNumChildren)+ mChildren <- mapM peek mChildrenP''+ mNumMeshes <- (#peek aiNode, mNumMeshes) p :: IO CUInt+ mMeshes <- (#peek aiNode, mMeshes) p >>=+ peekArray (fromIntegral mNumMeshes)+ return $ Node mName mTransformation mParent mChildren mMeshes+ poke = undefined++instance Storable Face where+ sizeOf _ = #size aiFace+ alignment _ = #alignment aiFace+ peek p = do+ mNumIndices <- (#peek aiFace, mNumIndices) p :: IO CUInt+ mIndices <- (#peek aiFace, mIndices) p+ lst <- peekArray (fromIntegral mNumIndices) mIndices+ return $ Face lst+ poke = undefined++instance Storable VertexWeight where+ sizeOf _ = #size aiVertexWeight+ alignment _ = #alignment aiVertexWeight+ peek p = VertexWeight <$> (#peek aiVertexWeight, mVertexId) p+ <*> (#peek aiVertexWeight, mWeight) p+ poke = undefined++instance Storable Bone where+ sizeOf _ = #size aiBone+ alignment _ = #alignment aiBone+ peek p = do+ mN <- liftM aiStringToString $ (#peek aiBone, mName) p+ mNW <- (#peek aiBone, mNumWeights) p+ mW <- (#peek aiBone, mWeights) p+ lst <- peekArray mNW mW+ mO <- (#peek aiBone, mOffsetMatrix) p+ return $ Bone mN lst mO+ poke = undefined++toEnumList :: Enum a => CUInt -> [a]+toEnumList ls =+ -- Find the places where the bits are set in ls, then convert them to b.+ let stage1 = map (ls .&.) $ map (2^) [0..(bitSize (undefined::CUInt))]+ stage2 = filter (>0) stage1+ in map (toEnum . fromIntegral) stage2++instance Storable Mesh where+ sizeOf _ = #size aiMesh+ alignment _ = #alignment aiMesh+ peek p = do+ -- Note for some reason I had to shift the bits right by 1 but I don't+ -- think that should have been necessary.+ mPrimitiveTypes <- liftM (toEnumList . (flip shiftR 1))+ ((#peek aiMesh, mPrimitiveTypes) p :: IO CUInt)+ mNumVs <- liftM fromIntegral+ $ ((#peek aiMesh, mNumVertices) p :: IO CUInt)+ mVertices <- liftM (map (\(Vec3F x) -> x)) + $ (#peek aiMesh, mVertices) p >>= peekArray mNumVs+ mNormals <- liftM (map (\(Vec3F x) -> x)) + $ (#peek aiMesh, mNormals) p >>= peekArray' mNumVs+ mTangents <- liftM (map (\(Vec3F x) -> x)) + $ (#peek aiMesh, mTangents) p >>= peekArray' mNumVs+ mBitangents <- liftM (map (\(Vec3F x) -> x)) + $ (#peek aiMesh, mBitangents) p >>= peekArray' mNumVs+ mColors <- liftM (map (\(Color4F x) -> x)) + $ (#peek aiMesh, mColors) p >>= peekArray' mNumVs+ mTextureCoords <- liftM (map (\(Vec3F x) -> x)) + $ (#peek aiMesh, mTextureCoords) p >>= peekArray' mNumVs+ mNumUVComponents <- (#peek aiMesh, mNumUVComponents) p+ mNumFaces <- liftM fromIntegral + ((#peek aiMesh, mNumFaces) p :: IO CUInt)+ mFaces <- (#peek aiMesh, mFaces) p >>= peekArray mNumFaces+ mBones <- join $ peekArrayPtr <$> ((#peek aiMesh, mNumBones) p)+ <*> ((#peek aiMesh, mBones) p)+ mMaterialIndex <- (#peek aiMesh, mMaterialIndex) p+ mName <- liftM aiStringToString $ (#peek aiMesh, mName) p+ return $ Mesh+ mPrimitiveTypes mVertices mNormals mTangents mBitangents+ mColors mTextureCoords mNumUVComponents mFaces mBones+ mMaterialIndex mName+ poke = undefined++instance Storable MaterialProperty where+ sizeOf _ = #size aiMaterialProperty+ alignment _ = #alignment aiMaterialProperty+ peek p = do+ mKey <- liftM aiStringToString $ (#peek aiMaterialProperty, mKey) p+ mSemantic <- liftM (cToEnum :: CUInt -> TextureType) $ + (#peek aiMaterialProperty, mSemantic) p+ mIndex <- (#peek aiMaterialProperty, mIndex) p+ -- mType <- liftM toEnum $ (#peek aiMaterialProperty, mType) p+ mData <- (#peek aiMaterialProperty, mData) p >>= peekCString+ -- return $ MaterialProperty mKey mSemantic mIndex mType mData+ return $ MaterialProperty mKey mSemantic mIndex mData+ poke = undefined++instance Storable NodeAnim where+ sizeOf _ = #size aiNodeAnim+ alignment _ = #alignment aiNodeAnim+ peek _ = return $ NodeAnim 0+ poke = undefined++instance Storable MeshAnim where+ sizeOf _ = #size aiMeshAnim+ alignment _ = #alignment aiMeshAnim+ peek _ = return $ MeshAnim 0+ poke = undefined++instance Storable Material where+ sizeOf _ = #size aiMaterial+ alignment _ = #alignment aiMaterial+ peek p = do+ mProperties <- join $ liftM2 peekArrayPtr+ (liftM fromIntegral ((#peek aiMaterial, mNumProperties) p :: IO CUInt))+ ((#peek aiMaterial, mProperties) p)+ return $ Material mProperties+ poke = undefined++instance Storable Animation where+ sizeOf _ = #size aiAnimation+ alignment _ = #alignment aiAnimation+ peek p = do+ mName <- liftM aiStringToString $ (#peek aiAnimation, mName) p+ mDuration <- (#peek aiAnimation, mDuration) p+ mTicksPerSecond <- (#peek aiAnimation, mTicksPerSecond) p+ mNumChannels <- (#peek aiAnimation, mNumChannels) p+ mChannels' <- (#peek aiAnimation, mChannels) p+ mChannels <- peekArray mNumChannels mChannels'+ mNumMeshChannels <- (#peek aiAnimation, mNumMeshChannels) p+ mMeshChannels' <- (#peek aiAnimation, mMeshChannels) p+ mMeshChannels <- peekArray mNumMeshChannels mMeshChannels'+ return $ Animation mName mDuration mTicksPerSecond mChannels mMeshChannels+ poke = undefined++instance Storable Light where+ sizeOf _ = #size aiLight+ alignment _ = #alignment aiLight+ peek p = do+ mName <- liftM aiStringToString $ (#peek aiLight, mName) p+ mType <- liftM toEnum $ (#peek aiLight, mType) p+ (Vec3F mPosition) <- (#peek aiLight, mPosition) p+ (Vec3F mDirection) <- (#peek aiLight, mDirection) p+ mAttenuationConstant <- (#peek aiLight, mAttenuationConstant) p+ mAttenuationLinear <- (#peek aiLight, mAttenuationLinear) p+ mAttenuationQuadratic <- (#peek aiLight, mAttenuationQuadratic) p+ (Color3F mColorDiffuse) <- (#peek aiLight, mColorDiffuse) p+ (Color3F mColorSpecular) <- (#peek aiLight, mColorSpecular) p+ (Color3F mColorAmbient) <- (#peek aiLight, mColorAmbient) p+ mAngleInnerCone <- (#peek aiLight, mAngleInnerCone) p+ mAngleOuterCone <- (#peek aiLight, mAngleOuterCone) p+ return $ Light+ mName mType mPosition mDirection mAttenuationConstant+ mAttenuationLinear mAttenuationQuadratic mColorDiffuse+ mColorSpecular mColorAmbient mAngleInnerCone mAngleOuterCone+ poke = undefined++instance Storable Texture where+ sizeOf _ = #size aiTexture+ alignment _ = #alignment aiTexture+ peek p = do+ mWidth <- (#peek aiTexture, mWidth) p+ mHeight <- (#peek aiTexture, mHeight) p+ -- Should achFormatHint be included?+ achFormatHint <- (#peek aiTexture, achFormatHint) p >>= peekCString+ pcData' <- (#peek aiTexture, pcData) p+ pcData <- if mHeight == 0+ then peekArray (fromIntegral mWidth) pcData'+ else peekArray (fromIntegral (mWidth * mHeight)) pcData'+ return $ Texture mWidth mHeight achFormatHint pcData+ poke = undefined++instance Storable Texel where+ sizeOf _ = #size aiTexel+ alignment _ = #alignment aiTexel+ peek _ = return $ Texel 0+ poke = undefined++instance Storable Camera where+ sizeOf _ = #size aiCamera+ alignment _ = #alignment aiCamera+ peek p = do+ mName <- liftM aiStringToString $ (#peek aiCamera, mName) p+ (Vec3F mPosition) <- (#peek aiCamera, mPosition) p+ (Vec3F mUp) <- (#peek aiCamera, mUp) p+ (Vec3F mLookAt) <- (#peek aiCamera, mLookAt) p+ mHorizontalFOV <- (#peek aiCamera, mHorizontalFOV) p+ mClipPlaneNear <- (#peek aiCamera, mClipPlaneNear) p+ mClipPlaneFar <- (#peek aiCamera, mClipPlaneFar) p+ mAspect <- (#peek aiCamera, mAspect) p+ return $ Camera mName mPosition mUp mLookAt mHorizontalFOV mClipPlaneNear + mClipPlaneFar mAspect+ poke = undefined++instance Storable Scene where+ sizeOf _ = #size aiScene+ alignment _ = #alignment aiScene+ peek p = do+ mFlags <- liftM toEnumList $ ((#peek aiScene, mFlags) p :: IO CUInt)+ mRootNode <- (#peek aiScene, mRootNode) p >>= peek+ mNumMeshes <- (#peek aiScene, mNumMeshes) p :: IO CUInt+ mMeshes' <- (#peek aiScene, mMeshes) p >>= + peekArray (fromIntegral mNumMeshes)+ mMeshes <- mapM peek mMeshes'+ mNumMaterials <- (#peek aiScene, mNumMaterials) p :: IO CUInt+ mMaterials' <- (#peek aiScene, mMaterials) p >>= + peekArray (fromIntegral mNumMaterials)+ mMaterials <- mapM peek mMaterials'+ mNumAnimations <- (#peek aiScene, mNumAnimations) p :: IO CUInt+ mAnimations <- (#peek aiScene, mAnimations) p >>= + peekArrayPtr (fromIntegral mNumAnimations)+ mNumTextures <- (#peek aiScene, mNumTextures) p :: IO CUInt+ mTextures <- (#peek aiScene, mTextures) p >>= + peekArrayPtr (fromIntegral mNumTextures)+ mNumLights <- (#peek aiScene, mNumLights) p :: IO CUInt+ mLights <- (#peek aiScene, mLights) p >>= + peekArrayPtr (fromIntegral mNumLights)+ mNumCameras <- (#peek aiScene, mNumCameras) p :: IO CUInt+ mCameras <- (#peek aiScene, mCameras) p >>= + peekArrayPtr (fromIntegral mNumCameras)+ return $ Scene mFlags mRootNode mMeshes mMaterials mAnimations mTextures+ mLights mCameras+ poke = undefined
+ Graphics/Formats/Assimp/Types.chs view
@@ -0,0 +1,445 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module : Graphics.Formats.Assimp.Storable+-- Copyright : (c) Joel Burget 2011+-- License BSD3+--+-- Maintainer : Joel Burget <joelburget@gmail.com>+-- Stability : experimental+-- Portability : non-portable+--+-- Data types for (nearly) every type used in assimp.++module Graphics.Formats.Assimp.Types (+ SceneFlags(..)+ , CompileFlags(..)+ , PostProcessSteps(..)+ , Return(..)+-- , Origin(..)+-- , DefaultLogStream(..)+ , PrimitiveType(..)+ , LightSourceType(..)+ , TextureOp(..)+ , TextureMapMode(..)+ , TextureMapping(..)+ , TextureType(..)+ , ShadingMode(..) -- ?+ , TextureFlags(..)+ , BlendMode(..)+ , PropertyTypeInfo(..)+ , MatKey(..)+ , matKeyToTuple+ , Plane3d(..)+ , Ray(..)+ , Vec2F(Vec2F)+ , Vec3F(Vec3F)+ , Vec4F(Vec4F)+ , Mat3F(Mat3F)+ , Mat4F(Mat4F)+ , Color3F(Color3F)+ , Color4F(Color4F)+ , MemoryInfo(..)+ , Quaternion(..)+ , AiString(..)+ , Node(..)+ , Face(..)+ , VertexWeight(..)+ , Bone(..)+ , Mesh(..)+ , MaterialProperty(..)+ , Material(..)+ , NodeAnim(..)+ , MeshAnim(..)+ , Animation(..)+ , Light(..)+ , Camera(..)+ , Scene(..)+ , Texture(..)+ , Texel(..)+ , position+ ) where++import C2HS++import Data.Vect.Float++-- Remove the force32bit enums+#define SWIG++#include "assimp.h" // Plain-C interface+#include "aiScene.h" // Output data structure+#include "aiPostProcess.h" // Post processing flags+#include "aiVersion.h" // Version information+#include "typedefs.h"++{#context lib="assimp"#}+{#context prefix="ai"#}++{#enum define SceneFlags {AI_SCENE_FLAGS_INCOMPLETE as FlagsIncomplete+ , AI_SCENE_FLAGS_VALIDATED as FlagsValidated+ , AI_SCENE_FLAGS_VALIDATION_WARNING as FlagsValidationWarning+ , AI_SCENE_FLAGS_NON_VERBOSE_FORMAT as FlagsNonVerboseFormat+ , AI_SCENE_FLAGS_TERRAIN as FlagsTerrain+ }#}+instance Show SceneFlags where+ show FlagsIncomplete = "FlagsIncomplete"+ show FlagsValidated = "FlagsValidated"+ show FlagsValidationWarning = "FlagsValidationWarning"+ show FlagsNonVerboseFormat = "FlagsNonVerboseFormat"+ show FlagsTerrain = "FlagsTerrain"++{#enum define CompileFlags {ASSIMP_CFLAGS_SHARED as Shared+ , ASSIMP_CFLAGS_STLPORT as StlPort+ , ASSIMP_CFLAGS_DEBUG as Debug+ , ASSIMP_CFLAGS_NOBOOST as NoBoost+ , ASSIMP_CFLAGS_SINGLETHREADED as SingleThreaded+ }#}+instance Show CompileFlags where+ show Shared = "Shared"+ show StlPort = "StlPort"+ show Debug = "Debug"+ show NoBoost = "NoBoost"+ show SingleThreaded = "SingleThreaded"++{#enum aiPostProcessSteps as PostProcessSteps {} with prefix="aiProcess_" deriving (Show, Eq)#}++data Return = ReturnSuccess+ | ReturnFailure+ | ReturnOutOfMemory+ deriving (Show,Eq)+instance Enum Return where+ fromEnum ReturnSuccess = 0+ fromEnum ReturnFailure = (-1)+ fromEnum ReturnOutOfMemory = (-3)++ toEnum 0 = ReturnSuccess+ toEnum (-1) = ReturnFailure+ toEnum (-3) = ReturnOutOfMemory+ toEnum unmatched = error ("Return.toEnum: Cannot match " ++ show unmatched)++--{#enum aiOrigin as Origin {} with prefix="aiOrigin_" deriving (Show, Eq)#}+--{#enum aiDefaultLogStream as DefaultLogStream {underscoreToCase} with prefix="aiDefaultLogStream" deriving (Show, Eq)#}++data PrimitiveType = PrimitiveTypePoint+ | PrimitiveTypeLine+ | PrimitiveTypeTriangle+ | PrimitiveTypePolygon+ deriving (Show,Eq)+instance Enum PrimitiveType where+ fromEnum PrimitiveTypePoint = 1+ fromEnum PrimitiveTypeLine = 2+ fromEnum PrimitiveTypeTriangle = 4+ fromEnum PrimitiveTypePolygon = 8++ toEnum 1 = PrimitiveTypePoint+ toEnum 2 = PrimitiveTypeLine+ toEnum 4 = PrimitiveTypeTriangle+ toEnum 8 = PrimitiveTypePolygon+ toEnum unmatched = error ("PrimitiveType.toEnum: Cannot match " ++ show unmatched)++data LightSourceType = LightSourceUndefined+ | LightSourceDirectional+ | LightSourcePoint+ | LightSourceSpot+ deriving (Show,Eq)+instance Enum LightSourceType where+ fromEnum LightSourceUndefined = 0+ fromEnum LightSourceDirectional = 1+ fromEnum LightSourcePoint = 2+ fromEnum LightSourceSpot = 3++ toEnum 0 = LightSourceUndefined+ toEnum 1 = LightSourceDirectional+ toEnum 2 = LightSourcePoint+ toEnum 3 = LightSourceSpot+ toEnum unmatched = error ("LightSourceType.toEnum: Cannot match " ++ show unmatched)++-- Texture enums+{#enum aiTextureOp as TextureOp {} with prefix="aiTextureOp_" deriving (Show, Eq)#}+{#enum aiTextureMapMode as TextureMapMode {} with prefix="aiTextureMapMode_" deriving (Show, Eq)#}+{#enum aiTextureMapping as TextureMapping {underscoreToCase} with prefix="aiTextureMapping_" deriving (Show, Eq)#}+{#enum aiTextureType as TextureType {underscoreToCase} with prefix="aiTextureType_" deriving (Show, Eq)#}+{#enum aiShadingMode as ShadingMode {} with prefix="aiShadingMode_" deriving (Show, Eq)#}+{#enum aiTextureFlags as TextureFlags {} with prefix="aiTextureFlags_" deriving (Show, Eq)#}+{#enum aiBlendMode as BlendMode {} with prefix="aiBlendMode_" deriving (Show, Eq)#}+{#enum aiPropertyTypeInfo as PropertyTypeInfo {underscoreToCase} deriving (Show, Eq)#}++data MatKey = KeyName+ | KeyTwoSided+ | KeyShadingModel+ | KeyEnableWireframe+ | KeyBlendFunc+ | KeyOpacity+ | KeyBumpScaling+ | KeyShininess+ | KeyReflectivity+ | KeyShininessStrength+ | KeyRefraction+ | KeyColorDiffuse+ | KeyColorAmbient+ | KeyColorSpecular+ | KeyColorEmissive+ | KeyColorTransparent+ | KeyColorReflective+ | KeyGlobalBackgroundImage+ | KeyTexture TextureType CUInt+ | KeyUvWSrc TextureType CUInt+ | KeyTexOp TextureType CUInt+ | KeyMapping TextureType CUInt+ | KeyTexBlend TextureType CUInt+ | KeyMappingModeU TextureType CUInt+ | KeyMappingModeV TextureType CUInt+ | KeyTexMapAxis TextureType CUInt+ | KeyUvTransform TextureType CUInt+ | KeyTexFlags TextureType CUInt++matKeyToTuple :: MatKey -> (String, CUInt, CUInt)+matKeyToTuple KeyName = ("?mat.name", 0, 0)+matKeyToTuple KeyTwoSided = ("$mat.twosided", 0, 0)+matKeyToTuple KeyShadingModel = ("$mat.shadingm", 0, 0)+matKeyToTuple KeyEnableWireframe = ("$mat.wireframe", 0, 0)+matKeyToTuple KeyBlendFunc = ("$mat.blend", 0, 0)+matKeyToTuple KeyOpacity = ("$mat.opacity", 0, 0)+matKeyToTuple KeyBumpScaling = ("$mat.bumpscaling", 0, 0)+matKeyToTuple KeyShininess = ("$mat.shininess", 0, 0)+matKeyToTuple KeyReflectivity = ("$mat.reflectivity", 0, 0)+matKeyToTuple KeyShininessStrength = ("$mat.shinpercent", 0, 0)+matKeyToTuple KeyRefraction = ("$mat.refracti", 0, 0)+matKeyToTuple KeyColorDiffuse = ("$clr.diffuse", 0, 0)+matKeyToTuple KeyColorAmbient = ("$clr.ambient", 0, 0)+matKeyToTuple KeyColorSpecular = ("$clr.specular", 0, 0)+matKeyToTuple KeyColorEmissive = ("$clr.emissive", 0, 0)+matKeyToTuple KeyColorTransparent = ("$clr.transparent", 0, 0)+matKeyToTuple KeyColorReflective = ("$clr.reflective", 0, 0)+matKeyToTuple KeyGlobalBackgroundImage = ("?bg.global", 0, 0)+matKeyToTuple (KeyTexture tType i) = ("$tex.file", fromEnum' tType, i)+matKeyToTuple (KeyUvWSrc tType i) = ("$tex.uvwsrc", fromEnum' tType, i)+matKeyToTuple (KeyTexOp tType i) = ("$tex.op", fromEnum' tType, i)+matKeyToTuple (KeyMapping tType i) = ("$tex.mapping", fromEnum' tType, i)+matKeyToTuple (KeyTexBlend tType i) = ("$tex.blend", fromEnum' tType, i)+matKeyToTuple (KeyMappingModeU tType i) = ("$tex.mapmodeu", fromEnum' tType, i)+matKeyToTuple (KeyMappingModeV tType i) = ("$tex.mapmodev", fromEnum' tType, i)+matKeyToTuple (KeyTexMapAxis tType i) = ("$tex.mapaxis", fromEnum' tType, i)+matKeyToTuple (KeyUvTransform tType i) = ("$tex.uvtrafo", fromEnum' tType, i)+matKeyToTuple (KeyTexFlags tType i) = ("$tex.flags", fromEnum' tType, i)++fromEnum' :: TextureType -> CUInt+fromEnum' = fromInteger . toInteger . fromEnum++data Plane3d = Plane3d+ { planeA :: Float+ , planeB :: Float+ , planeC :: Float+ , planeD :: Float+ } deriving (Show)+{#pointer *aiPlane as PlanePtr -> Plane3d#}++data Ray = Ray + { rayPos :: Vec3+ , rayDir :: Vec3+ } deriving (Show)+{#pointer *aiRay as RayPtr -> Ray#}++newtype Vec2F = Vec2F Vec2+newtype Vec3F = Vec3F Vec3+newtype Vec4F = Vec4F Vec4+newtype Mat3F = Mat3F Mat3+newtype Mat4F = Mat4F Mat4+newtype Color3F = Color3F Vec3+newtype Color4F = Color4F Vec4++{#pointer *aiColor3D as Color3Ptr -> Color3F#}+{#pointer *aiColor4D as Color4Ptr -> Color4F#}+{#pointer *aiVector2D as Vec2Ptr -> Vec2#}+{#pointer *aiVector3D as Vec3Ptr -> Vec3#}+{#pointer *aiMatrix3x3 as Mat3Ptr -> Mat3#}+{#pointer *aiMatrix4x4 as Mat4Ptr -> Mat4#}++data MemoryInfo = MemoryInfo + { memoryInfoTextures :: CUInt+ , memoryInfoMaterials :: CUInt+ , memoryInfoMeshes :: CUInt+ , memoryInfoNodes :: CUInt+ , memoryInfoAnimations :: CUInt+ , memoryInfoCameras :: CUInt+ , memoryInfoLights :: CUInt+ , memoryInfoTotal :: CUInt+ } deriving (Show)+{#pointer *aiMemoryInfo as MemoryInfoPtr -> MemoryInfo#}++-- data LogStream+-- {#pointer *aiLogStream as LogStreamPtr -> LogStream#}++data Quaternion = Quaternion + { quaternionW :: Float+ , quaternionX :: Float+ , quaternionY :: Float+ , quaternionZ :: Float+ } deriving (Show)+{#pointer *aiQuaternion as QuaternionPtr -> Quaternion#}++newtype AiString = AiString String deriving (Show)+{#pointer *aiString as StringPtr -> AiString#}++data Node = Node+ { nodeName :: String+ , transformation :: Mat4+ , parent :: Maybe Node+ , children :: [Node]+ , nodeMeshes :: [CUInt] -- Holds indices defining the node+ } deriving (Show)+{#pointer *aiNode as NodePtr -> Node#}++data Face = Face+ { indices :: [CUInt] -- Holds indices defining the face+ --, debug :: String+ } deriving (Show)+{#pointer *aiFace as FacePtr -> Face#}++data VertexWeight = VertexWeight+ { vertexId :: CUInt+ , weight :: CFloat+ } deriving (Show)+{#pointer *aiVertexWeight as VertexWeightPtr -> VertexWeight#}++data Bone = Bone+ { boneName :: String+ , weights :: [VertexWeight]+ , offpokeMatrix :: Mat4+ } deriving (Show)+{#pointer *aiBone as BonePtr -> Bone#}++data Mesh = Mesh+ { primitiveTypes :: [PrimitiveType]+ , vertices :: [Vec3]+ , normals :: [Vec3]+ , tangents :: [Vec3]+ , bitangents :: [Vec3]+ , colors :: [Vec4]+ , textureCoords :: [Vec3]+ , numUVComponents :: CUInt+ , faces :: [Face]+ , bones :: [Bone]+ , materialIndex :: CUInt+ , meshName :: String+ } deriving (Show)+{#pointer *aiMesh as MeshPtr -> Mesh#}++data MaterialProperty = MaterialProperty + { key :: String+ , semantic :: TextureType+ , index :: CUInt+ , mData :: String+ } deriving (Show)+{#pointer *aiMaterialProperty as MaterialPropertyPtr -> MaterialProperty#}++data Material = Material + { properties :: [MaterialProperty]+ } deriving (Show)+{#pointer *aiMaterial as MaterialPtr -> Material#}++data NodeAnim = NodeAnim + { dummy'NodeAnim :: Int+ } deriving (Show)++data MeshAnim = MeshAnim + { dummy'MeshAnim :: Int+ } deriving (Show)++data Animation = Animation + { animationName :: String+ , duration :: Double+ , ticksPerSecond :: Double+ , channels :: [NodeAnim]+ , meshChannels :: [MeshAnim]+ } deriving (Show)+{#pointer *aiAnimation as AnimationPtr -> Animation#}++data Texel = Texel + { dummy'Texel :: Int+ } deriving (Show)++data Texture = Texture + { width :: CUInt+ , height :: CUInt+ , achFormatHint :: String+ , pcData :: [Texel]+ } deriving (Show)+{#pointer *aiTexture as TexturePtr -> Texture#}++data UVTransform = UVTransform + { translation :: Vec2+ , scaling :: Vec2+ , rotation :: Float+ } deriving (Show)++data Light = Light+ { lightName :: String+ , mType :: LightSourceType+ , lightPosition :: Vec3+ , direction :: Vec3+ , attenuationConstant :: Float+ , attenuationLinear :: Float+ , attenuationQuadratic :: Float+ , colorDiffuse :: Vec3+ , colorSpecular :: Vec3+ , colorAmbient :: Vec3+ , angleInnerCone :: Float+ , angleOuterCone :: Float+ } deriving (Show)+{#pointer *aiLight as LightPtr -> Light#}++data Camera = Camera + { cameraName :: String+ , cameraPosition :: Vec3+ , up :: Vec3+ , lookAt :: Vec3+ , horizontalFOV :: Float+ , clipPlaneNear :: Float+ , clipPlaneFar :: Float+ , aspect :: Float+ } deriving (Show)+{#pointer *aiCamera as CameraPtr -> Camera#}++class Position a where+ position :: a -> Vec3++instance Position Camera where+ position = cameraPosition++instance Position Light where+ position = lightPosition++class Name a where+ name :: a -> String++instance Name Node where+ name = nodeName++instance Name Bone where+ name = boneName++instance Name Mesh where+ name = meshName++instance Name Animation where+ name = animationName++instance Name Light where+ name = lightName++instance Name Camera where+ name = cameraName++data Scene = Scene+ { flags :: [SceneFlags]+ , rootNode :: Node+ , meshes :: [Mesh]+ , materials :: [Material]+ , animations :: [Animation]+ , textures :: [Texture]+ , lights :: [Light]+ , cameras :: [Camera]+ } deriving (Show)+{#pointer *aiScene as ScenePtr -> Scene#}
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Joel Burget++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Joel Burget nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,17 @@+import Distribution.Simple+import Distribution.Simple.Setup+import Distribution.Simple.Utils (rawSystemExit, rawSystemStdout)+import Distribution.Verbosity+import System.Directory (setCurrentDirectory)++main = defaultMainWithHooks simpleUserHooks+ { preBuild = \a b -> makeLib a b >> preBuild simpleUserHooks a b }++makeLib :: Args -> BuildFlags -> IO ()+makeLib _ flags = do+ setCurrentDirectory "./assimp"+ rawSystemStdout (fromFlag $ buildVerbosity flags) "env"+ ["cmake", "-DENABLE_BOOST_WORKAROUND=ON"]+ rawSystemExit (fromFlag $ buildVerbosity flags) "env"+ ["CFLAGS=-D_LIB", "make"]+ setCurrentDirectory ".."
+ assimp.cabal view
@@ -0,0 +1,75 @@+Name: assimp+Version: 0.1+Synopsis: The Assimp asset import library++Description:+ Important: Install with+ @cabal install --extra-include-dirs \/usr\/local\/include\/assimp\/@+ Of course use the location of the include files on your system.+ .+ This library provides FFI bindings to the Assimp asset import+ library. It requires Assimp to already be installed. For more+ information about Assimp see the assimp website at+ <http://assimp.sourceforge.net/>.+ .+ This release corresponds to Assimp 2.0. When this package stabilizes I+ intend to track new releases of Assimp by also releasing new versions with+ the same version number, but this should be considered a beta release.+ Importing models is currently working. Textures and animations are+ untested.+ .+ Here is a sample program that imports a scene and then outputs the+ information contained in it.+ .+ > module Main where+ > + > import System (getArgs)+ > import Graphics.Formats.Assimp+ > + > -- Defines the preprocessing we want assimp to perform+ > processing = [ CalcTangentSpace+ > , Triangulate+ > , JoinIdenticalVertices+ > , SortByPType+ > ]+ > + > main = do+ > args <- getArgs+ > scene <- importFile (head args) processing+ > print scene -- Outputs all information in the scene+ > getVersionMajor >>= print -- Print the major version of assimp+ > getVersionMinor >>= print -- Print the minor version of assimp+ > getVersionRevision >>= print -- Print the version revision of assimp+ .+ See <https://github.com/joelburget/Cologne/blob/master/Cologne/AssimpImport.hs>+ for more.+ +License: BSD3+License-file: LICENSE+Author: Joel Burget+Maintainer: joelburget@gmail.com+Copyright: Joel Burget 2011+Category: Graphics+Build-type: Simple+Cabal-version: >= 1.6++Library+ Exposed-modules: Graphics.Formats.Assimp+ Other-modules:+ Graphics.Formats.Assimp.Types+ Graphics.Formats.Assimp.Storable+ Graphics.Formats.Assimp.Fun+ C2HS+ ghc-options: -Wall+ Build-depends: base >= 4 && < 5+ , haskell98+ , vect >= 0.4.6 && < 0.5+ Build-tools: c2hs, hsc2hs+ Extensions: ForeignFunctionInterface+ Extra-libraries: assimp+ Include-dirs: + Graphics/Formats/++Source-repository head+ type: git+ location: git@github.com:joelburget/assimp.git