From 5aba33b6f801910a8f5e1587c13678e237e31782 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sun, 28 Jul 2019 00:16:13 -0400 Subject: Render curve from obj file. --- Bezier.hs | 2 ++ LoadMesh.hs | 60 +++++++++++++++++++++++++++++++++++++++++++++++++---------- MeshSketch.hs | 40 ++++++++++++++++++++++++++++++++++++--- 3 files changed, 89 insertions(+), 13 deletions(-) diff --git a/Bezier.hs b/Bezier.hs index e526608..b93196d 100644 --- a/Bezier.hs +++ b/Bezier.hs @@ -32,6 +32,8 @@ data Curve = Curve , curveSegments :: Maybe Polygonization } +-- Although this function accepts an index, 'subdivideCurve' increases the +-- index by one after each call, so it is safe to ignore the index passed. type StorePoint m = BufferID -> Int -> Vector Float {- 3d -} -> m () xz :: Vector Float -> (Float,Float) diff --git a/LoadMesh.hs b/LoadMesh.hs index aaf0e06..cd7a8ad 100644 --- a/LoadMesh.hs +++ b/LoadMesh.hs @@ -18,6 +18,7 @@ import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Vector as V +import qualified Data.Vector.Storable as StorableV import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy.Char8 as L import Data.Text (unpack,Text,pack) @@ -37,10 +38,19 @@ data MaterialMesh m = MaterialMesh , materialMasks :: Map Text Mask } -type MeshData = ( [MaterialMesh Mesh] -- List of uniform-material meshes (and the name of the material). - , ( V.Vector MtlLib -- Material definitions. - , FilePath ) -- Path to wavefront obj file. - ) +data CurveData = CurveData + { curves :: [Curve] + , curvePt :: Int -> Location + , curveMax :: Int + } + + +data MeshData = MeshData + { matMeshes :: [MaterialMesh Mesh] -- List of uniform-material meshes (and the name of the material). + , matLib :: ( V.Vector MtlLib -- Material definitions. + , FilePath ) -- Path to wavefront obj file. + , matCurves :: CurveData + } relativeFrom :: FilePath -> FilePath -> FilePath relativeFrom path file | isAbsolute file = file @@ -51,7 +61,12 @@ loadOBJ fname = L.readFile fname >>= \bs -> do let obj@OBJ{..} = Wavefront.parse bs -- load materials mtlLib <- mapM (readMtlWithFallback . relativeFrom fname . unpack) objMtlLibs - return $ Right (objToMesh obj,(mtlLib,fname)) + return $ Right MeshData + { matMeshes = objToMesh obj + , matLib = (mtlLib,fname) + , matCurves = objToCurveData obj + } + data BoundingBox = BoundingBox @@ -122,22 +137,37 @@ transformMesh t m = m { mAttributes = Map.adjust (tranformAttribute t) "position" (mAttributes m) } -uploadOBJToGPU :: Maybe BoundingBox -> MeshData -> IO ([MaterialMesh GPUMesh],Matrix Float) -uploadOBJToGPU scalebb (subModels,(mtlLib,objpath)) = do - let meshbb = foldMap (attribBoundingBox . mAttributes . materialMesh) subModels :: BoundingBox +transformLocation :: Matrix Float -> Location -> Location +transformLocation t (Location x y z w) = Location xx yy zz ww + where + [xx,yy,zz,ww] = toList $ t #> fromList [x,y,z,w] + +locationBoundingBox :: Location -> BoundingBox +locationBoundingBox (Location x y z w) = BoundingBox x x y y z z + +uploadOBJToGPU :: Maybe BoundingBox -> MeshData -> IO (([MaterialMesh GPUMesh],CurveData),Matrix Float) +uploadOBJToGPU scalebb (MeshData subModels (mtlLib,objpath) curveData) = do + let meshbb = foldMap (attribBoundingBox . mAttributes . materialMesh) subModels + <> foldMap (foldMap (locationBoundingBox . curvePt curveData) . curvePoints) + (curves curveData) m = maybe (ident 4) (scaleWithin meshbb) scalebb + curveData' = case scalebb of + Just _ -> curveData { curvePt = transformLocation m . curvePt curveData } + Nothing -> curveData putStrLn $ show meshbb gpuSubModels <- forM subModels $ \matmesh -> do a <- LambdaCubeGL.uploadMeshToGPU (transformMesh m (materialMesh matmesh)) return matmesh { materialMesh = a } - return (gpuSubModels,m) + return ((gpuSubModels,curveData'),m) uploadMtlLib :: (V.Vector MtlLib,FilePath) -> IO (V.Vector (Map Text (ObjMaterial,TextureData))) uploadMtlLib (mtlLib,objpath) = do -- collect used textures let usedTextures = nub . concatMap (maybeToList . mtl_map_Kd) $ concatMap Map.elems $ V.toList mtlLib whiteImage = Juicy.ImageRGB8 $ Juicy.generateImage (\_ _ -> Juicy.PixelRGB8 255 255 255) 1 1 - checkerImage = Juicy.ImageRGB8 $ Juicy.generateImage (\x y -> if mod (x + y) 2 == 0 then Juicy.PixelRGB8 0 0 0 else Juicy.PixelRGB8 255 255 0) 2 2 + checkerImage = Juicy.ImageRGB8 $ Juicy.generateImage mkchecker 2 2 + where mkchecker x y = if mod (x + y) 2 == 0 then Juicy.PixelRGB8 0 0 0 + else Juicy.PixelRGB8 255 255 0 checkerTex <- LC.uploadTexture2DToGPU checkerImage -- load images and upload to gpu textureLib <- forM (Map.fromList $ zip usedTextures usedTextures) $ \fname -> Juicy.readImage (relativeFrom objpath fname) >>= \case @@ -147,6 +177,16 @@ uploadMtlLib (mtlLib,objpath) = do -- pair textures and materials return $ fmap (\a -> (a, maybe whiteTex (fromMaybe checkerTex . flip Map.lookup textureLib) . mtl_map_Kd $ a)) <$> mtlLib +vecLocation :: Location -> StorableV.Vector Float +vecLocation (Location x y z w) = StorableV.fromList [x,y,z,w] + +objToCurveData :: WavefrontOBJ -> CurveData +objToCurveData OBJ{..} = CurveData + { curves = map elValue $ V.toList $ objCurves + , curvePt = (objLocations V.!) + , curveMax = V.length objLocations + } + objToMesh :: WavefrontOBJ -> [MaterialMesh Mesh] objToMesh OBJ{..} = [ toMesh faceGroup | faceGroup <- faces ] where diff --git a/MeshSketch.hs b/MeshSketch.hs index a51cd3d..a2e4cbe 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs @@ -54,6 +54,10 @@ import Text.Printf import qualified Foreign.C.Types import System.FilePath import System.Directory +import Wavefront.Types +import Wavefront.Util + + import CubeMap import GLWidget (nullableContext, withCurrentGL) @@ -160,8 +164,8 @@ stateChangeMesh obj mm storage st = do let glarea = mmWidget mm -- load OBJ geometry and material descriptions let workarea = BoundingBox (-2.5) (2.5) (-2.5) 2.5 (-2.5) (2.5) - mtlLib = snd obj - (objMesh,objscale) <- uploadOBJToGPU (Just workarea) obj + mtlLib = matLib obj + ((objMesh,curveData),objscale) <- uploadOBJToGPU (Just workarea) obj putStrLn $ "Using object scale:\n" ++ show objscale -- load materials textures gpuMtlLib <- uploadMtlLib mtlLib @@ -172,6 +176,36 @@ stateChangeMesh obj mm storage st = do addToGroupsPane (mmListStore mm) True groupname writeIORef (stObjects st) bufs writeIORef (stMasks st) $ map (objSpan . maskableObject) bufs + forM_ (take 1 $ curves curveData) $ \c -> do + let mn = minimum $ curvePoints c + mx = maximum $ curvePoints c + bs = decomposeCurve (curvePt curveData) c + mapM_ (putStrLn . show) bs + clearRing (stRingBuffer st) + forM_ bs $ \(BezierSegment [a,b,c,d]) -> do + let cv = Bezier.Curve Nothing (vecLocation a) + (vecLocation b) + (vecLocation c) + (vecLocation d) + Nothing + δ = 0.005 -- TODO + range = Polygonization + { curveBufferID = error "curveBufferID" + , curveStartIndex = 0 + , curveSegmentCount = ringCapacity (stRingBuffer st) + } + r <- subdivideCurve δ cv range $ \_ _ v -> do + RingBuffer.pushBack (stRingBuffer st) $ \RingPoint{..} -> do + rpPosition @<- v + rpColor @<- yellow + putStrLn $ "Subdivided "++show (curveSegmentCount r)++" poly-lines." + return () + {- + RingBuffer.pushBack (stRingBuffer st) $ \RingPoint{..} -> do + rpPosition @<- V3 0 0 (0::Float) + rpColor @<- red -} + return () + putStrLn $ "Returning from stateChangeMesh." return st initializeState :: MeshSketch -> GLStorage -> IO State @@ -321,7 +355,7 @@ loadInitialMesh kont = do objName <- head . (++ ["cube.obj"]) <$> getArgs putStrLn $ "Loading object "++objName++"..." mobj <- loadOBJ objName - putStrLn $ "Finisehd loading object "++objName++"." + putStrLn $ "Finished loading object "++objName++"." kont mobj new :: IO Gtk.Paned -- cgit v1.2.3