{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : FULE.Container.Window
-- Description : The @Window@ Container and layout construction functions.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- This module contains @Window@, the base 'FULE.Container.Conatiner' for all
-- layouts, and the @layout@ and @layoutM@ functions for building a
-- 'Fule.Laout.Layout' from it.
module FULE.Container.Window
 ( Window
 , WindowAdjustorGen
 , window
 , layoutM
 , layout
 ) where

import Control.Arrow
import Data.Functor.Identity
import Data.Proxy

import FULE.Component
import FULE.Container
import FULE.Layout
import FULE.LayoutOp


-- | Type of a function to produce a 'FULE.Component.Component' to adjust
--   the 'FULE.Layout.Layout' in response to a change in the size of the window
--   in the encompassing GUI framework. The @Component@ should use the Guides
--   passed as arguments to this function to update the @Layout@.
type WindowAdjustorGen k
  =  GuideID
  -- ^ The Guide to use to adjust the /width/ of the 'FULE.Layout' in response
  --   to a change in the window size. Adjustments should be made using the delta
  --   of the old and new sizes.
  -> GuideID
  -- ^ The Guide to use to adjust the /height/ of the 'FULE.Layout' in response
  --   to a change in the window size. Adjustments should be made using the delta
  --   of the old and new sizes.
  -> k

-- | The base container of any (non-custom) 'FULE.Layout.Layout' representing
--   the window in the encompassing GUI framework. It is the only container that
--   can be used with the 'layout' and 'layoutM' functions to build a @Layout@.
data Window c k
  = Window
    { forall c k. Window c k -> Int
widthOf :: Int
    , forall c k. Window c k -> Int
heightOf :: Int
    , forall c k. Window c k -> WindowAdjustorGen k
controlGenOf :: WindowAdjustorGen k
    , forall c k. Window c k -> c
contentsOf :: c
    }

-- | Create a 'Window'.
window
  :: (Int, Int) -- ^ The width and height of the window.
  -> WindowAdjustorGen k
  -- ^ A function to construct a 'FULE.Component.Component' for reacting to
  --   changes in the size of the window in the encompassing GUI framework.
  -> c -- ^ The content of the window.
  -> Window c k
window :: forall k c. (Int, Int) -> WindowAdjustorGen k -> c -> Window c k
window (Int
width, Int
height) = Int -> Int -> WindowAdjustorGen k -> c -> Window c k
forall c k. Int -> Int -> WindowAdjustorGen k -> c -> Window c k
Window (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
width) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
height)


-- | Build a layout for a 'Window' in the specified monad @m@.
layoutM :: (Container c k m) => Window c k -> m (Layout, [ComponentInfo k])
layoutM :: forall c k (m :: * -> *).
Container c k m =>
Window c k -> m (Layout, [ComponentInfo k])
layoutM = ((LayoutDesign -> Layout)
-> (LayoutDesign, [ComponentInfo k]) -> (Layout, [ComponentInfo k])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first LayoutDesign -> Layout
build ((LayoutDesign, [ComponentInfo k]) -> (Layout, [ComponentInfo k]))
-> m (LayoutDesign, [ComponentInfo k])
-> m (Layout, [ComponentInfo k])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (LayoutDesign, [ComponentInfo k])
 -> m (Layout, [ComponentInfo k]))
-> (Window c k -> m (LayoutDesign, [ComponentInfo k]))
-> Window c k
-> m (Layout, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k])
forall (m :: * -> *) k.
Monad m =>
LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k])
runLayoutOp (LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k]))
-> (Window c k -> LayoutOp k m ())
-> Window c k
-> m (LayoutDesign, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window c k -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
Window c k -> LayoutOp k m ()
makeLayoutOp

-- | Build a layout for a 'Window' in the 'Data.Functor.Identity.Identity' monad.
layout :: (Container c k Identity) => Window c k -> (Layout, [ComponentInfo k])
layout :: forall c k.
Container c k Identity =>
Window c k -> (Layout, [ComponentInfo k])
layout = (LayoutDesign -> Layout)
-> (LayoutDesign, [ComponentInfo k]) -> (Layout, [ComponentInfo k])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first LayoutDesign -> Layout
build ((LayoutDesign, [ComponentInfo k]) -> (Layout, [ComponentInfo k]))
-> (Window c k -> (LayoutDesign, [ComponentInfo k]))
-> Window c k
-> (Layout, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (LayoutDesign, [ComponentInfo k])
-> (LayoutDesign, [ComponentInfo k])
forall a. Identity a -> a
runIdentity (Identity (LayoutDesign, [ComponentInfo k])
 -> (LayoutDesign, [ComponentInfo k]))
-> (Window c k -> Identity (LayoutDesign, [ComponentInfo k]))
-> Window c k
-> (LayoutDesign, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOp k Identity ()
-> Identity (LayoutDesign, [ComponentInfo k])
forall (m :: * -> *) k.
Monad m =>
LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k])
runLayoutOp (LayoutOp k Identity ()
 -> Identity (LayoutDesign, [ComponentInfo k]))
-> (Window c k -> LayoutOp k Identity ())
-> Window c k
-> Identity (LayoutDesign, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window c k -> LayoutOp k Identity ()
forall c k (m :: * -> *).
Container c k m =>
Window c k -> LayoutOp k m ()
makeLayoutOp

makeLayoutOp :: (Container c k m) => Window c k -> LayoutOp k m ()
makeLayoutOp :: forall c k (m :: * -> *).
Container c k m =>
Window c k -> LayoutOp k m ()
makeLayoutOp (Window Int
w Int
h WindowAdjustorGen k
gen c
c) = do
  GuideID
top <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideSpecification
Absolute Int
0
  GuideID
left <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideSpecification
Absolute Int
0
  GuideID
right <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideSpecification
Absolute Int
w
  GuideID
bottom <- GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ Int -> GuideSpecification
Absolute Int
h
  let bounds :: Bounds
bounds = GuideID -> GuideID -> GuideID -> GuideID -> Maybe Bounds -> Bounds
Bounds GuideID
top GuideID
left GuideID
right GuideID
bottom Maybe Bounds
forall a. Maybe a
Nothing
  let proxy :: Proxy k
proxy = Proxy k
forall {k}. Proxy k
forall {k} (t :: k). Proxy t
Proxy :: Proxy k
  k -> Proxy k -> Bounds -> RenderGroup -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> RenderGroup -> LayoutOp k m ()
addToLayout (WindowAdjustorGen k
gen GuideID
right GuideID
bottom) Proxy k
forall {k}. Proxy k
proxy Bounds
bounds RenderGroup
forall a. Maybe a
Nothing
  c -> Proxy k -> Bounds -> RenderGroup -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> RenderGroup -> LayoutOp k m ()
addToLayout c
c Proxy k
forall {k}. Proxy k
proxy Bounds
bounds RenderGroup
forall a. Maybe a
Nothing