diff --git a/hraylib3d.cabal b/hraylib3d.cabal index c6d5149..53e38d0 100644 --- a/hraylib3d.cabal +++ b/hraylib3d.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -82,7 +82,7 @@ library HRayLib3d.GameEngine.Loader.Entity HRayLib3d.GameEngine.Loader.GameCharacter HRayLib3d.GameEngine.Loader.GLB - HRayLib3d.GameEngine.Loader.GLTF + HRayLib3d.GameEngine.Loader.GlTF HRayLib3d.GameEngine.Loader.Image HRayLib3d.GameEngine.Loader.MD3 HRayLib3d.GameEngine.Loader.ShaderParser diff --git a/src/HRayLib3d/GameEngine/Data/AssetIR.hs b/src/HRayLib3d/GameEngine/Data/AssetIR.hs index e69de29..d780c52 100644 --- a/src/HRayLib3d/GameEngine/Data/AssetIR.hs +++ b/src/HRayLib3d/GameEngine/Data/AssetIR.hs @@ -0,0 +1,2 @@ +module HRayLib3d.GameEngine.Data.AssetIR where + \ No newline at end of file diff --git a/src/HRayLib3d/GameEngine/Graphics/GLTF.hs b/src/HRayLib3d/GameEngine/Graphics/GLTF.hs index 713bc6e..b8f8fbe 100644 --- a/src/HRayLib3d/GameEngine/Graphics/GLTF.hs +++ b/src/HRayLib3d/GameEngine/Graphics/GLTF.hs @@ -10,8 +10,8 @@ module HRayLib3d.GameEngine.Graphics.GLTF import Foreign ( Ptr, Storable, castPtr ) import Data.Map ( Map ) -import Data.Aeson ( eitherDecodeFileStrict ) -import Data.Maybe ( fromJust ) +import Data.Aeson ( (.:), withObject, eitherDecodeFileStrict, FromJSON, decode, Value ) +import Data.Maybe ( fromJust, fromMaybe ) import Data.Vector ( Vector ) import Data.HashSet ( HashSet ) import Data.Text.Unsafe ( inlinePerformIO ) @@ -35,13 +35,15 @@ import Codec.GlTF.BufferView ( BufferView(..) ) import Codec.GlTF.Texture () import Codec.GlTF.URI ( loadURI, URI ) -import LambdaCube.GL ( ArrayType (ArrWord32), Buffer, BufferSetter(..), Stream(..), Object(..), IndexStream(..), updateBuffer, Array(..), GLStorage(..), ArrayType (ArrFloat), compileBuffer, addObject, Primitive (TriangleList), V4 (..), V2 (..) ) +import LambdaCube.GL ( ArrayType (..), Buffer, Stream(..), Object(..), IndexStream(..), updateBuffer, Array(..), GLStorage(..), ArrayType (ArrFloat), compileBuffer, addObject, Primitive (TriangleList), V4 (..), V2 (..) ) import LambdaCube.GL.Mesh ( addMeshToObjectArray, uploadMeshToGPU ) import HRayLib3d.GameEngine.Data.GLTF ( GLTFModel(..) ) import HRayLib3d.GameEngine.Graphics.Storage ( addObjectWithMaterial ) import HRayLib3d.GameEngine.Utils ( bbox, setNub, sphere ) import LambdaCube.PipelineSchema ( StreamType(..) ) import qualified Codec.GlTF.Material as Material +import Data.Vect.Float.Base (Vec3(..)) +import Data.Aeson.Types (FromJSON(parseJSON)) data GlTFInstance = GlTFInstance @@ -70,11 +72,9 @@ decodeBase64 bs = case B64.decode bs of --B64.decode bs >>= return . SB8.dropWhile (== '\NUL') procRawBytes :: Codec.GlTF.URI.URI -> IO T.Text -procRawBytes uriBytes = do - rawURIBytes <- loadURI eitherDecodeFileStrict uriBytes - case rawURIBytes of - Left _ -> error "Bad URI" - Right a -> return (T.pack $ show a) +procRawBytes uriBytes = do return $ T.pack . show $ uriBytes + +instance (Num ComponentType) -- Type GlTF.BufferView was BL.ByteString before extractData :: Codec.GlTF.Buffer.Buffer -> Codec.GlTF.Accessor.Accessor -> Codec.GlTF.BufferView.BufferView -> Maybe [Float] @@ -126,7 +126,7 @@ cvtGlTF Codec.GlTF.GlTF{..} = do --bufferViewIndex = bufferViewIx -- Choose the desired buffer view index -- encodedData = C8.dropWhile (/= ',') (C8.pack $ URI $ fromJust uri) (C8.unpack encodedData) if "data:application/octet-stream;base64," `SB8.isPrefixOf` SB8.pack dataMaybe - then processGLTF gBuffers gAccessors bufferViewIxs + then processGLTF gBuffers gAccessors bufferViewIxs else error "Bad Data URI" processGLTF :: Vector Codec.GlTF.Buffer.Buffer -> Vector Accessor -> Vector BufferView -> (Array, Array, Vector (Array, Array)) @@ -134,13 +134,16 @@ processGLTF gBuffers gAccessors bufferViewIxs = do let indices = fromJust $ extractData (gBuffers V.! 4) (gAccessors V.! 4) (bufferViewIxs V.! 4) normals = fromJust $ extractData (gBuffers V.! 1) (gAccessors V.! 1) (bufferViewIxs V.! 1) texCoords = fromJust $ extractData (gBuffers V.! 3) (gAccessors V.! 3) (bufferViewIxs V.! 3) - return (Array (ArrWord32 (SV.length $ SV.fromList indices) (withV $ SV.fromList indices)), Array (ArrFloat (2 * SV.length (SV.fromList texCoords)) (withV (V.fromList texCoords))), V.map cvtPosNorm (V.fromList normals)) + ar1 = Array ArrFloat (SV.length $ SV.fromList indices) (withV $ SV.fromList indices) + ar2 = Array ArrFloat (2 * SV.length (SV.fromList texCoords)) (withV $ SV.fromList texCoords) + vb = V.map cvtPosNorm (V.fromList [(SV.fromList texCoords, SV.fromList normals)]) + (ar1, ar2, vb) withV :: Storable a => SV.Vector a -> (Ptr b1 -> IO b2) -> IO b2 withV a f = SV.unsafeWith a (\p -> f $ castPtr p) -cvtPosNorm :: (SV.Vector a1, SV.Vector a2) -> (Int -> BufferSetter -> Array, Int -> BufferSetter -> Array) -cvtPosNorm (p,n) = (f p, f n) where f sv = Array $ ArrFloat (3 * SV.length sv) $ withV sv +cvtPosNorm :: Storable a => (SV.Vector a, SV.Vector a) -> (Array, Array) -- (Int -> BufferSetter -> Array, Int -> BufferSetter -> Array) +cvtPosNorm (p,n) = (f p, f n) where f sv = Array ArrFloat (3 * SV.length sv) $ withV sv addSurface :: GlTF -> ([Array], [Array], [Array], [Array], [Vector (Array, Array)]) -> ([Array], [Array], [Array], [Array], [Vector (Array, Array)]) addSurface sf (il,tl,pl,nl,pnl) = do @@ -153,10 +156,10 @@ uploadGlTF :: GLTFModel -> IO GPUGlTF uploadGlTF model = do let (il, tl, pl, nl, pnl) = addSurface (gltfRaw model) ([],[],[],[],[]) buffer <- compileBuffer (concat [il, tl, pl, nl]) - let numSurfaces = V.length gltfSurfaces - surfaceData idx GLTFModel{..} = (index,attributes) where - index = IndexStream buffer idx 0 (SV.length srGlTFTriangles) - countV = SV.length srGlTFTexCoords + let numSurfaces = length il -- / 4) -- TODO: a Let to properly support GlTF animations + surfaceData idx GLTFModel{..} = (index, attributes) where + index = IndexStream buffer idx 0 (length tl) + countV = length pl attributes = Map.fromList [ ("diffuseUV", Stream Attribute_V2F buffer (1 * numSurfaces + idx) 0 countV) , ("position", Stream Attribute_V3F buffer (2 * numSurfaces + idx) 0 countV) @@ -165,36 +168,31 @@ uploadGlTF model = do , ("lightmapUV", ConstV2F (V2 0 0)) ] frames = Prelude.foldr addSurfaceFrames emptyFrame $ zip [0..] pnl where - emptyFrame = V.replicate (V.length gltfFrames) [] + emptyFrame = V.replicate 0 [] --gltfFrames addSurfaceFrames (idx,pn) f = V.zipWith (\l (p,n) -> (2 * numSurfaces + idx,p):(3 * numSurfaces + idx,n):l) f pn return $ GPUGlTF { gpuGlTFBuffer = buffer - , gpuGlTFSurfaces = zipWith surfaceData [0..] (V.toList gltfSurfaces) + , gpuGlTFSurfaces = zipWith surfaceData [0..] [model] --(V.fromList gltfSurfaces) , gpuGlTFFrames = frames , gpuGlTFModel = model - , gpuGlTFShaders = HashSet.fromList $ concat [map (T.unpack . fromJust . Material.name) $ V.toList gpuGlTFShaders | GLTFModel{..} <- V.toList gltfRaw] - } + , gpuGlTFShaders = HashSet.fromList $ concat [[] | GLTFModel{..} <- [model]] -- [map (T.unpack . fromJust . Material.name) $ listOfMat | GLTFModel{..} <- V.toList gltfRaw]] + } --V.toList gpuGlTFShaders addGPUGlTF :: GLStorage -> GPUGlTF -> [String] -> IO GlTFInstance addGPUGlTF r GPUGlTF{..} unis = do let GlTF{..} = gltfRaw gpuGlTFModel - objs <- V.forM (zip gpuGlTFSurfaces $ V.toList gltfSurfaces) $ \((index,attrs),sf) -> do - let materialName s = case Map.lookup (Material.name sf) skins of - Nothing -> Material.name s - Just a -> a - objList <- concat <$> V.forM (V.fromList $ Codec.GlTF.extensions sf) (\s -> do - a <- addObjectWithMaterial r (T.unpack . fromJust $ materialName s) TriangleList (Just index) attrs $ setNub $ "worldMat":unis - b <- addObject r "LightMapOnly" TriangleList (Just index) attrs $ setNub $ "worldMat":unis - return [a,b]) + objs <- V.forM (V.fromList gpuGlTFSurfaces) $ \(index, _) -> do + objList <- concat <$> V.forM (V.fromList [fromMaybe Codec.GlTF.extensions]) (\_ -> do + a <- addObjectWithMaterial r (T.unpack . fromJust $ Material.name (fromJust materials V.! 1)) TriangleList (Just index) Map.empty $ setNub $ "worldMat":unis + b <- addObject r "LightMapOnly" TriangleList (Just index) Map.empty $ setNub $ "worldMat":unis + return [a,b]) --attrs -- add collision geometry - collisionObjs <- case V.fromList objList of - (GlTF{..}:_) -> do - sphereObj <- uploadMeshToGPU (sphere (V4 1 0 0 1) 4 radius) >>= addMeshToObjectArray r "CollisionShape" (setNub $ ["worldMat","origin"] ++ unis) - boxObj <- uploadMeshToGPU (bbox (V4 0 0 1 1) Codec.GlTF.Accessor.min Codec.GlTF.Accessor.max) >>= addMeshToObjectArray r "CollisionShape" (setNub $ ["worldMat","origin"] ++ unis) - --when (frOrigin /= zero) $ putStrLn $ "frOrigin: " ++ show frOrigin - return [sphereObj,boxObj] - _ -> return [] + collisionObjs <- do --TODO: re-add radius + sphereObj <- uploadMeshToGPU (sphere (V4 1 0 0 1) 4 1.0) >>= addMeshToObjectArray r "CollisionShape" (setNub $ ["worldMat","origin"] ++ unis) + boxObj <- uploadMeshToGPU (bbox (V4 0 0 1 1) (Vec3 0 0 0) {- Codec.GlTF.Accessor.min -} (Vec3 0 0 0) {- Codec.GlTF.Accessor.max -}) >>= addMeshToObjectArray r "CollisionShape" (setNub $ ["worldMat","origin"] ++ unis) + --when (frOrigin /= zero) $ putStrLn $ "frOrigin: " ++ show frOrigin + return [sphereObj,boxObj] return $ objList ++ collisionObjs -- question: how will be the referred shaders loaded? -- general problem: should the gfx network contain all passes (every possible materials)? diff --git a/src/HRayLib3d/GameEngine/Graphics/OBJ.hs b/src/HRayLib3d/GameEngine/Graphics/OBJ.hs index 0ac2ae4..db760c3 100644 --- a/src/HRayLib3d/GameEngine/Graphics/OBJ.hs +++ b/src/HRayLib3d/GameEngine/Graphics/OBJ.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances, RecordWildCards #-} module HRayLib3d.GameEngine.Graphics.OBJ ( addOBJ , addGPUOBJ diff --git a/src/HRayLib3d/GameEngine/Loader.hs b/src/HRayLib3d/GameEngine/Loader.hs index d7b1166..f018051 100644 --- a/src/HRayLib3d/GameEngine/Loader.hs +++ b/src/HRayLib3d/GameEngine/Loader.hs @@ -1,21 +1,21 @@ module HRayLib3d.GameEngine.Loader ( - -- module HRayLib3d.GameEngine.Loader.BSP, - -- module HRayLib3d.GameEngine.Loader.Entity, - -- module HRayLib3d.GameEngine.Loader.GameCharacter, - -- module HRayLib3d.GameEngine.Loader.GLB, - -- module HRayLib3d.GameEngine.Loader.GlTF, - -- module HRayLib3d.GameEngine.Loader.Image, - -- module HRayLib3d.GameEngine.Loader.MD3, - -- module HRayLib3d.GameEngine.Loader.ShaderParser, - -- module HRayLib3d.GameEngine.Loader.Zip + module HRayLib3d.GameEngine.Loader.BSP, + module HRayLib3d.GameEngine.Loader.Entity, + module HRayLib3d.GameEngine.Loader.GameCharacter, + module HRayLib3d.GameEngine.Loader.GLB, + module HRayLib3d.GameEngine.Loader.GlTF, + module HRayLib3d.GameEngine.Loader.Image, + module HRayLib3d.GameEngine.Loader.MD3, + module HRayLib3d.GameEngine.Loader.ShaderParser, + module HRayLib3d.GameEngine.Loader.Zip ) where - -- import HRayLib3d.GameEngine.Loader.BSP, - -- import HRayLib3d.GameEngine.Loader.Entity, - -- import HRayLib3d.GameEngine.Loader.GameCharacter, - -- import HRayLib3d.GameEngine.Loader.GLB, - -- import HRayLib3d.GameEngine.Loader.GlTF, - -- import HRayLib3d.GameEngine.Loader.Image, - -- import HRayLib3d.GameEngine.Loader.MD3, - -- import HRayLib3d.GameEngine.Loader.ShaderParser, - -- import HRayLib3d.GameEngine.Loader.Zip \ No newline at end of file + import HRayLib3d.GameEngine.Loader.BSP + import HRayLib3d.GameEngine.Loader.Entity + import HRayLib3d.GameEngine.Loader.GameCharacter + import HRayLib3d.GameEngine.Loader.GLB + import HRayLib3d.GameEngine.Loader.GlTF + import HRayLib3d.GameEngine.Loader.Image + import HRayLib3d.GameEngine.Loader.MD3 + import HRayLib3d.GameEngine.Loader.ShaderParser + import HRayLib3d.GameEngine.Loader.Zip \ No newline at end of file diff --git a/src/HRayLib3d/GameEngine/Loader/GLTF.hs b/src/HRayLib3d/GameEngine/Loader/GLTF.hs index 8738ae5..7583d4c 100644 --- a/src/HRayLib3d/GameEngine/Loader/GLTF.hs +++ b/src/HRayLib3d/GameEngine/Loader/GLTF.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, ViewPatterns #-} -module HRayLib3d.GameEngine.Loader.GLTF +module HRayLib3d.GameEngine.Loader.GlTF ( readGLTF , loadGLTF , getGLTFModel diff --git a/src/HRayLib3d/Utils/Subprocess.hs b/src/HRayLib3d/Utils/Subprocess.hs index e841fc4..a905828 100644 --- a/src/HRayLib3d/Utils/Subprocess.hs +++ b/src/HRayLib3d/Utils/Subprocess.hs @@ -1,12 +1,12 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -module Manifest.Utils.Subprocess ( +module HRayLib3d.Utils.Subprocess ( try', append, appendLens, appendHandles, - appendIO, - startLocalManiapi, + appendIO + {-startLocalManiapi, runManiex, rebootSystemManiapi, startManieye, @@ -16,7 +16,7 @@ module Manifest.Utils.Subprocess ( startIDE, configureManiex, installManiex, - uninstallManiex + uninstallManiex-} ) where @@ -29,8 +29,7 @@ import System.Process (StdStream(CreatePipe), CreateProcess, createProcess, read import System.Environment import System.Directory (getHomeDirectory) -import Manifest.Types -import Manifest.Utils.Log +import HRayLib3d.Utils.LogMessage import Monomer.Widgets.Composite -- | Test if a Subprocess succeeds or fails on startup -- This specific version will throw an IOException for @@ -59,156 +58,156 @@ appendIO model a lens = return [Model $ model & lens .~ a] -- NOTE: All 'start' functions appends a reference of the process' pipe to the -- ManifestModel subprocess Lens so they can be closed all at once when the main -- window is, or be communicated to later -startIDE :: ManifestModel -> Text -> IO () -startIDE mdl txt = do - result <- try' $ createProcess (proc (unpack txt) ["./assets/projects/default"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting IDE") - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("IDE: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("IDE: CHECKLIST OK") - -startTensorBoard :: ManifestModel -> IO () -startTensorBoard mdl = do - result <- try' $ createProcess (proc "tensorboard" ["--logdir", (show $ mdl ^. dataset_dir)]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting Tensorboard") - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Tensorboard: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Tensorboard: CHECKLIST OK") - -installManiex :: ManifestModel -> IO () -installManiex mdl = do - result <- try' $ createProcess (proc "bash" ["install_maniex_pytorch.sh", "-s", (unpack $ mdl ^. maniex_install_path)]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("proc: bash install_maniex_pytorch.sh -s " ++ (unpack $ (mdl ^. maniex_install_path))) - orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("Booting \"Install Maniex\" ") - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Install: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Install: CHECKLIST OK") - -uninstallManiex :: ManifestModel -> IO () -uninstallManiex mdl = do - result <- try' $ createProcess (proc "bash" ["install_maniex_pytorch.sh", "-r"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting \"Uninstall Maniex\" ") - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Uninstall: " ++ show ex) - Right (_,_,_,p) -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Uninstall: CHECKLIST OK") - - --- | Boots an instance of maniapi.server in the "python -m" flavor. -startLocalManiapi :: ManifestModel -> IO () -startLocalManiapi mdl = do - result <- try' $ createProcess (proc ((mdl ^. userHome) ++ "/venv/blend/bin/python") ["-m", "maniapi.server"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE "Communication With ManiAPI Opened" - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") - --- | Boots the local instance of maniapi.server in the "systemctl" flavor. -startSystemManiapi :: ManifestModel -> IO () -startSystemManiapi mdl = do - result <- try' $ readProcess ("sudo") ["systemctl", "restart", "manidef"] ("uncanny" ++ "\n") --{ cwd = Just $ "/" ++ (mdl ^. userHome) ++ "Desktop/manifest"{-, std_out = CreatePipe-} } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE "Communication With ManiAPI Opened" - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) - Right str -> do - orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE str - orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") - --- | Stops the local instance of maniapi.server in the "systemctl" flavor. -stopSystemManiapi :: ManifestModel -> IO () -stopSystemManiapi mdl = do - result <- try' $ createProcess (proc ("sudo") ["systemctl", "stop", "manidef"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"{-, std_out = CreatePipe-} } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Closing ManiAPI Channel" - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("ManiAPI: SHUTDOWN") - --- | Monitor the local instance of maniapi.server (only applicable to systemctl setups) -monitorSystemManiapi :: ManifestModel -> IO () -monitorSystemManiapi mdl = do - result <- try' $ createProcess (proc ("journalctl") ["-f", "-u", "manidef"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE "Communication With ManiAPI Opened" - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") - -rebootSystemManiapi :: ManifestModel -> IO () -rebootSystemManiapi mdl = do - startSystemManiapi mdl - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_WARNING ("ManiAPI: REBOOTED (SYSTEMCTL)") - --- | Boot IDE and open Maniex/Config.yaml -configureManiex :: ManifestModel -> IO () -configureManiex mdl = do - envv <- getEnvironment - result <- try' $ createProcess (proc (unpack $ mdl ^. ide_command) [((mdl ^. ml_backend) == "PYT") ? "torch_config.yaml" :? "tf_config.yaml"]) {cwd = Just $ (mdl ^. userHome) ++ "/venv/blend/lib/python3.9/site-packages/maniex/"} --"code" ["./config.yaml"] --createProcess (proc "this_command_does_not_exist" []) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Maniex-Config" - case result of - Left ex -> do - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Maniex-Config: " ++ show ex) - Right (_, _, _, p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - --liftIO $ appendIO mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Maniex-Config: CHECKLIST OK") - --- | Boot Maniex --- NOTE: Manifest contains a custom Maniex submodule that must be pointed to in manidef, --- Use install_maniex.sh to help with this -runManiex :: ManifestModel -> IO () -runManiex mdl = do - envv <- getEnvironment - result <- try' $ createProcess (proc ((mdl ^. userHome) ++ "/venv/blend/bin/python") ["-m", ((mdl ^. ml_backend) == "PYT") ? "maniex.torch_main" :? "maniex.tf_main", "--datasetName", (unpack $ mdl ^. dataset_name), "--renderFunction", (unpack $ mdl ^. render_function), "--blendSources", (unpack $ mdl ^. blend_sources), "--datasetDir", (unpack $ mdl ^. dataset_dir), "--outputDir", (unpack $ mdl ^. output_dir), "--classifierDir", (unpack $ mdl ^. classifier_dir), "--weightsDir", (unpack $ mdl ^. weights_dir), "--trainOnly", (show $ mdl ^. skipInference), "--inferOnly", (show $ mdl ^. skipTraining)]) --{cwd = Just $ (mdl ^. userHome) ++ "/Desktop/manifest", env = Just envv} --createProcess (proc "this_command_does_not_exist" []) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Maniex" - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Maniex: " ++ show ex) - Right (_, _, _, p) -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Maniex: CHECKLIST OK\n") - --- | Boot the Original Manieye --- CAUTION: You must ln -s your Manieye's location before using this -startManieye :: ManifestModel -> Text -> Text -> IO () -startManieye mdl inital predicted = do - result <- try' $ createProcess (proc "manieye" [unpack inital, unpack predicted]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manieye(Legacy) Started") - case result of - Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) subprocesses - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manieye: CHECKLIST OK") - ---startManifestMasks -startManigram :: ManifestModel -> IO () -startManigram mdl = do - envv <- getEnvironment - result <- try' $ createProcess (proc "stack" ["run", "manifest-masks"]){cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"} --createProcess (proc "this_command_does_not_exist" []) - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Manigram" - case result of - Left ex -> do - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Manigram: " ++ show ex) - Right (_,_,_,p) -> do - liftIO $ appendLens mdl (append p) (subprocesses) - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manigram: CHECKLIST OK") +-- startIDE :: ManifestModel -> Text -> IO () +-- startIDE mdl txt = do +-- result <- try' $ createProcess (proc (unpack txt) ["./assets/projects/default"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting IDE") +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("IDE: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("IDE: CHECKLIST OK") + +-- startTensorBoard :: ManifestModel -> IO () +-- startTensorBoard mdl = do +-- result <- try' $ createProcess (proc "tensorboard" ["--logdir", (show $ mdl ^. dataset_dir)]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting Tensorboard") +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Tensorboard: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Tensorboard: CHECKLIST OK") + +-- installManiex :: ManifestModel -> IO () +-- installManiex mdl = do +-- result <- try' $ createProcess (proc "bash" ["install_maniex_pytorch.sh", "-s", (unpack $ mdl ^. maniex_install_path)]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("proc: bash install_maniex_pytorch.sh -s " ++ (unpack $ (mdl ^. maniex_install_path))) +-- orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("Booting \"Install Maniex\" ") +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Install: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Install: CHECKLIST OK") + +-- uninstallManiex :: ManifestModel -> IO () +-- uninstallManiex mdl = do +-- result <- try' $ createProcess (proc "bash" ["install_maniex_pytorch.sh", "-r"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE ("Booting \"Uninstall Maniex\" ") +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Uninstall: " ++ show ex) +-- Right (_,_,_,p) -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Uninstall: CHECKLIST OK") + + +-- -- | Boots an instance of maniapi.server in the "python -m" flavor. +-- startLocalManiapi :: ManifestModel -> IO () +-- startLocalManiapi mdl = do +-- result <- try' $ createProcess (proc ((mdl ^. userHome) ++ "/venv/blend/bin/python") ["-m", "maniapi.server"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE "Communication With ManiAPI Opened" +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") + +-- -- | Boots the local instance of maniapi.server in the "systemctl" flavor. +-- startSystemManiapi :: ManifestModel -> IO () +-- startSystemManiapi mdl = do +-- result <- try' $ readProcess ("sudo") ["systemctl", "restart", "manidef"] ("uncanny" ++ "\n") --{ cwd = Just $ "/" ++ (mdl ^. userHome) ++ "Desktop/manifest"{-, std_out = CreatePipe-} } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE "Communication With ManiAPI Opened" +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) +-- Right str -> do +-- orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE str +-- orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") + +-- -- | Stops the local instance of maniapi.server in the "systemctl" flavor. +-- stopSystemManiapi :: ManifestModel -> IO () +-- stopSystemManiapi mdl = do +-- result <- try' $ createProcess (proc ("sudo") ["systemctl", "stop", "manidef"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"{-, std_out = CreatePipe-} } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Closing ManiAPI Channel" +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_BODY MANI_LOG_ZONE ("ManiAPI: SHUTDOWN") + +-- -- | Monitor the local instance of maniapi.server (only applicable to systemctl setups) +-- monitorSystemManiapi :: ManifestModel -> IO () +-- monitorSystemManiapi mdl = do +-- result <- try' $ createProcess (proc ("journalctl") ["-f", "-u", "manidef"]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE "Communication With ManiAPI Opened" +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("ManiAPI: CHECKLIST OK") + +-- rebootSystemManiapi :: ManifestModel -> IO () +-- rebootSystemManiapi mdl = do +-- startSystemManiapi mdl +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_WARNING ("ManiAPI: REBOOTED (SYSTEMCTL)") + +-- -- | Boot IDE and open Maniex/Config.yaml +-- configureManiex :: ManifestModel -> IO () +-- configureManiex mdl = do +-- envv <- getEnvironment +-- result <- try' $ createProcess (proc (unpack $ mdl ^. ide_command) [((mdl ^. ml_backend) == "PYT") ? "torch_config.yaml" :? "tf_config.yaml"]) {cwd = Just $ (mdl ^. userHome) ++ "/venv/blend/lib/python3.9/site-packages/maniex/"} --"code" ["./config.yaml"] --createProcess (proc "this_command_does_not_exist" []) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Maniex-Config" +-- case result of +-- Left ex -> do +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Maniex-Config: " ++ show ex) +-- Right (_, _, _, p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- --liftIO $ appendIO mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Maniex-Config: CHECKLIST OK") + +-- -- | Boot Maniex +-- -- NOTE: Manifest contains a custom Maniex submodule that must be pointed to in manidef, +-- -- Use install_maniex.sh to help with this +-- runManiex :: ManifestModel -> IO () +-- runManiex mdl = do +-- envv <- getEnvironment +-- result <- try' $ createProcess (proc ((mdl ^. userHome) ++ "/venv/blend/bin/python") ["-m", ((mdl ^. ml_backend) == "PYT") ? "maniex.torch_main" :? "maniex.tf_main", "--datasetName", (unpack $ mdl ^. dataset_name), "--renderFunction", (unpack $ mdl ^. render_function), "--blendSources", (unpack $ mdl ^. blend_sources), "--datasetDir", (unpack $ mdl ^. dataset_dir), "--outputDir", (unpack $ mdl ^. output_dir), "--classifierDir", (unpack $ mdl ^. classifier_dir), "--weightsDir", (unpack $ mdl ^. weights_dir), "--trainOnly", (show $ mdl ^. skipInference), "--inferOnly", (show $ mdl ^. skipTraining)]) --{cwd = Just $ (mdl ^. userHome) ++ "/Desktop/manifest", env = Just envv} --createProcess (proc "this_command_does_not_exist" []) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Maniex" +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Maniex: " ++ show ex) +-- Right (_, _, _, p) -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Maniex: CHECKLIST OK\n") + +-- -- | Boot the Original Manieye +-- -- CAUTION: You must ln -s your Manieye's location before using this +-- startManieye :: ManifestModel -> Text -> Text -> IO () +-- startManieye mdl inital predicted = do +-- result <- try' $ createProcess (proc "manieye" [unpack inital, unpack predicted]){ cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer", std_out = CreatePipe } --(_, Just hout, _, _) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manieye(Legacy) Started") +-- case result of +-- Left ex -> orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("ManiAPI: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) subprocesses +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manieye: CHECKLIST OK") + +-- --startManifestMasks +-- startManigram :: ManifestModel -> IO () +-- startManigram mdl = do +-- envv <- getEnvironment +-- result <- try' $ createProcess (proc "stack" ["run", "manifest-masks"]){cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"} --createProcess (proc "this_command_does_not_exist" []) +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Manigram" +-- case result of +-- Left ex -> do +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Manigram: " ++ show ex) +-- Right (_,_,_,p) -> do +-- liftIO $ appendLens mdl (append p) (subprocesses) +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manigram: CHECKLIST OK") -startManigramControl :: ManifestModel -> IO () -startManigramControl mdl = do - envv <- getEnvironment - result <- try' $ createProcess (proc "stack" ["run", "manigram"]){cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"} - orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Manigram-Control" - case result of - Left ex -> do - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Manigram-Control: " ++ show ex) - Right (_,_,_,p) -> do - orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manigram-Control: CHECKLIST OK") +-- startManigramControl :: ManifestModel -> IO () +-- startManigramControl mdl = do +-- envv <- getEnvironment +-- result <- try' $ createProcess (proc "stack" ["run", "manigram"]){cwd = Just $ (mdl ^. userHome) ++ "/Software/manimer"} +-- orderedMessage $ ManiLogMessage MANI_LOG_HEAD MANI_LOG_ZONE "Booting Manigram-Control" +-- case result of +-- Left ex -> do +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ERROR ("Manigram-Control: " ++ show ex) +-- Right (_,_,_,p) -> do +-- orderedMessage $ ManiLogMessage MANI_LOG_TAIL MANI_LOG_ZONE ("Manigram-Control: CHECKLIST OK") -- | Boot ManiBlend (Blender) -- startManiblend :: ManifestModel -> IO ()