module Stage.Loader.UI
  ( Settings(..)

  , UI(..)
  , spawn

  , Observer(..)
  , newObserver
  , observe
  ) where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Control.Monad.Trans.Resource qualified as Resource
import Geomancy (vec4)
import Geomancy.Layout qualified as Layout
import Geomancy.Layout.Alignment qualified as Alignment
import Geomancy.Layout.Box qualified as Box
import Geomancy.Transform qualified as Transform
import Vulkan.Core10 qualified as Vk

import Engine.Camera qualified as Camera
import Engine.Types qualified as Engine
import Engine.UI.Message qualified as Message
import Engine.Vulkan.Types (HasVulkan, Queues)
import Engine.Worker qualified as Worker
import Geometry.Quad qualified as Quad
import Render.Samplers qualified as Samplers
import Render.Unlit.Textured.Model qualified as UnlitTextured
import Resource.Buffer qualified as Buffer
import Resource.Combined.Textures qualified as CombinedTextures
import Resource.Font.EvanW qualified as EvanW
import Resource.Model qualified as Model
import Resource.Model.Observer qualified as Observer
import Resource.Region qualified as Region
import Resource.Texture (Texture, Flat)

data Settings fonts textures = Settings
  { forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Text
titleMessage :: Text
  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Int32
backgroundIx :: Int32
  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Int32
spinnerIx    :: Int32

  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures
-> Collection textures fonts (Int32, Texture Flat)
combined     :: CombinedTextures.Collection textures fonts (Int32, Texture Flat)
  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> fonts Container
fonts        :: fonts EvanW.Container

  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> forall a. fonts a -> a
smallFont    :: forall a . fonts a -> a
  , forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> forall a. fonts a -> a
largeFont    :: forall a . fonts a -> a
  }

data UI = UI
  { UI -> Process
titleP    :: Message.Process
  , UI -> Process
subtitleP :: Message.Process

  , UI -> Var Input
progressInput :: Worker.Var Message.Input
  , UI -> Process
progressP     :: Message.Process

  , UI -> Merge Stores
backgroundP :: Worker.Merge UnlitTextured.Stores
  , UI -> Merge Stores
spinnerP    :: Worker.Merge UnlitTextured.Stores

  , UI -> Model 'Staged
quadUV :: UnlitTextured.Model 'Buffer.Staged
  }

spawn
  :: Queues Vk.CommandPool
  -> Settings fonts textures
  -> Engine.StageRIO env (Resource.ReleaseKey, UI)
spawn :: forall (fonts :: * -> *) (textures :: * -> *) env.
Queues CommandPool
-> Settings fonts textures -> StageRIO env (ReleaseKey, UI)
spawn Queues CommandPool
pools Settings{fonts Container
Int32
Text
Collection textures fonts (Int32, Texture Flat)
forall a. fonts a -> a
$sel:titleMessage:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Text
$sel:backgroundIx:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Int32
$sel:spinnerIx:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> Int32
$sel:combined:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures
-> Collection textures fonts (Int32, Texture Flat)
$sel:fonts:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> fonts Container
$sel:smallFont:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> forall a. fonts a -> a
$sel:largeFont:Settings :: forall (fonts :: * -> *) (textures :: * -> *).
Settings fonts textures -> forall a. fonts a -> a
titleMessage :: Text
backgroundIx :: Int32
spinnerIx :: Int32
combined :: Collection textures fonts (Int32, Texture Flat)
fonts :: fonts Container
smallFont :: forall a. fonts a -> a
largeFont :: forall a. fonts a -> a
..} = ResourceT (RIO (App GlobalHandles env)) UI
-> RIO (App GlobalHandles env) (ReleaseKey, UI)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
Region.run do
  Merge Box
screenBoxP <- ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m (Merge Box)
Camera.trackOrthoPixelsCentered

  Merge Box
screenPaddedP <-
    (GetOutput (Merge Box) -> Box)
-> Merge Box -> ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
      (Vec2 -> Box -> Box
Box.resize (-Vec2
16))
      Merge Box
screenBoxP

  -- Messages

  Merge (Box, (Box, Box))
sectionsP <-
    (GetOutput (Merge Box) -> (Box, (Box, Box)))
-> Merge Box
-> ResourceT
     (RIO (App GlobalHandles env)) (Merge (Box, (Box, Box)))
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
      ( \GetOutput (Merge Box)
parent ->
          let
            (Box
top, Box
bottom) = Either Float Float -> Box -> (Box, Box)
Layout.vertical (Float -> Either Float Float
forall a b. b -> Either a b
Right Float
0.5) Box
GetOutput (Merge Box)
parent
          in
            ( Box
top
            , Either Float Float -> Box -> (Box, Box)
Layout.vertical (Float -> Either Float Float
forall a b. b -> Either a b
Right Float
0.5) Box
bottom
            )
      )
      Merge Box
screenPaddedP

  Merge Box
titleBoxP <- (GetOutput (Merge (Box, (Box, Box))) -> Box)
-> Merge (Box, (Box, Box))
-> ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 (Box, (Box, Box)) -> Box
GetOutput (Merge (Box, (Box, Box))) -> Box
forall a b. (a, b) -> a
fst Merge (Box, (Box, Box))
sectionsP
  Process
titleP <- Input -> ResourceT (RIO (App GlobalHandles env)) (Var Input)
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Input
title ResourceT (RIO (App GlobalHandles env)) (Var Input)
-> (Var Input -> ResourceT (RIO (App GlobalHandles env)) Process)
-> ResourceT (RIO (App GlobalHandles env)) Process
forall a b.
ResourceT (RIO (App GlobalHandles env)) a
-> (a -> ResourceT (RIO (App GlobalHandles env)) b)
-> ResourceT (RIO (App GlobalHandles env)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Merge Box
-> Var Input -> ResourceT (RIO (App GlobalHandles env)) Process
forall (m :: * -> *) box input.
(MonadResource m, MonadUnliftIO m, HasOutput box,
 GetOutput box ~ Box, HasOutput input, GetOutput input ~ Input) =>
box -> input -> m Process
Message.spawn Merge Box
titleBoxP

  Merge (Box, Box)
lowerSectionP <- (GetOutput (Merge (Box, (Box, Box))) -> (Box, Box))
-> Merge (Box, (Box, Box))
-> ResourceT (RIO (App GlobalHandles env)) (Merge (Box, Box))
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 (Box, (Box, Box)) -> (Box, Box)
GetOutput (Merge (Box, (Box, Box))) -> (Box, Box)
forall a b. (a, b) -> b
snd Merge (Box, (Box, Box))
sectionsP

  Merge Box
subtitleBoxP <- (GetOutput (Merge (Box, Box)) -> Box)
-> Merge (Box, Box)
-> ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 (Box, Box) -> Box
GetOutput (Merge (Box, Box)) -> Box
forall a b. (a, b) -> a
fst Merge (Box, Box)
lowerSectionP
  Process
subtitleP <- Input -> ResourceT (RIO (App GlobalHandles env)) (Var Input)
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Input
subtitle ResourceT (RIO (App GlobalHandles env)) (Var Input)
-> (Var Input -> ResourceT (RIO (App GlobalHandles env)) Process)
-> ResourceT (RIO (App GlobalHandles env)) Process
forall a b.
ResourceT (RIO (App GlobalHandles env)) a
-> (a -> ResourceT (RIO (App GlobalHandles env)) b)
-> ResourceT (RIO (App GlobalHandles env)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Merge Box
-> Var Input -> ResourceT (RIO (App GlobalHandles env)) Process
forall (m :: * -> *) box input.
(MonadResource m, MonadUnliftIO m, HasOutput box,
 GetOutput box ~ Box, HasOutput input, GetOutput input ~ Input) =>
box -> input -> m Process
Message.spawn Merge Box
subtitleBoxP

  Var Input
progressInput <- Input -> ResourceT (RIO (App GlobalHandles env)) (Var Input)
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Input
progress
  Merge Box
progressBoxP <- (GetOutput (Merge (Box, Box)) -> Box)
-> Merge (Box, Box)
-> ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 (Box, Box) -> Box
GetOutput (Merge (Box, Box)) -> Box
forall a b. (a, b) -> b
snd Merge (Box, Box)
lowerSectionP
  Process
progressP <- Merge Box
-> Var Input -> ResourceT (RIO (App GlobalHandles env)) Process
forall (m :: * -> *) box input.
(MonadResource m, MonadUnliftIO m, HasOutput box,
 GetOutput box ~ Box, HasOutput input, GetOutput input ~ Input) =>
box -> input -> m Process
Message.spawn Merge Box
progressBoxP Var Input
progressInput

  -- Splash

  Merge Box
backgroundBoxP <-
    (GetOutput (Merge Box) -> Box)
-> Merge Box -> ResourceT (RIO (App GlobalHandles env)) (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
      (Vec2 -> Vec2 -> Box -> Box
Layout.placeAspect Vec2
Alignment.center Vec2
1)
      Merge Box
screenBoxP

  Merge Stores
backgroundP <-
    (GetOutput (Merge Box) -> Stores)
-> Merge Box
-> ResourceT (RIO (App GlobalHandles env)) (Merge Stores)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
      ( \GetOutput (Merge Box)
box ->
          Int32 -> Int32 -> [Transform] -> Stores
UnlitTextured.stores1
              (Collection Int32 -> Int32
forall a. Collection a -> a
Samplers.linear Collection Int32
Samplers.indices)
              Int32
backgroundIx
              [Box -> Transform
Box.mkTransform Box
GetOutput (Merge Box)
box]
      )
      Merge Box
backgroundBoxP

  -- Spinner

  Timed () Transform
spinnerTransformTimeP <-
    Bool
-> Int
-> Transform
-> ResourceT (RIO (App GlobalHandles env)) Transform
-> ResourceT (RIO (App GlobalHandles env)) (Timed () Transform)
forall (m :: * -> *) output.
(MonadUnliftIO m, MonadResource m) =>
Bool -> Int -> output -> m output -> m (Timed () output)
Worker.spawnTimed_ Bool
True Int
100 Transform
forall a. Monoid a => a
mempty do
      Double
t <- ResourceT (RIO (App GlobalHandles env)) Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
      pure $ Float -> Transform
Transform.rotateZ (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
t)

  Merge Transform
spinnerTransformBoxP <-
    (GetOutput (Merge Box) -> Transform)
-> Merge Box
-> ResourceT (RIO (App GlobalHandles env)) (Merge Transform)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
      (Box -> Transform
GetOutput (Merge Box) -> Transform
Box.mkTransform) -- FIXME: . Layout.boxFitScale 64)
      Merge Box
subtitleBoxP

  Merge Stores
spinnerP <-
    (GetOutput (Merge Transform)
 -> GetOutput (Timed () Transform) -> Stores)
-> Merge Transform
-> Timed () Transform
-> ResourceT (RIO (App GlobalHandles env)) (Merge Stores)
forall (m :: * -> *) i1 i2 o.
(MonadUnliftIO m, MonadResource m, HasOutput i1, HasOutput i2) =>
(GetOutput i1 -> GetOutput i2 -> o) -> i1 -> i2 -> m (Merge o)
Worker.spawnMerge2
      ( \GetOutput (Merge Transform)
place GetOutput (Timed () Transform)
turn ->
          Int32 -> Int32 -> [Transform] -> Stores
UnlitTextured.stores1
              (Collection Int32 -> Int32
forall a. Collection a -> a
Samplers.linear Collection Int32
Samplers.indices)
              Int32
spinnerIx
              [Transform
GetOutput (Timed () Transform)
turn, Transform
GetOutput (Merge Transform)
place]
      )
      Merge Transform
spinnerTransformBoxP
      Timed () Transform
spinnerTransformTimeP

  -- Models

  Model 'Staged
quadUV <- Maybe Text
-> Queues CommandPool
-> [Vertex Packed Vec2]
-> Maybe [Word32]
-> ResourceT (RIO (App GlobalHandles env)) (Model 'Staged)
forall env (m :: * -> *) pos attrs.
(MonadVulkan env m, Storable pos, Storable attrs) =>
Maybe Text
-> Queues CommandPool
-> [Vertex pos attrs]
-> Maybe [Word32]
-> m (Indexed 'Staged pos attrs)
Model.createStagedL
    (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"quadUV")
    Queues CommandPool
pools
    (Quad (Vertex Packed Vec2) -> [Vertex Packed Vec2]
forall pos attrs. Quad (Vertex pos attrs) -> [Vertex pos attrs]
Quad.toVertices Quad (Vertex Packed Vec2)
Quad.texturedQuad)
    Maybe [Word32]
forall a. Maybe a
Nothing
  Model 'Staged -> ResourceT (RIO (App GlobalHandles env)) ()
forall {k1} {k2} env (m :: * -> *) (storage :: Store) (pos :: k1)
       (attrs :: k2).
(MonadVulkan env m, MonadResource m) =>
Indexed storage pos attrs -> m ()
Model.registerIndexed_ Model 'Staged
quadUV

  pure UI{Var Input
Process
Merge Stores
Model 'Staged
$sel:titleP:UI :: Process
$sel:subtitleP:UI :: Process
$sel:progressInput:UI :: Var Input
$sel:progressP:UI :: Process
$sel:backgroundP:UI :: Merge Stores
$sel:spinnerP:UI :: Merge Stores
$sel:quadUV:UI :: Model 'Staged
titleP :: Process
subtitleP :: Process
progressInput :: Var Input
progressP :: Process
backgroundP :: Merge Stores
spinnerP :: Merge Stores
quadUV :: Model 'Staged
..}
  where
    title :: Input
title = Message.Input
      { $sel:inputText:Input :: Text
inputText         = Text
titleMessage
      , $sel:inputOrigin:Input :: Vec2
inputOrigin       = Vec2
Alignment.centerBottom
      , $sel:inputSize:Input :: Float
inputSize         = Float
64
      , $sel:inputColor:Input :: Vec4
inputColor        = Float -> Float -> Float -> Float -> Vec4
vec4 Float
1 Float
0.5 Float
0.25 Float
1
      , $sel:inputFont:Input :: Container
inputFont         = fonts Container -> Container
forall a. fonts a -> a
largeFont fonts Container
fonts
      , $sel:inputFontId:Input :: Int32
inputFontId       = (Int32, Texture Flat) -> Int32
forall a b. (a, b) -> a
fst ((Int32, Texture Flat) -> Int32)
-> (fonts (Int32, Texture Flat) -> (Int32, Texture Flat))
-> fonts (Int32, Texture Flat)
-> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fonts (Int32, Texture Flat) -> (Int32, Texture Flat)
forall a. fonts a -> a
largeFont (fonts (Int32, Texture Flat) -> Int32)
-> fonts (Int32, Texture Flat) -> Int32
forall a b. (a -> b) -> a -> b
$ Collection textures fonts (Int32, Texture Flat)
-> fonts (Int32, Texture Flat)
forall {k} (textures :: k -> *) (fonts :: k -> *) (a :: k).
Collection textures fonts a -> fonts a
CombinedTextures.fonts Collection textures fonts (Int32, Texture Flat)
combined
      , $sel:inputOutline:Input :: Vec4
inputOutline      = Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
0 Float
0 Float
1
      , $sel:inputOutlineWidth:Input :: Float
inputOutlineWidth = Float
4Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
16
      , $sel:inputSmoothing:Input :: Float
inputSmoothing    = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
16
      }

    subtitle :: Input
subtitle = Message.Input
      { $sel:inputText:Input :: Text
inputText         = Text
"Loading..."
      , $sel:inputOrigin:Input :: Vec2
inputOrigin       = Vec2
Alignment.centerTop
      , $sel:inputSize:Input :: Float
inputSize         = Float
32
      , $sel:inputColor:Input :: Vec4
inputColor        = Float -> Float -> Float -> Float -> Vec4
vec4 Float
0.5 Float
1 Float
0.25 Float
1
      , $sel:inputFont:Input :: Container
inputFont         = fonts Container -> Container
forall a. fonts a -> a
smallFont fonts Container
fonts
      , $sel:inputFontId:Input :: Int32
inputFontId       = (Int32, Texture Flat) -> Int32
forall a b. (a, b) -> a
fst ((Int32, Texture Flat) -> Int32)
-> (fonts (Int32, Texture Flat) -> (Int32, Texture Flat))
-> fonts (Int32, Texture Flat)
-> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fonts (Int32, Texture Flat) -> (Int32, Texture Flat)
forall a. fonts a -> a
smallFont (fonts (Int32, Texture Flat) -> Int32)
-> fonts (Int32, Texture Flat) -> Int32
forall a b. (a -> b) -> a -> b
$ Collection textures fonts (Int32, Texture Flat)
-> fonts (Int32, Texture Flat)
forall {k} (textures :: k -> *) (fonts :: k -> *) (a :: k).
Collection textures fonts a -> fonts a
CombinedTextures.fonts Collection textures fonts (Int32, Texture Flat)
combined
      , $sel:inputOutline:Input :: Vec4
inputOutline      = Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
0 Float
0 Float
1
      , $sel:inputOutlineWidth:Input :: Float
inputOutlineWidth = Float
4Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
16
      , $sel:inputSmoothing:Input :: Float
inputSmoothing    = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
16
      }

    progress :: Input
progress = Message.Input
      { $sel:inputText:Input :: Text
inputText         = Text
""
      , $sel:inputOrigin:Input :: Vec2
inputOrigin       = Vec2
Alignment.centerBottom
      , $sel:inputSize:Input :: Float
inputSize         = Float
16
      , $sel:inputColor:Input :: Vec4
inputColor        = Float -> Float -> Float -> Float -> Vec4
vec4 Float
0.25 Float
0.5 Float
1 Float
1
      , $sel:inputFont:Input :: Container
inputFont         = fonts Container -> Container
forall a. fonts a -> a
smallFont fonts Container
fonts
      , $sel:inputFontId:Input :: Int32
inputFontId       = (Int32, Texture Flat) -> Int32
forall a b. (a, b) -> a
fst ((Int32, Texture Flat) -> Int32)
-> (fonts (Int32, Texture Flat) -> (Int32, Texture Flat))
-> fonts (Int32, Texture Flat)
-> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fonts (Int32, Texture Flat) -> (Int32, Texture Flat)
forall a. fonts a -> a
smallFont (fonts (Int32, Texture Flat) -> Int32)
-> fonts (Int32, Texture Flat) -> Int32
forall a b. (a -> b) -> a -> b
$ Collection textures fonts (Int32, Texture Flat)
-> fonts (Int32, Texture Flat)
forall {k} (textures :: k -> *) (fonts :: k -> *) (a :: k).
Collection textures fonts a -> fonts a
CombinedTextures.fonts Collection textures fonts (Int32, Texture Flat)
combined
      , $sel:inputOutline:Input :: Vec4
inputOutline      = Vec4
0
      , $sel:inputOutlineWidth:Input :: Float
inputOutlineWidth = Float
0
      , $sel:inputSmoothing:Input :: Float
inputSmoothing    = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
16
      }

data Observer = Observer
  { Observer -> [Observer]
messages   :: [Message.Observer]
  , Observer -> ObserverCoherent
background :: UnlitTextured.ObserverCoherent
  , Observer -> ObserverCoherent
spinner    :: UnlitTextured.ObserverCoherent
  }

newObserver :: UI -> ResourceT (Engine.StageRIO st) Observer
newObserver :: forall st. UI -> ResourceT (StageRIO st) Observer
newObserver UI{Var Input
Process
Merge Stores
Model 'Staged
$sel:titleP:UI :: UI -> Process
$sel:subtitleP:UI :: UI -> Process
$sel:progressInput:UI :: UI -> Var Input
$sel:progressP:UI :: UI -> Process
$sel:backgroundP:UI :: UI -> Merge Stores
$sel:spinnerP:UI :: UI -> Merge Stores
$sel:quadUV:UI :: UI -> Model 'Staged
titleP :: Process
subtitleP :: Process
progressInput :: Var Input
progressP :: Process
backgroundP :: Merge Stores
spinnerP :: Merge Stores
quadUV :: Model 'Staged
..} = do
  -- XXX: Generic?
  [Observer]
messages <- (Process -> ResourceT (StageRIO st) Observer)
-> [Process] -> ResourceT (StageRIO st) [Observer]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (ResourceT (StageRIO st) Observer
-> Process -> ResourceT (StageRIO st) Observer
forall a b. a -> b -> a
const (ResourceT (StageRIO st) Observer
 -> Process -> ResourceT (StageRIO st) Observer)
-> ResourceT (StageRIO st) Observer
-> Process
-> ResourceT (StageRIO st) Observer
forall a b. (a -> b) -> a -> b
$ Int -> ResourceT (StageRIO st) Observer
forall st. Int -> ResourceT (StageRIO st) Observer
Message.newObserver Int
256)
    [ Process
titleP
    , Process
subtitleP
    , Process
progressP
    ]

  ObserverCoherent
background <- Int -> Text -> ResourceT (StageRIO st) ObserverCoherent
forall res env (m :: * -> *).
(VertexBuffers res, MonadVulkan env m) =>
Int -> Text -> ResourceT m (ObserverIO res)
Observer.newCoherent Int
1 Text
"background"
  ObserverCoherent
spinner <- Int -> Text -> ResourceT (StageRIO st) ObserverCoherent
forall res env (m :: * -> *).
(VertexBuffers res, MonadVulkan env m) =>
Int -> Text -> ResourceT m (ObserverIO res)
Observer.newCoherent Int
1 Text
"spinner"

  pure Observer{[Observer]
ObserverCoherent
$sel:messages:Observer :: [Observer]
$sel:background:Observer :: ObserverCoherent
$sel:spinner:Observer :: ObserverCoherent
messages :: [Observer]
background :: ObserverCoherent
spinner :: ObserverCoherent
..}

observe
  :: ( HasVulkan env
     )
  => UI
  -> Observer -> RIO env ()
observe :: forall env. HasVulkan env => UI -> Observer -> RIO env ()
observe UI{Var Input
Process
Merge Stores
Model 'Staged
$sel:titleP:UI :: UI -> Process
$sel:subtitleP:UI :: UI -> Process
$sel:progressInput:UI :: UI -> Var Input
$sel:progressP:UI :: UI -> Process
$sel:backgroundP:UI :: UI -> Merge Stores
$sel:spinnerP:UI :: UI -> Merge Stores
$sel:quadUV:UI :: UI -> Model 'Staged
titleP :: Process
subtitleP :: Process
progressInput :: Var Input
progressP :: Process
backgroundP :: Merge Stores
spinnerP :: Merge Stores
quadUV :: Model 'Staged
..} Observer{[Observer]
ObserverCoherent
$sel:messages:Observer :: Observer -> [Observer]
$sel:background:Observer :: Observer -> ObserverCoherent
$sel:spinner:Observer :: Observer -> ObserverCoherent
messages :: [Observer]
background :: ObserverCoherent
spinner :: ObserverCoherent
..} = do
  ((Process, Observer) -> RIO env ())
-> [(Process, Observer)] -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Process -> Observer -> RIO env ())
-> (Process, Observer) -> RIO env ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Process -> Observer -> RIO env ()
forall env (m :: * -> *) source.
(MonadVulkan env m, HasOutput source,
 GetOutput source ~ Vector InstanceAttrs) =>
source -> Observer -> m ()
Message.observe) ([(Process, Observer)] -> RIO env ())
-> [(Process, Observer)] -> RIO env ()
forall a b. (a -> b) -> a -> b
$
    [Process] -> [Observer] -> [(Process, Observer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Process
titleP, Process
subtitleP, Process
progressP] [Observer]
messages

  Merge Stores -> ObserverCoherent -> RIO env ()
forall env (m :: * -> *) output bufs.
(MonadVulkan env m, HasOutput output,
 UpdateCoherent bufs (GetOutput output)) =>
output -> ObserverIO bufs -> m ()
Observer.observeCoherent Merge Stores
backgroundP ObserverCoherent
background
  Merge Stores -> ObserverCoherent -> RIO env ()
forall env (m :: * -> *) output bufs.
(MonadVulkan env m, HasOutput output,
 UpdateCoherent bufs (GetOutput output)) =>
output -> ObserverIO bufs -> m ()
Observer.observeCoherent Merge Stores
spinnerP ObserverCoherent
spinner