Run.hs

module Command.GLTF.Loader.Run (run) where

import Command.GLTF.Loader.App
import Text.GLTF.Loader

import Lens.Micro
import Lens.Micro.Platform ()
import Linear (V3(..), V4(..))
import RIO
import qualified RIO.Vector.Boxed as Vector

run :: RIO App ()
run = do
  options <- asks (^. optionsL)
  let file = options ^. _optionsFile
      binary = options ^. _optionsBinary
      summary = options ^. _optionsSummary
      verbose = options ^. _optionsVerbose
      fromFile = if binary
        then fmap (over _Right (^. _gltf)) . fromBinaryFile
        else fromJsonFile

  logInfo $ "File: " <> fromString file
  result <- liftIO $ fromFile file

  either reportError (reporter verbose summary) result

reporter :: Bool -> Bool -> (Gltf -> RIO App ())
reporter True _ = reportVerbose
reporter _ True = reportSummary
reporter _ _ = reportGltf

reportError :: HasLogFunc logger => Errors -> RIO logger ()
reportError err
  = logError (display err)
  >> exitFailure

reportVerbose :: Gltf -> RIO App ()
reportVerbose gltf = do
  reportAsset $ gltf ^. _asset

  logInfo "" -- Blank line

  reportNodes gltf $ reportMeshVerbose gltf

reportSummary :: Gltf -> RIO App ()
reportSummary gltf = do
  reportAsset $ gltf ^. _asset
  
  logInfo "" -- Blank line

  reportNodes gltf reportMeshSummary

reportGltf :: Gltf -> RIO App ()
reportGltf gltf = do
  reportAsset $ gltf ^. _asset
  
  logInfo "" -- Blank line

  reportNodes gltf $ reportMesh gltf

reportAsset :: Asset -> RIO App ()
reportAsset asset = do
  logInfo $ "Generator: " <> asset ^. _assetGenerator . to (fromMaybe "Unknown") . to display
  logInfo $ "Version: " <> asset ^. _assetVersion . to display

reportNodes :: Gltf -> (Mesh -> RIO App ()) -> RIO App ()
reportNodes gltf meshReporter = do
  let nodes = gltf ^. _nodes
  logInfo $ "Nodes: " <> display (RIO.length nodes)

  forM_ nodes $ \node -> do
    logInfo $ "  Name: " <> maybe "Unknown node" display (view _nodeName node)

    forM_ (node ^. _nodeMeshId) $ \meshId -> do
      logInfo "  Mesh: "
      forM_ (gltf ^. _meshes ^? ix meshId) meshReporter

reportMeshVerbose :: Gltf -> Mesh -> RIO App ()
reportMeshVerbose gltf mesh = do
  logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")
  logInfo "    Mesh Primitives:"

  forM_ (mesh ^. _meshPrimitives) $ \primitive' -> do
    -- Report Vertices
    logInfo "      Vertices:"
    
    let positions = primitive' ^. _meshPrimitivePositions
    forM_ (primitive' ^. _meshPrimitiveIndices) $ \index -> do
      forM_ (positions Vector.!? fromIntegral index) $ \position -> do
        logInfo $ "        [" <> display index <> "]: " <> displayV3 position

    logInfo "      Normals:"
    let normals = primitive' ^. _meshPrimitiveNormals
    forM_ (primitive' ^. _meshPrimitiveIndices) $ \index -> do
      forM_ (normals Vector.!? fromIntegral index) $ \normal -> do
        logInfo $ "        [" <> display index <> "]: " <> displayV3 normal

    -- Report material
    forM_ (primitive' ^. _meshPrimitiveMaterial) $ \materialId -> do
      forM_ (gltf ^. _materials . to (Vector.!? materialId)) reportMaterial
    
reportMesh :: Gltf -> Mesh -> RIO App ()
reportMesh gltf mesh = do
  logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")
  logInfo "    Mesh Primitives:"

  forM_ (mesh ^. _meshPrimitives) $ \primitive' -> do
    logInfo "      Vertex Positions:"

    forM_ (Vector.uniq $ primitive' ^. _meshPrimitivePositions) $ \position -> do
      logInfo $ "        " <> displayV3 position

    -- Report material
    forM_ (primitive' ^. _meshPrimitiveMaterial) $ \materialId -> do
      forM_ (gltf ^. _materials . to (Vector.!? materialId)) reportMaterial

reportMeshSummary :: Mesh -> RIO App ()
reportMeshSummary mesh = do
  logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")

  let primitives' = mesh ^. _meshPrimitives
      vertices = Vector.concatMap (^. _meshPrimitivePositions) primitives'
      indices = Vector.concatMap (^. _meshPrimitiveIndices) primitives'

  logInfo $ "    Unique Vertices: " <> display (length vertices)
  logInfo $ "    Total Vertices: " <> display (length indices)

reportMaterial :: Material -> RIO App ()
reportMaterial material = do
  logInfo "      Material:"
  logInfo $ "        Name: " <>
    material ^. _materialName . to (display . fromMaybe "Unknown")
  
  forM_ (material ^. _materialPbrMetallicRoughness) $ \pbr -> do
    logInfo $ "        Base Color Factor: " <> pbr ^. _pbrBaseColorFactor . to displayV4
    logInfo $ "        Metallic Factor: " <> pbr ^. _pbrMetallicFactor . to display
    logInfo $ "        Roughness Factor: " <> pbr ^. _pbrRoughnessFactor . to display
  
displayV3 :: Display a => V3 a -> Utf8Builder
displayV3 (V3 x y z)
  = "("
  <> display x <> ", "
  <> display y <> ", "
  <> display z <>
  ")"

displayV4 :: Display a => V4 a -> Utf8Builder
displayV4 (V4 w x y z)
  = "("
  <> display w <> ", "
  <> display x <> ", "
  <> display y <> ", "
  <> display z <>
  ")"