--------------------------------------------------------------------------------
-- |
-- Module      :  RedViz
-- Copyright   :  (c) Vladimir Lopatin 2022
-- License     :  BSD-3-Clause
--
-- Maintainer  :  Vladimir Lopatin <madjestic13@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- Reading and parsing pgeo file format
--
--------------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}
--{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}

module Graphics.RedViz.PGeo
  ( PGeo(..)
  , VGeo(..)
  , Vec3
  , readPGeo
  , readVGeo
  , readBGeo
  , fromPGeo
  , fromPGeo'
  ) where

import Data.Aeson
import Data.Aeson.TH
import Data.Maybe                             (fromMaybe)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString      as BS
import Graphics.Rendering.OpenGL      as GL   (Vertex4(..))
import Data.Store                     as DS

import Graphics.RedViz.FromVector
import Graphics.RedViz.Utils
import Graphics.RedViz.VAO

-- import Debug.Trace   as DT

-- | TODO : replace Vec3 -> Vec4
type Vec3 = (Double, Double, Double)

type Vec4 = (Double, Double, Double, Double)

instance FromVector Vec3 where
  toVertex4 :: Vec3 -> Vertex4 Double
  toVertex4 :: Vec3 -> Vertex4 Double
toVertex4 (Double
k, Double
l, Double
m) = Double -> Double -> Double -> Double -> Vertex4 Double
forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 Double
k Double
l Double
m Double
1.0  

data PGeo
  =  PGeo
     {
       PGeo -> [[Int]]
ids   :: [[Int]]  
     , PGeo -> [Float]
as    :: [Float] -- 1
     , PGeo -> [Vec3]
cs    :: [Vec3]  -- 3
     , PGeo -> [Vec3]
ns    :: [Vec3]  -- 3
     , PGeo -> [Vec3]
uvws  :: [Vec3]  -- 3
     , PGeo -> [Vec3]
ps    :: [Vec3]  -- 3 -> 13+1 -> 14 stride -- TODO: add v (vel), m (mass)
     , PGeo -> [String]
mats  :: [String]
     , PGeo -> [Float]
m     :: [Float]
     , PGeo -> [Vec3]
v     :: [Vec3] -- [[x,y,x]] ~= [Vec3]
     , PGeo -> [[Float]]
xform :: [[Float]] -- [xform M44]
     }
  deriving Int -> PGeo -> ShowS
[PGeo] -> ShowS
PGeo -> String
(Int -> PGeo -> ShowS)
-> (PGeo -> String) -> ([PGeo] -> ShowS) -> Show PGeo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PGeo] -> ShowS
$cshowList :: [PGeo] -> ShowS
show :: PGeo -> String
$cshow :: PGeo -> String
showsPrec :: Int -> PGeo -> ShowS
$cshowsPrec :: Int -> PGeo -> ShowS
Show
deriveJSON defaultOptions ''PGeo

data VGeo
  =  VGeo
     {
       VGeo -> [[Int]]
is  :: [[Int]]    -- indices
     , VGeo -> [Int]
st  :: [Int]      -- strides
     , VGeo -> [[Float]]
vs  :: [[Float]]  -- all attrs as a flat list
     , VGeo -> [String]
mts :: [FilePath] -- materials
     , VGeo -> [Float]
ms  :: [Float]    -- masses
     , VGeo -> [[Float]]
vls :: [[Float]]     -- velocities
     , VGeo -> [[Float]]
xf  :: [[Float]]  -- preTransforms
     }
  deriving Int -> VGeo -> ShowS
[VGeo] -> ShowS
VGeo -> String
(Int -> VGeo -> ShowS)
-> (VGeo -> String) -> ([VGeo] -> ShowS) -> Show VGeo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VGeo] -> ShowS
$cshowList :: [VGeo] -> ShowS
show :: VGeo -> String
$cshow :: VGeo -> String
showsPrec :: Int -> VGeo -> ShowS
$cshowsPrec :: Int -> VGeo -> ShowS
Show

readBGeo :: FilePath -> IO VGeo
readBGeo :: String -> IO VGeo
readBGeo String
file = 
  do
    -- _ <- DT.trace "trace" $ return ()
    ByteString
bs <- String -> IO ByteString
BS.readFile String
file
    VGeo -> IO VGeo
forall (m :: * -> *) a. Monad m => a -> m a
return (VGeo -> IO VGeo) -> VGeo -> IO VGeo
forall a b. (a -> b) -> a -> b
$ case (ByteString
-> Either
     PeekException
     ([[Int]], [Int], [[Float]], [String], [Float], [[Float]],
      [[Float]])
forall a. Store a => ByteString -> Either PeekException a
DS.decode ByteString
bs) of
               Right ([[Int]]
idxs, [Int]
st, [[Float]]
vaos, [String]
mats, [Float]
mass, [[Float]]
vels, [[Float]]
xform) -> [[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[Int]]
idxs [Int]
st [[Float]]
vaos [String]
mats [Float]
mass [[Float]]
vels [[Float]]
xform
               Left PeekException
_ -> [[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[]] [] [[]] [] [] [] [[]]

readVGeo :: FilePath -> IO VGeo
readVGeo :: String -> IO VGeo
readVGeo String
file = 
  do
    Maybe
  ([[Int]], [Int], [[Float]], [String], [Float], [[Float]],
   [[Float]])
d <- String
-> IO
     (Maybe
        ([[Int]], [Int], [[Float]], [String], [Float], [[Float]],
         [[Float]]))
forall a. FromJSON a => String -> IO (Maybe a)
decodeFileStrict String
file :: IO (Maybe ([[Int]],[Int],[[Float]],[String], [Float], [[Float]], [[Float]]))
    VGeo -> IO VGeo
forall (m :: * -> *) a. Monad m => a -> m a
return (VGeo -> IO VGeo) -> VGeo -> IO VGeo
forall a b. (a -> b) -> a -> b
$ case Maybe
  ([[Int]], [Int], [[Float]], [String], [Float], [[Float]],
   [[Float]])
d of
               Just ([[Int]]
idxs, [Int]
st, [[Float]]
vaos, [String]
mats, [Float]
mass, [[Float]]
vels, [[Float]]
xform) -> [[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[Int]]
idxs [Int]
st [[Float]]
vaos [String]
mats [Float]
mass [[Float]]
vels [[Float]]
xform
               Maybe
  ([[Int]], [Int], [[Float]], [String], [Float], [[Float]],
   [[Float]])
Nothing  -> [[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[]] [] [[]] [] [] [] [[]]

readPGeo :: FilePath -> IO PGeo
readPGeo :: String -> IO PGeo
readPGeo String
jsonFile =
  do
    Either String PGeo
d <- (ByteString -> Either String PGeo
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String PGeo)
-> IO ByteString -> IO (Either String PGeo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BL.readFile String
jsonFile) :: IO (Either String PGeo)
    --print $ "readPGeo.d :" ++ show d
    -- case d of
    ()
_ <-
      case (Either String PGeo -> Maybe PGeo
forall a a. Either a a -> Maybe a
fromEither Either String PGeo
d) of
        Maybe PGeo
Nothing -> String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"readPGeo.d :" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String PGeo -> String
forall a. Show a => a -> String
show Either String PGeo
d
        Maybe PGeo
_ -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"parsing the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
forall a. Show a => a -> String
show String
jsonFile) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": OK"
    
    let ids' :: [[Int]]
ids'  = (PGeo -> [[Int]]
ids   (PGeo -> [[Int]])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        as' :: [Float]
as'   = (PGeo -> [Float]
as    (PGeo -> [Float])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        cs' :: [Vec3]
cs'   = (PGeo -> [Vec3]
cs    (PGeo -> [Vec3])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Vec3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        ns' :: [Vec3]
ns'   = (PGeo -> [Vec3]
ns    (PGeo -> [Vec3])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Vec3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        uvws' :: [Vec3]
uvws' = (PGeo -> [Vec3]
uvws  (PGeo -> [Vec3])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Vec3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        ps' :: [Vec3]
ps'   = (PGeo -> [Vec3]
ps    (PGeo -> [Vec3])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Vec3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        mts' :: [String]
mts'  = (PGeo -> [String]
mats  (PGeo -> [String])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        mass' :: [Float]
mass' = (PGeo -> [Float]
m     (PGeo -> [Float])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        vels' :: [Vec3]
vels' = (PGeo -> [Vec3]
v     (PGeo -> [Vec3])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [Vec3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
        xf' :: [[Float]]
xf'   = (PGeo -> [[Float]]
xform (PGeo -> [[Float]])
-> (Either String PGeo -> PGeo) -> Either String PGeo -> [[Float]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String PGeo -> PGeo
forall a. Either a PGeo -> PGeo
fromEitherDecode) Either String PGeo
d
    PGeo -> IO PGeo
forall (m :: * -> *) a. Monad m => a -> m a
return (PGeo -> IO PGeo) -> PGeo -> IO PGeo
forall a b. (a -> b) -> a -> b
$ [[Int]]
-> [Float]
-> [Vec3]
-> [Vec3]
-> [Vec3]
-> [Vec3]
-> [String]
-> [Float]
-> [Vec3]
-> [[Float]]
-> PGeo
PGeo [[Int]]
ids' [Float]
as' [Vec3]
cs' [Vec3]
ns' [Vec3]
uvws' [Vec3]
ps' [String]
mts' [Float]
mass' [Vec3]
vels' [[Float]]
xf'

      where
        fromEitherDecode :: Either a PGeo -> PGeo
fromEitherDecode = PGeo -> Maybe PGeo -> PGeo
forall a. a -> Maybe a -> a
fromMaybe ([[Int]]
-> [Float]
-> [Vec3]
-> [Vec3]
-> [Vec3]
-> [Vec3]
-> [String]
-> [Float]
-> [Vec3]
-> [[Float]]
-> PGeo
PGeo [[]] [] [] [] [] [] [] [] [] [[]]) (Maybe PGeo -> PGeo)
-> (Either a PGeo -> Maybe PGeo) -> Either a PGeo -> PGeo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a PGeo -> Maybe PGeo
forall a a. Either a a -> Maybe a
fromEither
        fromEither :: Either a a -> Maybe a
fromEither Either a a
d =
          case Either a a
d of
            Right a
pt -> a -> Maybe a
forall a. a -> Maybe a
Just a
pt
            Either a a
_ -> Maybe a
forall a. Maybe a
Nothing

fromPGeo :: PGeo -> VGeo
fromPGeo :: PGeo -> VGeo
fromPGeo (PGeo [[Int]]
idx' [Float]
as' [Vec3]
cs' [Vec3]
ns' [Vec3]
uvw' [Vec3]
ps' [String]
mts' [Float]
mass' [Vec3]
vels' [[Float]]
xf') = ([[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[Int]]
idxs [Int]
st [[Float]]
vaos [String]
mts' [Float]
mass' [[Float]]
vels [[Float]]
xf')
  where
    stride :: Int
stride = Int
13 -- TODO: make it more elegant, right now VBO's are hard-coded to be have stride = 13...
    vao :: VAO
vao = ([[Int]] -> [Float] -> [Vec3] -> [Vec3] -> [Vec3] -> [Vec3] -> VAO
toVAO [[Int]]
idx' [Float]
as' [Vec3]
cs' [Vec3]
ns' [Vec3]
uvw' [Vec3]
ps')
    ([[Int]]
idxs, [[Float]]
vaos) = [([Int], [Float])] -> ([[Int]], [[Float]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Int], [Float])] -> ([[Int]], [[Float]]))
-> [([Int], [Float])] -> ([[Int]], [[Float]])
forall a b. (a -> b) -> a -> b
$ ([[Float]] -> ([Int], [Float])) -> VAO -> [([Int], [Float])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Float]] -> ([Int], [Float])
toIdxVAO VAO
vao -- that already outputs [[]], but vao, I think,is still a single element list?
    st :: [Int]
st           = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take ([[Float]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Float]]
vaos) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. a -> [a]
repeat Int
stride
    vels :: [[Float]]
vels         = (Vec3 -> [Float]) -> [Vec3] -> [[Float]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Double
x,Double
y,Double
z)   -> (Double -> Float) -> [Double] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double
x,Double
y,Double
z]) [Vec3]
vels'

fromPGeo' :: PGeo -> VGeo
fromPGeo' :: PGeo -> VGeo
fromPGeo' (PGeo [[Int]]
idx' [Float]
as' [Vec3]
cs' [Vec3]
ns' [Vec3]
uvw' [Vec3]
ps' [String]
mts' [Float]
mass' [Vec3]
vels' [[Float]]
xf') = ([[Int]]
-> [Int]
-> [[Float]]
-> [String]
-> [Float]
-> [[Float]]
-> [[Float]]
-> VGeo
VGeo [[Int]]
idxs [Int]
st [[Float]]
vaos [String]
mts' [Float]
mass' [[Float]]
vels [[Float]]
xf')
  where
    stride :: Int
stride = Int
13 -- TODO: make it more elegant, right now VBO's are hard-coded to be have stride = 13...
    vao :: VAO
vao = ([[Int]] -> [Float] -> [Vec3] -> [Vec3] -> [Vec3] -> [Vec3] -> VAO
toVAO [[Int]]
idx' [Float]
as' [Vec3]
cs' [Vec3]
ns' [Vec3]
uvw' [Vec3]
ps')
    ([[Int]]
idxs, [[Float]]
vaos) = [([Int], [Float])] -> ([[Int]], [[Float]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Int], [Float])] -> ([[Int]], [[Float]]))
-> [([Int], [Float])] -> ([[Int]], [[Float]])
forall a b. (a -> b) -> a -> b
$ ([[Float]] -> ([Int], [Float])) -> VAO -> [([Int], [Float])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Float]] -> ([Int], [Float])
toIdxVAO' VAO
vao -- that already outputs [[]], but vao, I think,is still a single element list?
    st :: [Int]
st           = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take ([[Float]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Float]]
vaos) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. a -> [a]
repeat Int
stride
    vels :: [[Float]]
vels         = (Vec3 -> [Float]) -> [Vec3] -> [[Float]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Double
x,Double
y,Double
z)   -> (Double -> Float) -> [Double] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double
x,Double
y,Double
z]) [Vec3]
vels'