From 797f800ab38505f0866a59f0e4ea38ce90d85c32 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Wed, 19 Jun 2019 17:38:34 -0400 Subject: Moved addOBJToObjectArray to module LoadMesh. --- LoadMesh.hs | 26 ++++++++++++++++++++++++++ MeshSketch.hs | 22 ---------------------- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/LoadMesh.hs b/LoadMesh.hs index ee93344..7cc61bc 100644 --- a/LoadMesh.hs +++ b/LoadMesh.hs @@ -5,6 +5,7 @@ module LoadMesh where import LambdaCube.GL as LC -- renderer import LambdaCube.GL.Mesh as LambdaCubeGL +import LambdaCube.GL.Type as LC import MtlParser import Control.Monad @@ -24,6 +25,7 @@ import Codec.Picture as Juicy import Wavefront import Wavefront.Types import Data.Aeson +import Mask type MeshData = ( [(Mesh,Maybe Text)] -- List of uniform-material meshes (and the name of the material). , ( MtlLib -- Material definitions. @@ -151,3 +153,27 @@ objToMesh OBJ{..} = [(toMesh faceGroup, elMtl . head $ faceGroup) | faceGroup <- , let TexCoord x y z = fromMaybe defaultTexCoord ((objTexCoords !-) =<< faceTexCoordIndex) in V3 x y z ) (position,normal,texcoord) = V.unzip3 . V.concat . map (V.fromList . map toVertex . triangulate . elValue) $ l + +data MaskableObject = MaskableObject + { maskableObject :: LC.Object + , groupMasks :: Map Text Mask + } + +objSpan :: LC.Object -> Mask +objSpan obj = case Map.elems (objAttributes obj) of + Stream { streamLength = x }:_ -> Mask [(0,fromIntegral x)] + _ -> Mask [(0,1)] + + + +addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) + -> IO [MaskableObject] +addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do + obj <- LambdaCubeGL.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] mesh + -- diffuseTexture and diffuseColor values can change on each model + case mat >>= flip Map.lookup mtlLib of + Nothing -> return () + Just (ObjMaterial{..},t) -> LC.updateObjectUniforms obj $ do + "diffuseTexture" @= return t -- set model's diffuse texture + "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr) + return $ MaskableObject obj $ maybe Map.empty (`Map.singleton` objSpan obj) mat diff --git a/MeshSketch.hs b/MeshSketch.hs index 87d9763..d9290fd 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs @@ -141,28 +141,6 @@ realToFracVector :: ( Real a ) => Vector a -> Vector b realToFracVector v = Math.fromList $ map realToFrac $ Math.toList v -data MaskableObject = MaskableObject - { maskableObject :: LC.Object - , groupMasks :: Map Text Mask - } - -objSpan :: LC.Object -> Mask -objSpan obj = case Map.elems (objAttributes obj) of - Stream { streamLength = x }:_ -> Mask [(0,fromIntegral x)] - _ -> Mask [(0,1)] - -addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) - -> IO [MaskableObject] -addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do - obj <- LC.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] mesh - -- diffuseTexture and diffuseColor values can change on each model - case mat >>= flip Map.lookup mtlLib of - Nothing -> return () - Just (ObjMaterial{..},t) -> LC.updateObjectUniforms obj $ do - "diffuseTexture" @= return t -- set model's diffuse texture - "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr) - return $ MaskableObject obj $ maybe Map.empty (`Map.singleton` objSpan obj) mat - mkFullscreenToggle :: IsWindow a => a -> IO (IO ()) mkFullscreenToggle w = do full <- newIORef False -- cgit v1.2.3