packages feed

3dmodels (empty) → 0.3.0

raw patch · 9 files changed

+1372/−0 lines, 9 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, linear, packer

Files

+ 3dmodels.cabal view
@@ -0,0 +1,30 @@+-- Initial 3dmodels.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                3dmodels+version:             0.3.0+synopsis:            3D model parsers+description:         3D model parsers+homepage:            https://github.com/capsjac/3dmodels+license:             LGPL-3+license-file:        LICENSE+author:              capsjac <capsjac at gmail dot com>+maintainer:          capsjac <capsjac at gmail dot com>+copyright:           (c) 2014 capsjac+category:            Graphics+build-type:          Simple+extra-source-files:  ChangeLog+cabal-version:       >=1.10+extra-source-files:  ++source-repository head+  type:              git+  location:          https://github.com/capsjac/3dmodels++library+  exposed-modules:     Graphics.Model.MikuMikuDance, Graphics.Model.DirectX, Graphics.Model.Obj, Graphics.Model.MikuMikuDance.Loader, Graphics.Model.MikuMikuDance.Types+  -- other-modules:       +  other-extensions:    OverloadedStrings, RecordWildCards, TupleSections+  build-depends:       base >=4.7 && <4.8, attoparsec >=0.12 && <0.13, bytestring >=0.10 && <0.11, linear >=1.10 && <1.11, packer >=0.1 && <0.2+  -- hs-source-dirs:      +  default-language:    Haskell2010
+ ChangeLog view
@@ -0,0 +1,8 @@+Year 2014+	Aug 20, 15:40 Project start.+	Aug 21, 16:48 PMX 2.0 finished.+	        20:48 VMD finished.+	Aug 22, 21:16 PMD finished. -> 0.1.0.0+	Aug 23, 14:54 PMX 2.1 supported. -> 0.2.0.0+	Nov  8,  1:20 Refactored with linear, packer -> 0.3.0+
+ Graphics/Model/DirectX.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-- | DirectX Object File (.x) Parser+module Graphics.Model.DirectX (+  loadXOF,+  parseXOF,+  reverseHand,++  XOF(..),+  DxMesh(..),+  DxMaterial(..)+  ) where++import Control.Applicative+import Data.Attoparsec.ByteString.Char8 as A+import qualified Data.ByteString as B+import Data.Traversable+import Data.Word+import Linear++-- | DirectX Object File+data XOF = XOF+	{ _xofFormat :: B.ByteString+	, _xofTemplates :: [(B.ByteString, [B.ByteString])]+	, _xofHeader :: (Word16, Word16, Word32) -- ^ major minor flags+	, _xofMesh :: DxMesh+	-- , _xofFrames :: [(frame_name, [(mesh_name, DxMesh)])]+	-- , _xofAnimationSets :: [DxAnimationSet :: (frame_name, [DxKeyframe])]+	} deriving Show++data DxMesh = DxMesh+	{ _dxVertices :: [V3 Float]+	, _dxFaces :: [Either (V4 Word32) (V3 Word32)]+	, _dxIndexes :: [Word32]+	, _dxMaterials :: [DxMaterial]+	, _dxNormals :: [V3 Float]+	, _dxNormalIndexes :: [Either (V4 Word32) (V3 Word32)]+	, _dxTexCoords :: [V2 Float]+	, _dxVertexColors ::  [(Word32, V4 Float)]+	} deriving Show++data DxMaterial = DxMaterial+	{ _dxFaceColor :: V4 Float+	, _dxPower :: Float+	, _dxSpecular :: V3 Float+	, _dxEmissive :: V3 Float+	, _dxTexturePath :: Maybe B.ByteString+	} deriving Show++--data DxKeyframe =+--	  DxRotate Int Quaternion+--	| DxScale Int (V3 Float)+--	| DxTranslate Int (V3 Float)+--	| DxApplyMatrix Int M44 Float+++loadXOF :: FilePath -> IO XOF+loadXOF path = parseXOF <$> B.readFile path++parseXOF :: B.ByteString -> XOF+parseXOF bs =+	case feed (parse parseXMesh bs) "" of+		Done _ result -> result+		result -> error $ "parseXOF: Invalid format:\n" ++ show result++-- | Convert to right handed system.+reverseHand :: XOF -> XOF+reverseHand xof@XOF{_xofMesh=DxMesh{..}, ..} =+	xof { _xofMesh = (_xofMesh xof) {+		_dxVertices = fmap rhVtx _dxVertices,+		_dxFaces = fmap rhFace _dxFaces,+		_dxNormals = fmap rhVtx _dxNormals,+		_dxNormalIndexes = fmap rhFace _dxNormalIndexes+	}}+	where rhVtx (V3 x y z) = V3 x y (-z)+	      rhFace (Right (V3 a b c)) = Right $ V3 b a c+	      rhFace (Left (V4 a b c d)) = Left $ V4 a d c b++parseXMesh :: Parser XOF+parseXMesh = XOF+	<$> string "xof 0302txt 0064" <* skipSpace -- \r\n+	<*> many (templateDecl <* skipSpace)+	<*> headerDecl <* skipSpace+	<*> meshDecl++takeIdent :: Parser B.ByteString+takeIdent = A.takeWhile (inClass "a-zA-Z0-9_")++-- | e.g. template Header { field1; field2; ... }+templateDecl = try $+	(,) <$> (string "template" >> skipSpace >> takeIdent <* skipSpace) -- name+	<*> braces '{' '}' (skipSpace >> many (fieldDecl <* skipSpace)) -- fields++fieldDecl =+	braces '<' '>' (A.takeWhile (/= '>'))+	<|> braces '[' ']' (string "..." <|> takeIdent)+	<|> A.takeWhile (inClass "a-zA-Z0-9_ []") <* char ';'++float = realToFrac <$> signed double++getVector :: (Applicative a, Traversable a) => Parser (a Float)+getVector = sequenceA $ pure getFloatField++-- | e.g. <aaa> => braces '<' '>' (string "aaa")+braces l r p = char l *> p <* char r++semicolon = char ';' <* skipSpace+comma = char ','+maybeComma = (comma <|> return ' ') >> skipSpace++getIntField = decimal <* semicolon+getFloatField = float <* semicolon+getStringField = braces '"' '"' (A.takeWhile (/= '"')) <* semicolon++getVectorField :: (Applicative a, Traversable a) => Parser (a Float)+getVectorField = getVector <* semicolon++getArray :: Parser a -> Int -> Parser [a]+getArray parser len = count len (parser <* maybeComma) <* semicolon++section name p = do+	string name+	skipSpace+	braces '{' '}' (skipSpace >> p)++headerDecl :: Parser (Word16, Word16, Word32)+headerDecl = section "Header" $ do+	major <- fromIntegral <$> getIntField+	minor <- fromIntegral <$> getIntField+	flags <- fromIntegral <$> getIntField+	return (major, minor, flags)++meshDecl :: Parser DxMesh+meshDecl = section "Mesh" $ do+	vertices <- getIntField >>= getArray getVector+	faces <- getIntField >>= getArray meshFace+	(indexes, materials) <- option ([], []) meshMaterialList <* skipSpace+	(normals, faceNormals) <- option ([], []) meshNormals <* skipSpace+	DxMesh vertices faces indexes materials normals faceNormals+		<$> option [] meshTextureCoords <* skipSpace+		<*> option [] meshVertexColors <* skipSpace++meshFace = fmap Left meshFace4 <|> fmap Right meshFace3+meshFace4 = do+	char '4' >> semicolon+	sequenceA $ V4 (decimal <* comma) (decimal <* comma)+		(decimal <* comma) (decimal <* char ';')+meshFace3 = do+	char '3' >> semicolon+	sequenceA $ V3 (decimal <* comma)+		(decimal <* comma) (decimal <* char ';')++meshMaterialList = section "MeshMaterialList" $ do+	nMaterials <- getIntField+	indexes <- getIntField >>= getArray faceIndex+	semicolon+	materials <- count nMaterials (materialDecl <* skipSpace)+	return (indexes, materials)++faceIndex :: Parser Word32+faceIndex = decimal++materialDecl = section "Material" $ do+	faceColor <- getVectorField+	power <- getFloatField+	specularColor <- getVectorField+	emissiveColor <- getVectorField+	texFile <- optional textureFilename+	skipSpace+	return $ DxMaterial faceColor power specularColor emissiveColor texFile++textureFilename = section "TextureFilename" getStringField++meshNormals = section "MeshNormals" $ do+	normals <- getIntField >>= getArray getVector+	faceNormals <- getIntField >>= getArray meshFace+	return (normals, faceNormals)++meshTextureCoords = section "MeshTextureCoords" $+	getIntField >>= getArray getVector++meshVertexColors = section "MeshVertexColors" $+	getIntField >>= getArray indexedColor++indexedColor = (,) <$> fmap fromIntegral getIntField <*> getVector+
+ Graphics/Model/MikuMikuDance.hs view
@@ -0,0 +1,19 @@+-- | MikuMikuDance (MMD) model/motion reader.+-- This module provides unpacking interfaces for MMD 3D models and their motions,+-- both traditional PMD and newer PMX format are fully supported.+-- +-- > model <- loadMMD "博麗霊夢_n＋式/博麗霊夢_n＋式.pmd" :: IO MMD+-- +-- > motion <- loadVMD "Motion_BadApple/BadApple_Rside_20110206.vmd" :: IO VMD+module Graphics.Model.MikuMikuDance (+  loadMMD,+  decodeMMD,+  unpackMMD,+  loadVMD,+  decodeVMD,+  unpackVMD,+  module Graphics.Model.MikuMikuDance.Types+) where+import Graphics.Model.MikuMikuDance.Types+import Graphics.Model.MikuMikuDance.Loader+
+ Graphics/Model/MikuMikuDance/Loader.hs view
@@ -0,0 +1,530 @@+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Model.MikuMikuDance.Loader where+import Control.Applicative+import Control.Monad+import Data.Int+import Data.Bits+import Data.Packer+import qualified Data.ByteString as B+import Graphics.Model.MikuMikuDance.Types+import Linear+import Unsafe.Coerce+++getFloat :: Unpacking Float -- Performance hack (may not work on your devices!)+getFloat = unsafeCoerce <$> getWord32LE++get2 :: Unpacking a -> Unpacking (V2 a)+get2 get = V2 <$> get <*> get++get3 :: Unpacking a -> Unpacking (V3 a)+get3 get = V3 <$> get <*> get <*> get++get4 :: Unpacking a -> Unpacking (V4 a)+get4 get = V4 <$> get <*> get <*> get <*> get++getV2 :: Unpacking (V2 Float)+getV2 = get2 getFloat++getV3 :: Unpacking (V3 Float)+getV3 = get3 getFloat++getV4 :: Unpacking (V4 Float)+getV4 = get4 getFloat++getWord8Int, getWord16Int, getWord32Int :: Unpacking Int+getWord8Int = fromIntegral <$> getWord8+getWord16Int = fromIntegral <$> getWord16LE+getWord32Int = fromIntegral <$> getWord32LE++-- Left handed system -> Right handed system+ltrTrans (V3 x y z) = V3 x y (-z)+ltrEular (V3 x y z) = V3 (-x) (-y) z+ltrQuat (V4 t i j k) = V4 (-t) i j k+getPos = fmap ltrTrans getV3+getEular = fmap ltrEular getV3+getQuat = fmap ltrQuat getV4+++-- * PMX++loadMMD :: FilePath -> IO MMD +loadMMD path = decodeMMD <$> B.readFile path++decodeMMD :: B.ByteString -> MMD+decodeMMD bs = runUnpacking unpackMMD bs++unpackMMD :: Unpacking MMD+unpackMMD = do+	magic <- getWord32BE+	case magic of+		0x506d6400 -> unpackPMD+		0x504d5820 -> unpackPMX+		_ -> fail "Not a MMD Model"++getUnsignedIndexUnpacker :: Unpacking (Unpacking Int32)+getUnsignedIndexUnpacker = do+	size <- getWord8+	return $ case size of+		1 -> fromIntegral <$> getWord8+		2 -> fromIntegral <$> getWord16LE+		4 -> fromIntegral <$> getWord32LE++getIndexUnpacker :: Unpacking (Unpacking Int32)+getIndexUnpacker = do+	size <- getWord8+	return $ case size of+		1 -> ((fromIntegral :: Int8 -> Int32) . fromIntegral) <$> getWord8+		2 -> ((fromIntegral :: Int16 -> Int32) . fromIntegral) <$> getWord16LE+		4 -> fromIntegral <$> getWord32LE++getTextBuf :: Unpacking B.ByteString+getTextBuf = getWord32Int >>= getBytesCopy++-- Polygon Model Extended+unpackPMX :: Unpacking MMD+unpackPMX = do+	version <- getFloat+	size <- getWord8+	when ((version /= 2.0 && version /= 2.1) || size /= 8) $+		fail "Not PMX 2.0/2.1"+	+	-- PMX Header+	-- 0: UTF-16, 1: UTF-8+	isUTF16 <- getWord8+	let charset 0 = "UTF-16"+	    charset 1 = "UTF-8"+	numExtUVs <- getWord8+	getVertexIndex <- getUnsignedIndexUnpacker+	getTextureIndex <- getIndexUnpacker+	getMaterialndex <- getIndexUnpacker+	getBoneIndex <- getIndexUnpacker+	getMorphIndex <- getIndexUnpacker+	getBodyIndex <- getIndexUnpacker+	modelName <- getTextBuf+	modelNameEn <- getTextBuf+	comment <- getTextBuf+	commentEn <- getTextBuf++	-- Vertex+	numVertices <- getWord32Int+	vertices <- replicateM numVertices $ do+		pos <- getPos+		normal <- getPos+		uv <- getV2+		extV4s <- replicateM (fromIntegral numExtUVs) getV4+		weightFormat <- getWord8+		w <- case weightFormat of+			0 -> BDEF1 <$> getBoneIndex+			1 -> BDEF2 <$> get2 getBoneIndex <*> getFloat+			2 -> BDEF4 <$> get4 getBoneIndex <*> getV4+			-- SDEF need left<->right handed system transformation?+			3 -> SDEF <$> get2 getBoneIndex <*> getFloat <*> get3 getPos+			4 -> QDEF <$> get4 getBoneIndex <*> getV4+		-- edgeScalingFactor+		esf <- getFloat+		return $ MMDVertex pos normal uv extV4s w esf++	-- Plane+	numPlanes <- getWord32Int+	planes <- replicateM (numPlanes `div` 3) $ do+		V3 p q r <- get3 getVertexIndex+		return $ V3 q p r -- from left to right+	+	-- Texture+	numTextures <- getWord32Int+	textures <- replicateM numTextures getTextBuf+	+	-- Material+	numMaterials <- getWord32Int+	materials <- replicateM numMaterials $ do+		name <- getTextBuf+		nameEn <- getTextBuf+		diffuse <- getV4+		specular <- getV3+		shininess <- getFloat+		ambient <- getV3+		renderFlags <- getWord8+		edgeColor <- getV4+		edgeSize <- getFloat+		tex <- getTextureIndex+		sphereTex <- getTextureIndex+		sphereMode <- getWord8+		toonFlag <- getWord8+		toon <- case toonFlag of+			0 -> getTextureIndex+			1 -> (\x -> fromIntegral x - 10) <$> getWord8+		script <- getTextBuf+		verticesCount <- getWord32LE+		return $ MMDMaterial name nameEn diffuse specular shininess ambient+			renderFlags edgeColor edgeSize tex sphereTex sphereMode toon+			script verticesCount++	-- Bone+	numBones <- getWord32Int+	bones <- replicateM numBones $ do+		name <- getTextBuf+		nameEn <- getTextBuf+		pos <- getPos+		parent <- getBoneIndex+		transDepth <- getWord32Int+		flags <- getWord16LE+		link <- if flags .&. 1 == 0+			then Left <$> getV3+			else Right <$> getBoneIndex+		following <- if flags .&. 0x300 /= 0+			then Just <$> ((,) <$> getBoneIndex <*> getFloat)+			else return Nothing+		axis <- if flags .&. 0x400 /= 0+			then Just <$> getV3+			else return Nothing+		local <- if flags .&. 0x800 /= 0+			then Just <$> ((,) <$> getPos <*> getPos)+			else return Nothing+		external <- if flags .&. 0x2000 /= 0+			then Just <$> getWord32Int+			else return Nothing+		ik <- if flags .&. 0x20 /= 0+			then do+				ix <- getBoneIndex+				lc <- getWord32Int+				maxRot <- getFloat+				numlink <- getWord32Int+				links <- replicateM numlink $ do+					ix <- getBoneIndex+					ranged <- getWord8+					limit <- if ranged == 1+						then Just <$> ((,) <$> getEular <*> getEular)+						else return Nothing+					return (ix, limit)+				return . Just $ MMDIK ix lc maxRot links+			else return Nothing+		return $ MMDBone name nameEn pos parent transDepth flags link+			following axis local external ik++	-- Morph+	numMorphs <- getWord32Int+	morphs <- replicateM numMorphs $ do+		name <- getTextBuf+		nameEn <- getTextBuf+		facial <- getWord8+		morphType <- getWord8+		let getMorphOffset = case morphType of+			0 -> GroupMorph <$> getMorphIndex <*> getFloat+			1 -> VertexMorph <$> getVertexIndex <*> getPos+			2 -> BoneMorph <$> getBoneIndex <*> getPos <*> getQuat+			3 -> UVMorph <$> getVertexIndex <*> getV4+			4 -> UV1Morph <$> getVertexIndex <*> getV4+			5 -> UV2Morph <$> getVertexIndex <*> getV4+			6 -> UV3Morph <$> getVertexIndex <*> getV4+			7 -> UV4Morph <$> getVertexIndex <*> getV4+			8 -> MaterialMorph <$> getMaterialndex <*> getWord8+				<*> getV4 <*> getV3 <*> getFloat+				<*> getV3 <*> getV4 <*> getFloat+				<*> getV4 <*> getV4 <*> getV4+			9 -> FlipMorph <$> getMorphIndex <*> getFloat+			10 -> ImpulseMorph <$> getBodyIndex <*> ((/= 0) <$> getWord8)+				<*> getPos <*> getEular+		numOffsets <- getWord32Int+		offsets <- replicateM numOffsets getMorphOffset+		return $ MMDMorph name nameEn facial offsets++	-- Group+	numGroups <- getWord32Int+	groups <- replicateM numGroups $ do+		name <- getTextBuf+		nameEn <- getTextBuf+		isSpecial <- getWord8+		count <- getWord32Int+		elements <- replicateM count $ do+			kind <- getWord8+			case kind of+				0 -> Left <$> getBoneIndex+				1 -> Right <$> getMorphIndex+		return $ MMDGroup name nameEn (isSpecial /= 0) elements++	-- Rigid Body+	numRigidBodies <- getWord32Int+	bodies <- replicateM numRigidBodies $+		MMDRigidBody <$> getTextBuf <*> getTextBuf <*> getBoneIndex+			<*> getWord8 <*> getWord16LE <*> getWord8+			<*> getV3 <*> getPos <*> getEular+			<*> getFloat <*> getFloat <*> getFloat+			<*> getFloat <*> getFloat <*> getWord8++	-- Joint+	numJoints <- getWord32Int+	joints <- replicateM numJoints $+		MMDJoint <$> getTextBuf <*> getTextBuf <*> getWord8+			<*> getBodyIndex <*> getBodyIndex+			<*> getPos <*> getEular+			<*> getPos <*> getPos <*> getEular <*> getEular+			<*> getPos <*> getEular++	-- Soft Body+	numSoftBodies <- getWord32Int+	softBodies <- replicateM numSoftBodies $+		MMDSoftBody <$> getTextBuf <*> getTextBuf <*> getWord8+			<*> getMaterialndex <*> getWord8 <*> getWord16LE+			<*> getWord8 <*> getWord32Int <*> getWord32Int+			<*> getFloat <*> getFloat <*> getWord32Int+			<*> get3 getV4 <*> get2 getV3+			<*> get4 getWord32Int <*> getV3+			<*> (getWord32Int >>= flip replicateM (+				(,,) <$> getBodyIndex <*> getVertexIndex+					<*> ((== 1) <$> getWord8)))+			<*> (getWord32Int >>= flip replicateM getVertexIndex)++	-- Sums up!+	return $ MMD version (charset isUTF16) numExtUVs+		modelName modelNameEn comment commentEn+		vertices planes textures [] materials bones morphs groups bodies+		joints softBodies++-- get fixed length C string terminating NUL byte+getFixedStr :: Int -> Unpacking B.ByteString+getFixedStr l = B.takeWhile (/= 0) <$> getBytesCopy l++-- Polygon Model Data+unpackPMD :: Unpacking MMD+unpackPMD = do+	unpackSetPosition 3+	version <- getFloat+	when (version /= 1.0) $+		fail "Not PMD 1.0"+	+	-- PMD Header+	name <- getFixedStr 20+	comment <- getFixedStr 256+	+	-- Vertex+	numVertices <- getWord32Int+	vertices <- replicateM numVertices $ do+		v <- MMDVertex <$> getPos <*> getPos <*> getV2+		weight <- BDEF2 <$> get2 getBoneIndex <*> getPercent+		edgeFlag <- getWord8+		let edgeScale = fromIntegral (1 - edgeFlag)+		return $ v [] weight edgeScale++	-- Plane+	numPlanesX3 <- getWord32Int+	planes <- replicateM (numPlanesX3 `div` 3) $ do+		V3 p q r <- get3 getVertexIndex+		return $ V3 q p r++	-- Material+	numMaterials <- getWord32Int+	materials <- forM [0 .. numMaterials - 1] $ \i -> do+		diffuse <- getV4+		specularity <- getFloat+		specular <- getV3+		ambient <- getV3+		toonIx <- fromIntegral <$> getWord8 -- -1:0.bmp, 0..9:[1..10].bmp+		edgeFlag <- getWord8 -- 1 to disable+		numVertices <- getWord32LE+		texturePath <- getFixedStr 20+		let sphereMode =+			-- "tex.bmp*sphere.sph" => Multiply (MMD 5.12-)+			-- "tex.bmp*sphere.spa" => Plus (MMD 5.12-)+			-- "tex.bmp/sphere.sph" => Multiply (MMD 5.11)+			-- "tex.bmp" or "sphere.sph" => None (MMD 5.09-)+			if 42 `B.elem` texturePath -- or 47 `elem` texturePath+			then if ".spa" `B.isSuffixOf` texturePath+				then 2 -- Add+				else 1 -- Mul+			else 0 -- None+		let i' = fromIntegral i+		return $ MMDMaterial texturePath ""+			diffuse specular specularity ambient+			((1 - edgeFlag) * 16) -- draw edge+			(V4 0 0 0 1) 1.0 (i' * 2) (i' * 2 + 1) sphereMode+			(toonIx - 10) B.empty numVertices++	-- Texture+	let split x y | mSphereMode x == 0 = mNameJa x : mNameJa x : y+	    split x y = t1 : B.tail t2 : y+	    	where (t1,t2) = B.break (== 42) (mNameJa x)+	let textures = foldr split [] materials+	+	-- Bone+	numBones <- getWord16Int+	bones <- replicateM numBones $ do+		name <- getFixedStr 20+		parent <- getBoneIndex+		tailBone <- getBoneIndex+		-- 0:回転 1:回転と移動 2:IK 3:不明 4:IK影響下+		-- 5:回転影響下 6:IK接続先 7:非表示 8:捻り 9:回転運動+		typ <- getWord8+		ik <- getBoneIndex+		headPos <- getPos+		return $ MMDBone name "" headPos parent+			0 0 -- XXX ?+			(Right 0) Nothing --XXX follow link+			Nothing Nothing Nothing Nothing++	-- IK+	numIKBones <- getWord16Int+	ikbones <- replicateM numIKBones $ do+		bone <- getBoneIndex+		target <- getBoneIndex+		ikLen <- getWord8Int+		iter <- getWord16Int+		rotLimit <- (* 4) <$> getFloat+		links <- replicateM ikLen $+			(\x -> (x, Nothing)) <$> getBoneIndex+		return $ (bone, MMDIK target iter rotLimit links)+	let bones' = zipWith (\ i bone ->+		bone { bIK = lookup i ikbones }) [0..] bones++	-- Face+	numFaces <- getWord16Int+	faces <- replicateM numFaces $ do+		name <- getFixedStr 20+		numVertices <- getWord32Int+		facial <- getWord8+		-- 0:Base, 1:Brow, 2: Eye, 3: Lip, 4:Other+		-- XXX 'base' should be ignored (0,0,0)???+		vMorph <- replicateM numVertices $+			VertexMorph <$> fmap fromIntegral getWord32LE <*> getPos+		return $ MMDMorph name "" facial vMorph+		+	faceListLen <- getWord8Int+	faceList <- replicateM faceListLen getMorphIndex++	-- Group+	boneGroupsLen <- getWord8Int+	boneGroups <- replicateM boneGroupsLen (getFixedStr 50)+	let bGsEn = replicate boneGroupsLen ""+	numGroupedBones <- getWord32Int+	groupedBones <- replicateM numGroupedBones $+		(,) <$> getBoneIndex <*> getWord8++	-- Ext - English support since MMD 4.03+	empty <- isEmpty+	haveEnNames <- if empty then return False else (== 1) <$> getWord8+	(nameEn, commentEn, bones, faces, bGsEn) <-+		if not haveEnNames+		then return ("", "", bones, faces, bGsEn)+		else do+			name' <- getFixedStr 20+			comment' <- getFixedStr 256+			bones' <- forM bones $ \bone -> do+					nameEn <- getFixedStr 20+					return bone { bName = nameEn }+			faces' <- forM faces $ \morph -> do+					nameEn <- getFixedStr 20+					return morph { mphName = nameEn }+			bGsEn' <- replicateM (boneGroupsLen - 1) (getFixedStr 50)+			return (name', comment', bones', faces', bGsEn')++	-- UTF-16+	let root = "R\NULo\NULo\NULt\NUL"+	let rootGroup = MMDGroup root root True [Left 0]+	let faceGroup = MMDGroup "h\136\197`" "E\NULx\NULp\NUL" True+			(map Right faceList)+	let groups = rootGroup : faceGroup :+		zipWith3 (\i j e ->+			MMDGroup j e False $+				map (Left . fst) $+					filter ((== i).snd) groupedBones+		) [1..] boneGroups bGsEn+		-- group 0 ('center') is reserved for the root bone+	+	-- toon texture list since MMD 4.03+	toonTexList <- if empty then return []+		else replicateM 10 (getFixedStr 100)++	-- Ext - Bullet Physics+	--    Rigid Body+	numRigidBodies <- getWord32Int+	bodies <- replicateM numRigidBodies $+		MMDRigidBody <$> getFixedStr 20 <*> pure "" <*> getBoneIndex+			<*> getWord8 <*> getWord16LE <*> getWord8+			<*> getV3 <*> getPos <*> getEular+			<*> getFloat <*> getFloat <*> getFloat+			<*> getFloat <*> getFloat <*> getWord8+	--    Joint+	numJoints <- getWord32Int+	joints <- replicateM numJoints $+		MMDJoint <$> getFixedStr 20 <*> pure "" <*> pure 0+			<*> getBodyIndex <*> getBodyIndex+			<*> getPos <*> getEular+			<*> getPos <*> getPos <*> getEular <*> getEular+			<*> getPos <*> getEular+	+	-- Sums up!+	return $ MMD 1 "Shift-JIS" 0 name nameEn comment commentEn+		vertices planes textures toonTexList materials bones'+		faces groups bodies joints []+	where+		toInt16 = fromIntegral+		toInt32 = fromIntegral :: Int16 -> Int32+		getBoneIndex = toInt32 . toInt16 <$> getWord16LE+		getPercent = (/100) . fromIntegral <$> getWord8+		getVertexIndex = fromIntegral <$> getWord16LE+		getMorphIndex = getVertexIndex+		getBodyIndex = fromIntegral <$> getWord32LE+++-- * VMD++loadVMD :: FilePath -> IO VMD+loadVMD path = decodeVMD <$> B.readFile path++decodeVMD :: B.ByteString -> VMD+decodeVMD bs = runUnpacking unpackVMD bs++unpackVMD :: Unpacking VMD+unpackVMD = do+	magic <- getBytes 30+	when (magic /= "Vocaloid Motion Data 0002\0\0\0\0\0") $+		-- MMD 3.0+ required.+		fail "Not Vocaloid Motion Data"+	+	-- If the content is camera, light, and self shadow,+	-- model name should be "カメラ・照明\0on Data"+	name <- getFixedStr 20++	numBoneKeyframes <- getWord32Int+	boneM <- replicateM numBoneKeyframes $+		BoneKeyframe <$> getFixedStr 15 <*> getWord32LE <*> getPos+			<*> getQuat <*> replicateM 64 (fromIntegral <$> getWord8)+	+	numMorphKeyframes <- getWord32Int+	morphM <- replicateM numMorphKeyframes $+		MorphKeyframe <$> getFixedStr 15 <*> getWord32LE <*> getFloat++	numCameraKeyframes <- getWord32Int+	cameraM <- replicateM numCameraKeyframes $+		CameraKeyframe <$> getWord32LE <*> getFloat+			<*> getPos <*> getEular+			<*> replicateM 24 (fromIntegral <$> getWord8)+			<*> getWord32LE <*> ((== 0) <$> getWord8)++	numLightKeyframes <- getWord32Int+	lightM <- replicateM numLightKeyframes $+		LightKeyframe <$> getWord32LE <*> getV3 <*> getPos++	-- After MMDv6.19 --+	empty <- isEmpty+	shadowM <- if empty then return []+	else do+		numSelfShadowKeyframes <- getWord32Int+		replicateM numSelfShadowKeyframes $+			ShadowKeyframe <$> getWord32LE+				<*> (fromIntegral <$> getWord8) <*> getFloat+	+	-- Since MMDv7.40 --+	empty <- isEmpty+	ctrlM <- if empty then return []+	else do+		numCtrlKeyframes <- getWord32Int+		replicateM numCtrlKeyframes $+			ControlKeyframe <$> getWord32LE <*> ((== 1) <$> getWord8)+				<*> (getWord32Int >>= \count ->+					replicateM count+					((,) <$> getFixedStr 20 <*> ((== 1) <$> getWord8)))++	-- Sums up!+	return $ VMD name boneM morphM cameraM lightM shadowM ctrlM+
+ Graphics/Model/MikuMikuDance/Types.hs view
@@ -0,0 +1,306 @@+module Graphics.Model.MikuMikuDance.Types (+  VertexIx,+  TexIx,+  BoneIx,+  MorphIx,+  MaterialIx,+  BodyIx,+  MMD(..),+  MMDVertex(..),+  MMDWeight(..),+  MMDMaterial(..),+  MMDBone(..),+  MMDIK(..),+  MMDMorph(..),+  MMDMorphOffest(..),+  MMDGroup(..),+  MMDRigidBody(..),+  MMDJoint(..),+  MMDSoftBody(..),++  VMD(..),+  BoneKeyframe(..),+  MorphKeyframe(..),+  CameraKeyframe(..),+  LightKeyframe(..),+  ShadowKeyframe(..),+  ControlKeyframe(..),++  VPD+  ) where+import qualified Data.ByteString as B+import Data.Int+import Data.Word+import Linear+++-- * PMX (Polygon Model eXtended)++type VertexIx = Int32+type TexIx = Int32+type BoneIx = Int32+type MorphIx = Int32+type MaterialIx = Int32+type BodyIx = Int32++-- | PMX 2.1 spec made by Kyockhook-P (極北P)+data MMD = MMD+	{ mmdFormat :: Float+	-- ^ 1.0: PMD, 2.0/2.1:PMX+	, mmdCharCode :: String+	-- ^ UTF-16, UTF-8, Shift-JIS+	, mmdExtUVs :: Word8 -- ^ in [0..4]+	, mmdNameJa :: B.ByteString+	, mmdName :: B.ByteString+	, mmdCommentJa :: B.ByteString+	, mmdComment :: B.ByteString+	, mmdVertices :: [MMDVertex]+	, mmdPlanes :: [V3 VertexIx]+	-- ^ ABC(Triangle), /Since 2.1/: AAA(Point), ABA(Line)+	, mmdTextures :: [B.ByteString]+	, mmdAltToonTex :: [B.ByteString]+	-- ^ length: 0(PMX) or 10(PMD, if exists)+	, mmdMaterials :: [MMDMaterial]+	, mmdBones :: [MMDBone]+	, mmdMorphs :: [MMDMorph]+	, mmdGroups :: [MMDGroup]+	, mmdRigidBodies :: [MMDRigidBody]+	, mmdJoints :: [MMDJoint]+	, mmdSoftBodies :: [MMDSoftBody]+	-- ^ /Since 2.1/+	} deriving Show++data MMDVertex = MMDVertex+	{ vPosition :: V3 Float+	, vNormal :: V3 Float+	, vUV :: V2 Float+	, vExtUVs :: [V4 Float]+	, vWeight :: MMDWeight+	, vEdgeScale :: Float+	} deriving Show++data MMDWeight =+	  BDEF1 BoneIx+	-- | Weight of the first bone+	| BDEF2 (V2 BoneIx) Float+	-- | Weight of each bone+	| BDEF4 (V4 BoneIx) (V4 Float)+	-- | BDEF2 + SDEF-C(x,y,z) + SDEF-R0(x,y,z) + SDEF-R1(x,y,z)+	| SDEF (V2 BoneIx) Float (M33 Float)+	-- | /Since 2.1/ DualQuaternion+	| QDEF (V4 BoneIx) (V4 Float)+	deriving Show++data MMDMaterial = MMDMaterial+	{ mNameJa :: B.ByteString+	, mName :: B.ByteString+	, mDiffuse :: V4 Float -- ^ RGBA+	, mSpecular :: V3 Float -- ^ RGB+	, mSpecularFactor :: Float+	, mAmbient :: V3 Float -- ^ RGB+	-- | 1:cullface=both, 2:drop shadow, 4:render to self shadow map,+	-- 8:render to self shadow, 16:draw edges,+	-- /Since 2.1/ => 32:vertex color, 64:As Points, 128:As Lines+	, mOptions :: Word8+	, mEdgeColor :: V4 Float -- ^ RGBA+	-- | /Since 2.1/ Point size (See mOptions)+	, mEdgeSize :: Float+	, mTexture :: TexIx+	, mSphereTexture :: TexIx+	-- | 0: None, 1: Multiply, 2: Add, 3: Use subtexture+	, mSphereMode :: Word8+	-- | Indexed texture >= 0, -10 <= shered toon texture (0-9) - 10 < 0+	, mToonTexture :: TexIx+	, mComment :: B.ByteString+	-- | The number of planes * 3+	, mNumVertices :: Word32+	} deriving Show++data MMDBone = MMDBone+	{ bNameJa :: B.ByteString+	, bName :: B.ByteString+	, bPosition :: V3 Float+	, bParent :: BoneIx+	, bTransformDepth :: Int+	, bFlags :: Word16+	, bLInk :: Either (V3 Float) BoneIx -- ^ offset or bone index+	, bFollow :: Maybe (BoneIx, Float)+	, bAxis :: Maybe (V3 Float)+	, bLocalAxis :: Maybe (V3 Float, V3 Float)+	, bExternalParent :: Maybe Int+	, bIK :: Maybe MMDIK+	} deriving Show++data MMDIK = MMDIK+	{ ikTarget :: BoneIx+	, ikLoopCount :: Int+	, ikRotLimitPerLoop :: Float+	, ikLinks :: [(BoneIx, Maybe (V3 Float, V3 Float))]+	} deriving Show++data MMDMorph = MMDMorph+	{ mphNameJa :: B.ByteString+	, mphName :: B.ByteString+	, mphUICtrl :: Word8+	, mphOffsets :: [MMDMorphOffest]+	} deriving Show++data MMDMorphOffest =+	  GroupMorph MorphIx Float+	| VertexMorph VertexIx (V3 Float) -- ^ offset+	| BoneMorph BoneIx (V3 Float) (V4 Float)+	| UVMorph VertexIx (V4 Float)+	| UV1Morph VertexIx (V4 Float)+	| UV2Morph VertexIx (V4 Float)+	| UV3Morph VertexIx (V4 Float)+	| UV4Morph VertexIx (V4 Float)+	| MaterialMorph MaterialIx Word8 (V4 Float) (V3 Float) Float (V3 Float) (V4 Float) Float (V4 Float) (V4 Float) (V4 Float)+	-- ^ 0:*, 1:+. Diffuse, Specular, SpecularFactor, Ambient, EdgeColor, EdgeSize, TextureFactors, SphereTexFactors, ToonTexFactors.+	| FlipMorph MorphIx Float+	-- ^ /Since 2.1/+	| ImpulseMorph BodyIx Bool (V3 Float) (V3 Float)+	-- ^ /Since 2.1/ isLocal, velocity, torque+	deriving Show++data MMDGroup = MMDGroup+	{ gNameJa :: B.ByteString+	, gName :: B.ByteString+	, gIsReserved :: Bool+	, gElements :: [Either BoneIx MorphIx]+	} deriving Show++data MMDRigidBody = MMDRigidBody+	{ rbNameJa :: B.ByteString+	, rbName :: B.ByteString+	, rbRelated :: BoneIx+	, rbGroup :: Word8+	, rbNoCollisionGroup :: Word16+	, rbShape :: Word8 -- ^ 0:Ball, 1:Box, 2:Capsule+	, rbSize :: V3 Float -- ^ (x,y,z)+	, rbPosition :: V3 Float -- ^ (x,y,z)+	, rbRotation :: V3 Float -- ^ (x,y,z)+	, rbMass :: Float+	, rbSpeedAttenuation :: Float+	, rbRotAttenuation :: Float+	, rbRepulsion :: Float+	, rbFriction :: Float+	, rbComputeMode :: Word8 -- ^ 0: static, 1: dynamic, 2: both+	} deriving Show++data MMDJoint = MMDJoint+	{ jNameJa :: B.ByteString+	, jName :: B.ByteString+	, jointType :: Word8+	, jBone1 :: BodyIx+	, jBone2 :: BodyIx+	, jPosition :: V3 Float+	, jRotation :: V3 Float+	, jPosUpperBound :: V3 Float+	, jPosLowerBound :: V3 Float+	, jRotUpperBound :: V3 Float+	, jRotLowerBound :: V3 Float+	, jPosSpringConst :: V3 Float+	, jRotSpringConst :: V3 Float+	} deriving Show++-- | /Since 2.1/+data MMDSoftBody = MMDSoftBody+	{ sbNameJa :: B.ByteString+	, sbName :: B.ByteString+	, sbShape :: Word8+	-- ^ 0:TriMesh, 1:Rope+	, sbRelated :: MaterialIx+	, sbGroup :: Word8+	, sbNoCollisionGroup :: Word16+	, sbOptions :: Word8+	-- ^ 1:generateBendingConstraints(B-Link), 2:generateClusters, 4:randomizeConstraints+	, sbBLinkDistance :: Int+	, sbNumClusters :: Int+	, sbMass :: Float+	, sbCollisionMargin :: Float+	, sbAeroModel :: Int+	-- ^ 0:V_Point, 1:V_TwoSided, 2:V_OneSided, 3:F_TwoSided, 4:F_OneSided+	, sbConfig :: V3 (V4 Float)+	-- ^ (VCF DP DG LF, PR VC DF MT, CHR KHR SHR AHR)+	, sbCluster :: V2 (V3 Float)+	-- ^ (SRHR_CL SKHR_CL SSHR_CL, SR_SPLT_CL SK_SPLT_CL SS_SPLT_CL)+	, sbIteration :: V4 Int+	-- ^ V_IT P_IT D_IT C_IT+	, sbMaterial :: V3 Float+	-- ^ LST AST VST+	, sbAnchorRigidBodies :: [(BodyIx, VertexIx, Bool)]+	-- ^ True: Enable Near mode+	, sbPinVertices :: [VertexIx]+	} deriving Show+++-- * VMD (Vocaloid Motion Data)++-- VMD strings are encoded in CP932+-- | Vocaloid Motion Data+data VMD = VMD+	{ vmdModelName :: B.ByteString -- ^ CP932+	, boneMotion :: [BoneKeyframe]+	, morphMotion :: [MorphKeyframe]+	, cameraMotion :: [CameraKeyframe]+	, lightMotion :: [LightKeyframe]+	, shadowMotion :: [ShadowKeyframe]+	, controlMotion :: [ControlKeyframe]+	} deriving Show++data BoneKeyframe = BoneKeyframe+	{ bkName :: B.ByteString+	, bkFrame :: Word32+	, bkPosition :: V3 Float -- ^ XYZ or (0,0,0)+	, bkRotation :: V4 Float -- ^ Quaternion XYZW or (0,0,0,1)+	, bkInterpolation :: [Int] -- XXX description+	} deriving Show++data MorphKeyframe = MorphKeyframe+	{ moName :: B.ByteString+	, moFrame :: Word32+	, moFace :: Float+	} deriving Show++data CameraKeyframe = CameraKeyframe+	{ ckFrame :: Word32+	, ckDistance :: Float+	, ckPosition :: V3 Float+	, ckRotation :: V3 Float+	, ckBezier :: [Int] -- ^ bezier int[24]+	, ckViewingAngle :: Word32 -- ^ in degree+	, ckPerspective :: Bool -- 0:Enable, 1:Disable+	} deriving Show++data LightKeyframe = LightKeyframe+	{ lkFrame :: Word32+	, lkColor :: V3 Float+	, lkPosition :: V3 Float+	} deriving Show++data ShadowKeyframe = ShadowKeyframe+	{ skFrame :: Word32+	, skType :: Int+	, skDistance :: Float -- ^ 0.1 - (dist * 0.00001)+	} deriving Show++data ControlKeyframe = ControlKeyframe+	{ ctFrame :: Word32+	, ctModelVisibility :: Bool+	, ctIKCapability :: [(B.ByteString, Bool)]+	} deriving Show+++-- * VPD++-- | Vocaloid Pose Data+-- (name of a Bone, position of the bone, quaternion of the bone)+type VPD = (B.ByteString, V3 Float, V4 Float)+++-- * VAC++-- | Vocaloid Accessory +-- (name of an accessory, .x filename, position, eular angle, name of the bound bone)+type VAC = (String, FilePath, Float, V3 Float, V3 Float, String)+
+ Graphics/Model/Obj.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+-- | OBJ is a widely used simple 3D model format made for TAV.+-- The Advanced Visualizer (TAV), a 3D graphics software package,+-- was the flagship product of Wavefront Technologies from the 1980s+-- until the 1990s.+-- <https://en.wikipedia.org/wiki/The_Advanced_Visualizer>++module Graphics.Model.Obj (+  loadOBJ,+  parseOBJ,+  --reverseHandOBJ,+  loadMtl,+  parseMtl,++  ObjMesh(..),+  ObjFace(..),+  ObjMaterial(..)+  ) where++import Control.Applicative+import Data.Attoparsec.ByteString.Char8 as A+import qualified Data.ByteString as B+import Data.Int+import Linear++data ObjMesh = ObjMesh+	{ _objGroup :: String+	, _objMaterial :: Maybe (FilePath, String)+	, _objVertices :: [V3 Float]+	, _objUVs :: [V2 Float]+	, _objNormals :: [V3 Float]+	, _objFaces :: [[ObjFace]]+	} deriving Show++data ObjFace = ObjFace+	{ _objVertexIx :: Int32+	, _objTextureIx :: Int32+	, _objNormalIx :: Int32+	} deriving Show++data ObjMaterial = ObjMaterial+	{ _objName :: String+	, _objAmbient :: V3 Float+	, _objDiffuse :: V3 Float+	, _objSpecular :: V3 Float+	, _objShineness :: Float+	} deriving Show++loadOBJ :: FilePath -> IO [ObjMesh]+loadOBJ path = parseOBJ <$> B.readFile path++parseOBJ :: B.ByteString -> [ObjMesh]+parseOBJ bs =+	case feed (parse parseMeshes bs) "" of+		Done _ result -> result+		result -> error $ "parseOBJ: Invalid format:\n" ++ show result++comments = do+	many (skipSpace >> char '#' >> A.takeWhile (/= '\n'))+	skipSpace++parseMeshes :: Parser [ObjMesh]+parseMeshes = do+	path <- comments *> option "" parseMtllib <* comments+	many1 (parseMesh path <* comments)++parseMesh :: String -> Parser ObjMesh+parseMesh path = do+	group <- option "default" parseG <* comments+	mtl1 <- optional parseUsemtl <* comments+	vertices <- many1 (parseV <* comments)+	uvs <- many (parseVt <* comments)+	normals <- many (parseVn <* comments)+	mtl2 <- optional parseUsemtl <* comments+	faces <- many (parseF <* comments)+	let mtl = fmap (path,) (maybe mtl2 Just mtl1)+	return $ ObjMesh group mtl vertices uvs normals faces++getString, parseMtllib, parseG, parseUsemtl :: Parser String+getString = many1 (satisfy (/= '\n'))+parseMtllib = string "mtllib " >> getString+parseG = char 'g' >> sp >> getString+parseUsemtl = string "usemtl " >> getString++parseV = char 'v' >> float3+parseVt = char 'v' >> char 't' >> float2+parseVn = char 'v' >> char 'n' >> float3+parseF = char 'f' >> many indexes++float = realToFrac <$> signed double+sp = char ' '+float3 = V3+	<$> (sp *> float)+	<*> (sp *> float)+	<*> (sp *> float)+float2 = V2+	<$> (sp *> float)+	<*> (sp *> float)++index = option 0 decimal+indexes = ObjFace+	<$> (sp       *> index)+	<*> (char '/' *> index)+	<*> (char '/' *> index)++loadMtl :: FilePath -> IO ObjMaterial+loadMtl path = parseMtl <$> B.readFile path++parseMtl :: B.ByteString -> ObjMaterial+parseMtl bs =+	case feed (parse parseMtl' bs) "" of+		Done _ result -> result+		result -> error $ "parseMtl: Invalid format:\n" ++ show result++parseMtl' :: Parser ObjMaterial+parseMtl' = do+	comments+	mtl <- string "newmtl " >> getString <* comments+	amb <- string "Ka" >> float3 <* comments+	diff <- string "Kd" >> float3 <* comments+	spec <- string "Ks" >> float3 <* comments+	shine <- string "Ns " >> float+	-- XXX map_Kd+	return $ ObjMaterial mtl amb diff spec shine+
+ LICENSE view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions.++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version.++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain