module Engine.UI.Layout
  ( BoxProcess
  , Box(..)
  , trackScreen
  , padAbs
  , hSplitRel
  , vSplitRel

  , splitsRelStatic
  , sharePadsH
  , sharePadsV

  , boxPadAbs
  , sharePads

  , fitPlaceAbs
  , boxFitPlace
  , boxFitScale

  , boxRectAbs
  , boxTransformAbs

  , Alignment(..)
  , pattern LeftTop
  , pattern LeftMiddle
  , pattern LeftBottom
  , pattern CenterTop
  , pattern Center
  , pattern CenterBottom
  , pattern RightTop
  , pattern RightMiddle
  , pattern RightBottom
  , Origin(..)

  , whenInBoxP
  , pointInBox
  ) where

import RIO

import Data.Traversable (mapAccumL)
import Geomancy (Transform, Vec2, Vec4, vec2, vec4, withVec2, pattern WithVec2, pattern WithVec4)
import Geomancy.Transform qualified as Transform
import Geomancy.Vec4 qualified as Vec4
import RIO.App (App)
import UnliftIO.Resource (MonadResource)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Types qualified as Engine
import Engine.Worker qualified as Worker

data Box = Box
  { Box -> Vec2
boxPosition :: Vec2
  , Box -> Vec2
boxSize     :: Vec2
  }
  deriving (Box -> Box -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Box -> Box -> Bool
$c/= :: Box -> Box -> Bool
== :: Box -> Box -> Bool
$c== :: Box -> Box -> Bool
Eq, Eq Box
Box -> Box -> Bool
Box -> Box -> Ordering
Box -> Box -> Box
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Box -> Box -> Box
$cmin :: Box -> Box -> Box
max :: Box -> Box -> Box
$cmax :: Box -> Box -> Box
>= :: Box -> Box -> Bool
$c>= :: Box -> Box -> Bool
> :: Box -> Box -> Bool
$c> :: Box -> Box -> Bool
<= :: Box -> Box -> Bool
$c<= :: Box -> Box -> Bool
< :: Box -> Box -> Bool
$c< :: Box -> Box -> Bool
compare :: Box -> Box -> Ordering
$ccompare :: Box -> Box -> Ordering
Ord, Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Box] -> ShowS
$cshowList :: [Box] -> ShowS
show :: Box -> String
$cshow :: Box -> String
showsPrec :: Int -> Box -> ShowS
$cshowsPrec :: Int -> Box -> ShowS
Show)

data Alignment = Alignment
  { Alignment -> Origin
alignX :: Origin -- ^ left/center/right
  , Alignment -> Origin
alignY :: Origin -- ^ top/middle/bottom
  }

pattern LeftTop :: Alignment
pattern $bLeftTop :: Alignment
$mLeftTop :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
LeftTop = Alignment Begin  Begin

pattern LeftMiddle :: Alignment
pattern $bLeftMiddle :: Alignment
$mLeftMiddle :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
LeftMiddle = Alignment Begin Middle

pattern LeftBottom :: Alignment
pattern $bLeftBottom :: Alignment
$mLeftBottom :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
LeftBottom = Alignment Begin End

pattern CenterTop :: Alignment
pattern $bCenterTop :: Alignment
$mCenterTop :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
CenterTop = Alignment Middle Begin

pattern Center :: Alignment
pattern $bCenter :: Alignment
$mCenter :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
Center = Alignment Middle Middle

pattern CenterBottom :: Alignment
pattern $bCenterBottom :: Alignment
$mCenterBottom :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
CenterBottom = Alignment Middle End

pattern RightTop :: Alignment
pattern $bRightTop :: Alignment
$mRightTop :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
RightTop = Alignment End Begin

pattern RightMiddle :: Alignment
pattern $bRightMiddle :: Alignment
$mRightMiddle :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
RightMiddle = Alignment End Middle

pattern RightBottom :: Alignment
pattern $bRightBottom :: Alignment
$mRightBottom :: forall {r}. Alignment -> ((# #) -> r) -> ((# #) -> r) -> r
RightBottom = Alignment End End

data Origin
  = Begin
  | Middle
  | End
  deriving (Origin -> Origin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Eq Origin
Origin -> Origin -> Bool
Origin -> Origin -> Ordering
Origin -> Origin -> Origin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Origin -> Origin -> Origin
$cmin :: Origin -> Origin -> Origin
max :: Origin -> Origin -> Origin
$cmax :: Origin -> Origin -> Origin
>= :: Origin -> Origin -> Bool
$c>= :: Origin -> Origin -> Bool
> :: Origin -> Origin -> Bool
$c> :: Origin -> Origin -> Bool
<= :: Origin -> Origin -> Bool
$c<= :: Origin -> Origin -> Bool
< :: Origin -> Origin -> Bool
$c< :: Origin -> Origin -> Bool
compare :: Origin -> Origin -> Ordering
$ccompare :: Origin -> Origin -> Ordering
Ord, Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show, Int -> Origin
Origin -> Int
Origin -> [Origin]
Origin -> Origin
Origin -> Origin -> [Origin]
Origin -> Origin -> Origin -> [Origin]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Origin -> Origin -> Origin -> [Origin]
$cenumFromThenTo :: Origin -> Origin -> Origin -> [Origin]
enumFromTo :: Origin -> Origin -> [Origin]
$cenumFromTo :: Origin -> Origin -> [Origin]
enumFromThen :: Origin -> Origin -> [Origin]
$cenumFromThen :: Origin -> Origin -> [Origin]
enumFrom :: Origin -> [Origin]
$cenumFrom :: Origin -> [Origin]
fromEnum :: Origin -> Int
$cfromEnum :: Origin -> Int
toEnum :: Int -> Origin
$ctoEnum :: Int -> Origin
pred :: Origin -> Origin
$cpred :: Origin -> Origin
succ :: Origin -> Origin
$csucc :: Origin -> Origin
Enum, Origin
forall a. a -> a -> Bounded a
maxBound :: Origin
$cmaxBound :: Origin
minBound :: Origin
$cminBound :: Origin
Bounded)

type BoxProcess = Worker.Merge Box

trackScreen
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => m BoxProcess
trackScreen :: forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m BoxProcess
trackScreen = do
  Var Extent2D
screen <- forall st (m :: * -> *).
MonadReader (App GlobalHandles st) m =>
m (Var Extent2D)
Engine.askScreenVar
  forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 Extent2D -> Box
mkBox Var Extent2D
screen
  where
    mkBox :: Extent2D -> Box
mkBox Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = Box
      { $sel:boxPosition:Box :: Vec2
boxPosition = Vec2
0
      , $sel:boxSize:Box :: Vec2
boxSize     = Float -> Float -> Vec2
vec2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height)
      }

padAbs
  :: ( MonadResource m
     , MonadUnliftIO m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     , Worker.HasOutput padding
     , Worker.GetOutput padding ~ Vec4
     )
  => parent
  -> padding
  -> m BoxProcess
padAbs :: forall (m :: * -> *) parent padding.
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box, HasOutput padding,
 GetOutput padding ~ Vec4) =>
parent -> padding -> m BoxProcess
padAbs = 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 Box -> Vec4 -> Box
boxPadAbs

{-# INLINEABLE boxPadAbs #-}
boxPadAbs :: Box -> Vec4 -> Box
boxPadAbs :: Box -> Vec4 -> Box
boxPadAbs Box{Vec2
boxSize :: Vec2
boxPosition :: Vec2
$sel:boxSize:Box :: Box -> Vec2
$sel:boxPosition:Box :: Box -> Vec2
..} (WithVec4 Float
top Float
right Float
bottom Float
left) = Box
  { $sel:boxPosition:Box :: Vec2
boxPosition = Vec2
boxPosition forall a. Num a => a -> a -> a
+ Float -> Float -> Vec2
vec2 Float
dx Float
dy
  , $sel:boxSize:Box :: Vec2
boxSize     = Vec2
boxSize forall a. Num a => a -> a -> a
- Float -> Float -> Vec2
vec2 Float
dw Float
dh
  }
  where
    WithVec2 Float
w Float
h = Vec2
boxSize
    dx :: Float
dx = Float
left forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
right forall a. Num a => a -> a -> a
* Float
0.5
    dy :: Float
dy = Float
top forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
- Float
bottom forall a. Num a => a -> a -> a
* Float
0.5
    dw :: Float
dw = forall a. Ord a => a -> a -> a
min Float
w (Float
left forall a. Num a => a -> a -> a
+ Float
right)
    dh :: Float
dh = forall a. Ord a => a -> a -> a
min Float
h (Float
top forall a. Num a => a -> a -> a
+ Float
bottom)

padRel
  :: ( MonadResource m
     , MonadUnliftIO m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     , Worker.HasOutput padding
     , Worker.GetOutput padding ~ Vec4
     )
  => parent
  -> padding
  -> m BoxProcess
padRel :: forall (m :: * -> *) parent padding.
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box, HasOutput padding,
 GetOutput padding ~ Vec4) =>
parent -> padding -> m BoxProcess
padRel = 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 Box -> Vec4 -> Box
boxPadRel

{-# INLINEABLE boxPadRel #-}
boxPadRel :: Box -> Vec4 -> Box
boxPadRel :: Box -> Vec4 -> Box
boxPadRel box :: Box
box@Box{$sel:boxSize:Box :: Box -> Vec2
boxSize=WithVec2 Float
w Float
h} Vec4
pad =
  Box -> Vec4 -> Box
boxPadAbs Box
box (Vec4
pad forall a. Num a => a -> a -> a
* Float -> Float -> Float -> Float -> Vec4
vec4 Float
h Float
w Float
h Float
w)

fitPlaceAbs
  :: ( MonadResource m
     , MonadUnliftIO m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     )
  => Alignment
  -> "dimensions" ::: Vec2
  -> parent
  -> m BoxProcess
fitPlaceAbs :: forall (m :: * -> *) parent.
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box) =>
Alignment -> Vec2 -> parent -> m BoxProcess
fitPlaceAbs Alignment
align Vec2
dimensions =
  forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1
    (Alignment -> Vec2 -> Box -> Box
boxFitPlace Alignment
align Vec2
dimensions)

{-# INLINEABLE boxFitPlace #-}
boxFitPlace
  :: Alignment
  -> "dimensions" ::: Vec2
  -> "parent" ::: Box
  -> Box
boxFitPlace :: Alignment -> Vec2 -> Box -> Box
boxFitPlace Alignment{Origin
alignY :: Origin
alignX :: Origin
$sel:alignY:Alignment :: Alignment -> Origin
$sel:alignX:Alignment :: Alignment -> Origin
..} Vec2
wh Box
parent =
  Box -> Vec4 -> Box
boxPadAbs Box
parent (Float -> Float -> Float -> Float -> Vec4
vec4 Float
t Float
r Float
b Float
l)
  where
    (WithVec2 Float
dw Float
dh, Box
_box) = Vec2 -> Box -> (Vec2, Box)
boxFitScale Vec2
wh Box
parent

    (Float
l, Float
r) = case Origin
alignX of
      Origin
Begin  -> (Float
0,      Float
dw)
      Origin
Middle -> (Float
dw forall a. Fractional a => a -> a -> a
/ Float
2, Float
dw forall a. Fractional a => a -> a -> a
/ Float
2)
      Origin
End    -> (Float
dw,     Float
0)

    (Float
t, Float
b) = case Origin
alignY of
      Origin
Begin  -> (Float
0,      Float
dh)
      Origin
Middle -> (Float
dh forall a. Fractional a => a -> a -> a
/ Float
2, Float
dh forall a. Fractional a => a -> a -> a
/ Float
2)
      Origin
End    -> (Float
dh,     Float
0)

{-# INLINEABLE boxFitScale #-}
boxFitScale
  :: "dimensions" ::: Vec2
  -> "parent" ::: Box
  -> ( "leftovers" ::: Vec2
     , Box
     )
boxFitScale :: Vec2 -> Box -> (Vec2, Box)
boxFitScale (WithVec2 Float
w Float
h) Box
parent =
  ( Float -> Float -> Vec2
vec2 (Float
pw forall a. Num a => a -> a -> a
- Float
sw) (Float
ph forall a. Num a => a -> a -> a
- Float
sh)
  , Box
      { $sel:boxSize:Box :: Vec2
boxSize     = Float -> Float -> Vec2
vec2 Float
sw Float
sh
      , $sel:boxPosition:Box :: Vec2
boxPosition = Box -> Vec2
boxPosition Box
parent
      }
  )
  where
    Box{$sel:boxSize:Box :: Box -> Vec2
boxSize=WithVec2 Float
pw Float
ph} = Box
parent

    sw :: Float
sw = Float
scale forall a. Num a => a -> a -> a
* Float
w
    sh :: Float
sh = Float
scale forall a. Num a => a -> a -> a
* Float
h

    scale :: Float
scale =
      if Float
parentAspect forall a. Ord a => a -> a -> Bool
> Float
aspect then
        Float
ph forall a. Fractional a => a -> a -> a
/ Float
h
      else
        Float
pw forall a. Fractional a => a -> a -> a
/ Float
w
      where
        parentAspect :: Float
parentAspect = Float
pw forall a. Fractional a => a -> a -> a
/ Float
ph
        aspect :: Float
aspect = Float
w forall a. Fractional a => a -> a -> a
/ Float
h

splitsRelStatic
  :: ( MonadResource m
     , MonadUnliftIO m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     , Traversable t -- XXX: nested traversables may behave suprisingly
     )
  => ((Float, Float) -> Vec4)
  -> parent
  -> t Float
  -> m (t BoxProcess)
splitsRelStatic :: forall (m :: * -> *) parent (t :: * -> *).
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box, Traversable t) =>
((Float, Float) -> Vec4) -> parent -> t Float -> m (t BoxProcess)
splitsRelStatic (Float, Float) -> Vec4
padF parent
parentVar t Float
shares =
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall (t :: * -> *).
Traversable t =>
Float -> t Float -> t (Float, Float)
sharePads Float
totalShares t Float
shares) \(Float, Float)
pads -> do
    Var Vec4
shareVar <- forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar forall a b. (a -> b) -> a -> b
$ (Float, Float) -> Vec4
padF (Float, Float)
pads Vec4 -> Float -> Vec4
Vec4.^/ Float
totalShares
    forall (m :: * -> *) parent padding.
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box, HasOutput padding,
 GetOutput padding ~ Vec4) =>
parent -> padding -> m BoxProcess
padRel parent
parentVar Var Vec4
shareVar
  where
    totalShares :: Float
totalShares = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t Float
shares

sharePadsH :: (Float, Float) -> Vec4
sharePadsH :: (Float, Float) -> Vec4
sharePadsH (Float
left, Float
right) = Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
right Float
0 Float
left

sharePadsV :: (Float, Float) -> Vec4
sharePadsV :: (Float, Float) -> Vec4
sharePadsV (Float
top, Float
bottom) = Float -> Float -> Float -> Float -> Vec4
vec4 Float
top Float
0 Float
bottom Float
0

sharePads :: Traversable t => Float -> t Float -> t (Float, Float)
sharePads :: forall (t :: * -> *).
Traversable t =>
Float -> t Float -> t (Float, Float)
sharePads Float
totalShares t Float
shares = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Float -> Float -> (Float, (Float, Float))
f Float
0 t Float
shares
  where
    f :: Float -> Float -> (Float, (Float, Float))
f Float
sharesBefore Float
share =
      ( Float
sharesBefore forall a. Num a => a -> a -> a
+ Float
share
      , ( Float
sharesBefore
        , Float
totalShares forall a. Num a => a -> a -> a
- Float
sharesBefore forall a. Num a => a -> a -> a
- Float
share
        )
      )

hSplitRel
  :: ( MonadResource m
     , MonadUnliftIO m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     , Worker.HasOutput proportion
     , Worker.GetOutput proportion ~ Float
     )
  => parent
  -> proportion
  -> m (BoxProcess, BoxProcess)
hSplitRel :: forall (m :: * -> *) parent proportion.
(MonadResource m, MonadUnliftIO m, HasOutput parent,
 GetOutput parent ~ Box, HasOutput proportion,
 GetOutput proportion ~ Float) =>
parent -> proportion -> m (BoxProcess, BoxProcess)
hSplitRel parent
parentVar proportion
proportionVar = (,)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> parent -> proportion -> m BoxProcess
spawnLeft parent
parentVar proportion
proportionVar
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> parent -> proportion -> m BoxProcess
spawnRight parent
parentVar proportion
proportionVar
  where
    spawnLeft :: parent -> proportion -> m BoxProcess
spawnLeft = 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 parent
parent GetOutput proportion
proportion ->
      let
        rightWidth :: Float
rightWidth =
          forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
boxSize GetOutput parent
parent) \Float
width Float
_height ->
            Float
width forall a. Num a => a -> a -> a
- Float
width forall a. Num a => a -> a -> a
* GetOutput proportion
proportion
      in
        Box -> Vec4 -> Box
boxPadAbs GetOutput parent
parent (Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
rightWidth Float
0 Float
0)

    spawnRight :: parent -> proportion -> m BoxProcess
spawnRight = 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 parent
parent GetOutput proportion
proportion ->
      let
        leftWidth :: Float
leftWidth =
          forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
boxSize GetOutput parent
parent) \Float
width Float
_height ->
            Float
width forall a. Num a => a -> a -> a
* GetOutput proportion
proportion
      in
        Box -> Vec4 -> Box
boxPadAbs GetOutput parent
parent (Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
0 Float
0 Float
leftWidth)

vSplitRel
  :: ( MonadUnliftIO m
     , MonadResource m
     , Worker.HasOutput parent
     , Worker.GetOutput parent ~ Box
     , Worker.HasOutput proportion
     , Worker.GetOutput proportion ~ Float
     )
  => parent
  -> proportion
  -> m (BoxProcess, BoxProcess)
vSplitRel :: forall (m :: * -> *) parent proportion.
(MonadUnliftIO m, MonadResource m, HasOutput parent,
 GetOutput parent ~ Box, HasOutput proportion,
 GetOutput proportion ~ Float) =>
parent -> proportion -> m (BoxProcess, BoxProcess)
vSplitRel parent
parentVar proportion
proportionVar = (,)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> parent -> proportion -> m BoxProcess
spawnTop parent
parentVar proportion
proportionVar
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> parent -> proportion -> m BoxProcess
spawnBottom parent
parentVar proportion
proportionVar
  where
    spawnTop :: parent -> proportion -> m BoxProcess
spawnTop = 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 parent
parent GetOutput proportion
proportion ->
      let
        bottomHeight :: Float
bottomHeight =
          forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
boxSize GetOutput parent
parent) \Float
_width Float
height ->
            Float
height forall a. Num a => a -> a -> a
- Float
height forall a. Num a => a -> a -> a
* GetOutput proportion
proportion
      in
        Box -> Vec4 -> Box
boxPadAbs GetOutput parent
parent (Float -> Float -> Float -> Float -> Vec4
vec4 Float
0 Float
0 Float
bottomHeight Float
0)

    spawnBottom :: parent -> proportion -> m BoxProcess
spawnBottom = 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 parent
parent GetOutput proportion
proportion ->
      let
        topHeight :: Float
topHeight =
          forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
boxSize GetOutput parent
parent) \Float
_width Float
height ->
            Float
height forall a. Num a => a -> a -> a
* GetOutput proportion
proportion
      in
        Box -> Vec4 -> Box
boxPadAbs GetOutput parent
parent (Float -> Float -> Float -> Float -> Vec4
vec4 Float
topHeight Float
0 Float
0 Float
0)

{-# INLINEABLE boxRectAbs #-}
boxRectAbs :: Box -> Vk.Rect2D
boxRectAbs :: Box -> Rect2D
boxRectAbs Box{Vec2
boxSize :: Vec2
boxPosition :: Vec2
$sel:boxSize:Box :: Box -> Vec2
$sel:boxPosition:Box :: Box -> Vec2
..} =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
boxPosition \Float
x Float
y ->
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
boxSize \Float
w Float
h ->
    let
      r :: Rect2D
r = Vk.Rect2D
        { $sel:offset:Rect2D :: Offset2D
offset = Int32 -> Int32 -> Offset2D
Vk.Offset2D (forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Float
x) (forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Float
y) -- FIXME: rects have top-left origin
        , $sel:extent:Rect2D :: Extent2D
extent = Word32 -> Word32 -> Extent2D
Vk.Extent2D (forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
w) (forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
h)
        }
    in
      -- traceShow (Box{..}, r)
      Rect2D
r

{-# INLINEABLE boxTransformAbs #-}
boxTransformAbs :: Box -> Transform
boxTransformAbs :: Box -> Transform
boxTransformAbs Box{Vec2
boxSize :: Vec2
boxPosition :: Vec2
$sel:boxSize:Box :: Box -> Vec2
$sel:boxPosition:Box :: Box -> Vec2
..} = forall a. Monoid a => [a] -> a
mconcat
  [ forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
boxSize Float -> Float -> Transform
Transform.scaleXY
  , forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
boxPosition Float -> Float -> Transform
translateXY
  ]

{-# INLINE translateXY #-}
translateXY :: Float -> Float -> Transform
translateXY :: Float -> Float -> Transform
translateXY Float
x Float
y = Float -> Float -> Float -> Transform
Transform.translate Float
x Float
y Float
0

whenInBoxP
  :: ( MonadIO m
     , Worker.HasOutput box
     , Worker.GetOutput box ~ Box
     )
  => "screen" ::: Vec2
  -> box
  -> ("local" ::: Vec2 -> m ())
  -> m ()
whenInBoxP :: forall (m :: * -> *) box.
(MonadIO m, HasOutput box, GetOutput box ~ Box) =>
Vec2 -> box -> (Vec2 -> m ()) -> m ()
whenInBoxP Vec2
cursorPos box
boxP Vec2 -> m ()
action = do
  Box
box <- forall worker (m :: * -> *).
(HasOutput worker, MonadIO m) =>
worker -> m (GetOutput worker)
Worker.getOutputData box
boxP
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Vec2 -> Box -> Bool
pointInBox Vec2
cursorPos Box
box) forall a b. (a -> b) -> a -> b
$
    Vec2 -> m ()
action forall a b. (a -> b) -> a -> b
$ Vec2
cursorPos forall a. Num a => a -> a -> a
- Box -> Vec2
boxPosition Box
box

pointInBox :: Vec2 -> Box -> Bool
pointInBox :: Vec2 -> Box -> Bool
pointInBox Vec2
point Box{Vec2
boxSize :: Vec2
boxPosition :: Vec2
$sel:boxSize:Box :: Box -> Vec2
$sel:boxPosition:Box :: Box -> Vec2
..} =
  forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2
point forall a. Num a => a -> a -> a
- Vec2
boxPosition) \Float
px Float
py ->
    forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Vec2
boxSize forall a. Fractional a => a -> a -> a
/ Vec2
2) \Float
hw Float
hh ->
      Float
px forall a. Ord a => a -> a -> Bool
> -Float
hw Bool -> Bool -> Bool
&& Float
px forall a. Ord a => a -> a -> Bool
< Float
hw Bool -> Bool -> Bool
&&
      Float
py forall a. Ord a => a -> a -> Bool
> -Float
hh Bool -> Bool -> Bool
&& Float
py forall a. Ord a => a -> a -> Bool
< Float
hh