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 = 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) = Layout.Box
{ $sel:boxPosition:Box :: Vec2
boxPosition =
Box -> Vec2
Layout.boxPosition Box
parent forall a. Num a => a -> a -> a
+
Float -> Float -> Vec2
vec2 (Float
midpoint forall a. Num a => a -> a -> a
* Float
scale forall a. Num a => a -> a -> a
- Float
parentWidth forall a. Num a => a -> a -> a
* Float
0.5) Float
0
, $sel:boxSize:Box :: Vec2
boxSize =
Float -> Float -> Vec2
vec2 (Float
size forall a. Num a => a -> a -> a
* Float
scale) Float
parentHeight
}
where
size :: Float
size = Float
right forall a. Num a => a -> a -> a
- Float
left
midpoint :: Float
midpoint = Float
right forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
left forall a. Num a => a -> a -> a
* Float
0.5
(Float
final, t (Float, Float)
ranges') = forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
scale :: Float
scale = Float
parentWidth 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 forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
[Box
left, Box
right] ->
(Box
left, Box
right)
[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 = 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) = Layout.Box
{ $sel:boxPosition:Box :: Vec2
boxPosition =
Box -> Vec2
Layout.boxPosition Box
parent forall a. Num a => a -> a -> a
+
Float -> Float -> Vec2
vec2 Float
0 (Float
midpoint forall a. Num a => a -> a -> a
* Float
scale forall a. Num a => a -> a -> a
- Float
parentHeight forall a. Num a => a -> a -> a
* Float
0.5)
, $sel:boxSize:Box :: Vec2
boxSize =
Float -> Float -> Vec2
vec2 Float
parentWidth (Float
size forall a. Num a => a -> a -> a
* Float
scale)
}
where
size :: Float
size = Float
bottom forall a. Num a => a -> a -> a
- Float
top
midpoint :: Float
midpoint = Float
bottom forall a. Num a => a -> a -> a
* Float
0.5 forall a. Num a => a -> a -> a
+ Float
top forall a. Num a => a -> a -> a
* Float
0.5
(Float
final, t (Float, Float)
ranges') = forall (t :: * -> *) a.
(Traversable t, Num a) =>
t a -> (a, t (a, a))
ranges t Float
items
scale :: Float
scale = Float
parentHeight 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 forall a. Num a => a -> a -> a
- Float
alpha] Box
parent of
[Box
top, Box
bottom] ->
(Box
top, Box
bottom)
[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 =
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
alpha2 \Float
ax Float
ay ->
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 Vec2
size \Float
w Float
h ->
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxSize Box
parent) \Float
pw Float
ph ->
forall r. Vec2 -> (Float -> Float -> r) -> r
withVec2 (Box -> Vec2
Layout.boxPosition Box
parent) \Float
px Float
py ->
let
x :: Float
x = Float
px forall a. Num a => a -> a -> a
+ 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
y :: Float
y = Float
py forall a. Num a => a -> a -> a
+ 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
(Float
left, Float
right) = forall b. Num b => b -> b -> b -> (b, b)
place Float
ax Float
w Float
pw
(Float
top, Float
bottom) = forall b. Num b => b -> b -> b -> (b, b)
place Float
ay Float
h Float
ph
in
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 forall a. Num a => a -> a -> a
* b
alpha
, b
leftovers forall a. Num a => a -> a -> a
* (b
1 forall a. Num a => a -> a -> a
- b
alpha)
)
where
leftovers :: b
leftovers = b
target 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(a
begin, a
end) ->
a
begin forall a. Num a => a -> a -> a
* a
0.5 forall a. Num a => a -> a -> a
+ a
end 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 = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL 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 forall a. Num a => a -> a -> a
+ b
size
in
( b
end
, (b
begin, b
end)
)