module Engine.UI.Layout.Linear
( hBoxShares
, hBoxSplitRel
, vBoxShares
, vBoxSplitRel
, placeBox
, place
, ranges
, midpoints
) where
import RIO
import Data.Traversable (mapAccumL)
import Engine.UI.Layout qualified as Layout
import Geomancy (Vec2, vec2, withVec2, pattern WithVec2)
{-# INLINEABLE hBoxShares #-}
hBoxShares
:: Traversable t
=> t Float
-> Layout.Box
-> t Layout.Box
hBoxShares :: forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
hBoxShares t Float
items Box
parent = ((Float, Float) -> Box) -> t (Float, Float) -> t Box
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float) -> Box
mkBox t (Float, Float)
ranges'
where
mkBox :: (Float, Float) -> Box
mkBox (Float
left, Float
right) = Box :: Vec2 -> Vec2 -> Box
Layout.Box
{ $sel:boxPosition:Box :: Vec2
boxPosition =
Box -> Vec2
Layout.boxPosition Box
parent Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+
Float -> Float -> Vec2
vec2 (Float
midpoint Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
parentWidth Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) Float
0
, $sel:boxSize:Box :: Vec2
boxSize =
Float -> Float -> Vec2
vec2 (Float
size Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale) Float
parentHeight
}
where
size :: Float
size = Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
left
midpoint :: Float
midpoint = Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
(Float
final, t (Float, Float)
ranges') = t Float -> (Float, t (Float, Float))
forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
scale :: Float
scale = Float
parentWidth Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
final
WithVec2 Float
parentWidth Float
parentHeight = Box -> Vec2
Layout.boxSize Box
parent
{-# INLINEABLE hBoxSplitRel #-}
hBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)
hBoxSplitRel :: Float -> Box -> (Box, Box)
hBoxSplitRel Float
alpha Box
parent =
case forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
hBoxShares @[] [Float
alpha, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
[Box
left, Box
right] ->
(Box
left, Box
right)
[Box]
_ ->
[Char] -> (Box, Box)
forall a. HasCallStack => [Char] -> a
error [Char]
"requesting a pair"
{-# INLINEABLE vBoxShares #-}
vBoxShares
:: Traversable t
=> t Float
-> Layout.Box
-> t Layout.Box
vBoxShares :: forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
vBoxShares t Float
items Box
parent = ((Float, Float) -> Box) -> t (Float, Float) -> t Box
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, Float) -> Box
mkBox t (Float, Float)
ranges'
where
mkBox :: (Float, Float) -> Box
mkBox (Float
top, Float
bottom) = Box :: Vec2 -> Vec2 -> Box
Layout.Box
{ $sel:boxPosition:Box :: Vec2
boxPosition =
Box -> Vec2
Layout.boxPosition Box
parent Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
+
Float -> Float -> Vec2
vec2 Float
0 (Float
midpoint Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
parentHeight Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5)
, $sel:boxSize:Box :: Vec2
boxSize =
Float -> Float -> Vec2
vec2 Float
parentWidth (Float
size Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale)
}
where
size :: Float
size = Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
top
midpoint :: Float
midpoint = Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
(Float
final, t (Float, Float)
ranges') = t Float -> (Float, t (Float, Float))
forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
scale :: Float
scale = Float
parentHeight Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
final
WithVec2 Float
parentWidth Float
parentHeight = Box -> Vec2
Layout.boxSize Box
parent
{-# INLINEABLE vBoxSplitRel #-}
vBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)
vBoxSplitRel :: Float -> Box -> (Box, Box)
vBoxSplitRel Float
alpha Box
parent =
case forall (t :: * -> *). Traversable t => t Float -> Box -> t Box
vBoxShares @[] [Float
alpha, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
[Box
top, Box
bottom] ->
(Box
top, Box
bottom)
[Box]
_ ->
[Char] -> (Box, Box)
forall a. HasCallStack => [Char] -> a
error [Char]
"requesting a pair"
{-# INLINEABLE placeBox #-}
placeBox :: Vec2 -> Vec2 -> Layout.Box -> Layout.Box
placeBox :: Vec2 -> Vec2 -> Box -> Box
placeBox Vec2
alpha2 Vec2
size Box
parent =
Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
alpha2 \Float
ax Float
ay ->
Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxSize Box
parent) \Float
pw Float
ph ->
Vec2 -> (Float -> Float -> Box) -> Box
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxPosition Box
parent) \Float
px Float
py ->
let
x :: Float
x = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
left Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
right Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
y :: Float
y = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
top Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
bottom Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
(Float
left, Float
right) = Float -> Float -> Float -> (Float, Float)
forall b. Num b => b -> b -> b -> (b, b)
place Float
ax Float
w Float
pw
(Float
top, Float
bottom) = Float -> Float -> Float -> (Float, Float)
forall b. Num b => b -> b -> b -> (b, b)
place Float
ay Float
h Float
ph
in
Box :: Vec2 -> Vec2 -> Box
Layout.Box
{ $sel:boxPosition:Box :: Vec2
boxPosition = Float -> Float -> Vec2
vec2 Float
x Float
y
, $sel:boxSize:Box :: Vec2
boxSize = Vec2
size
}
{-# INLINE place #-}
place :: Num b => b -> b -> b -> (b, b)
place :: forall b. Num b => b -> b -> b -> (b, b)
place b
alpha b
size b
target =
( b
leftovers b -> b -> b
forall a. Num a => a -> a -> a
* b
alpha
, b
leftovers b -> b -> b
forall a. Num a => a -> a -> a
* (b
1 b -> b -> b
forall a. Num a => a -> a -> a
- b
alpha)
)
where
leftovers :: b
leftovers = b
target b -> b -> b
forall a. Num a => a -> a -> a
- b
size
{-# INLINE midpoints #-}
midpoints :: (Functor f, Fractional a) => f (a, a) -> f a
midpoints :: forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f (a, a) -> f a
midpoints =
((a, a) -> a) -> f (a, a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(a
begin, a
end) ->
a
begin a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
+ a
end a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5
{-# INLINE ranges #-}
ranges :: (Traversable t, Num a) => t a -> (a, t (a, a))
ranges :: forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges = (a -> a -> (a, (a, a))) -> a -> t a -> (a, t (a, a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL a -> a -> (a, (a, a))
forall {b}. Num b => b -> b -> (b, (b, b))
f a
0
where
f :: b -> b -> (b, (b, b))
f !b
begin b
size =
let
!end :: b
end = b
begin b -> b -> b
forall a. Num a => a -> a -> a
+ b
size
in
( b
end
, (b
begin, b
end)
)