module Geomancy.Layout where import Geomancy import Geomancy.Layout.Alignment (Alignment, Origin) import Geomancy.Layout.Alignment qualified as Alignment import Geomancy.Layout.Box (Box(..), TRBL(..)) import Geomancy.Layout.Box qualified as Box -- import Debug.Trace type Offset = Float horizontal :: Either Offset Origin -> Box -> (Box, Box) horizontal = \case Left width -> if width >= 0 then cutLeft width else cutRight (-width) Right origin -> if origin >= 0 then splitLeft origin else splitRight (-origin) vertical :: Either Offset Origin -> Box -> (Box, Box) vertical = \case Left height -> if height >= 0 then cutTop height else cutBottom (-height) Right origin -> if origin >= 0 then splitTop origin else splitBottom (-origin) cutLeft :: Offset -> Box -> (Box, Box) cutLeft width parent = Box.withTRBL parent \t r b l -> let edge = l + width in ( Box.fromTRBL t edge b l , Box.fromTRBL t r b edge ) cutRight :: Offset -> Box -> (Box, Box) cutRight width parent = Box.withTRBL parent \t r b l -> let edge = r - width in ( Box.fromTRBL t edge b l , Box.fromTRBL t r b edge ) cutTop :: Offset -> Box -> (Box, Box) cutTop height parent = Box.withTRBL parent \t r b l -> let edge = t + height in ( Box.fromTRBL t r edge l , Box.fromTRBL edge r b l ) cutBottom :: Offset -> Box -> (Box, Box) cutBottom height parent = Box.withTRBL parent \t r b l -> let edge = b - height in ( Box.fromTRBL t r edge l , Box.fromTRBL edge r b l ) {-# INLINE splitLeft #-} splitLeft :: Origin -> Box -> (Box, Box) splitLeft origin parent = withVec2 parent.size \w _h -> cutLeft (w * origin) parent {-# INLINE splitRight #-} splitRight :: Origin -> Box -> (Box, Box) splitRight origin parent = withVec2 parent.size \w _h -> cutRight (w * origin) parent {-# INLINE splitTop #-} splitTop :: Origin -> Box -> (Box, Box) splitTop origin parent = withVec2 parent.size \_w h -> cutTop (h * origin) parent {-# INLINE splitBottom #-} splitBottom :: Origin -> Box -> (Box, Box) splitBottom origin parent = withVec2 parent.size \_w h -> cutBottom (h * origin) parent attachLeft :: Offset -> Box -> Box -> Box attachLeft offset parent box = withVec2 parent.position \px py -> withVec2 parent.size \pw _ph -> withVec2 box.size \w _h -> let pleft = px - pw * 0.5 right = pleft - offset in box { position = vec2 (right - w * 0.5) py } attachRight :: Offset -> Box -> Box -> Box attachRight offset parent box = withVec2 parent.position \px py -> withVec2 parent.size \pw _ph -> withVec2 box.size \w _h -> let pright = px + pw * 0.5 left = pright + offset in box { position = vec2 (left + w * 0.5) py } alignV :: Origin -> Box -> Box -> Box alignV origin parent box = withVec2 parent.position \_px py -> withVec2 parent.size \_pw ph -> withVec2 box.position \x _y -> withVec2 box.size \_w h -> let (before, after) = Alignment.placeSize1d origin h ph y' = py + before * 0.5 - after * 0.5 in box { position = vec2 x y' } attachTop :: Float -> Box -> Box -> Box attachTop offset parent box = withVec2 parent.position \px py -> withVec2 parent.size \_pw ph -> withVec2 box.size \_w h -> let ptop = py - ph * 0.5 bottom = ptop - offset in box { position = vec2 px (bottom - h * 0.5) } attachBottom :: Float -> Box -> Box -> Box attachBottom offset parent box = withVec2 parent.position \px py -> withVec2 parent.size \_pw ph -> withVec2 box.size \_w h -> let pbottom = py + ph * 0.5 top = pbottom + offset in box { position = vec2 px (top + h * 0.5) } alignH :: Origin -> Box -> Box -> Box alignH origin parent box = withVec2 parent.position \px _py -> withVec2 parent.size \pw _ph -> withVec2 box.position \_x y -> withVec2 box.size \w _h -> let (before, after) = Alignment.placeSize1d origin w pw x' = px + before * 0.5 - after * 0.5 in box { position = vec2 x' y } {-# INLINEABLE placeSize #-} placeSize :: Alignment -> Vec2 -> Box -> Box placeSize align size parent = withVec2 align \ah av -> withVec2 size \w h -> withVec2 parent.size \pw ph -> let (leftoversL, leftoversR) = Alignment.placeSize1d ah w pw (leftoversT, leftoversB) = Alignment.placeSize1d av h ph in Box.addPadding (TRBL $ vec4 leftoversT leftoversR leftoversB leftoversL) parent {-# INLINEABLE placeAspect #-} placeAspect :: Alignment -> Vec2 -> Box -> Box placeAspect align aspect parent = withVec2 aspect \aw ah -> withVec2 parent.size \pw ph -> let scale = if pw / ph > aw / ah then ph / ah else pw / aw in placeSize align (aspect ^* scale) parent