Layout.hs

module UI.Widgets.Layout where

import Data.Coerce
import Data.Map.Ordered as OMap
import Data.Maybe

import Common
import UI.Widgets.Common

data Orientation
  = Vertical
  | Horizontal

newtype ContentId = ContentId Text
  deriving (Show, Ord, Eq)

data LayoutWidget = LayoutWidget
  { lowDim              :: Dimensions
  , lowPos              :: ScreenPos
  , lowContent          :: OMap ContentId SomeWidgetRef
  , lowOrientation      :: Orientation
  , lowVisibility       :: Bool
  , lowFloatingContent  :: [SomeWidgetRef]
  , lowDimensionDistribution :: Int -> [Double]
  }

instance Layout LayoutWidget where
  addWidget ref (coerce -> contentId) child =
    modifyWRef ref (\low -> low { lowContent = (lowContent low) |> (contentId, (SomeWidgetRef child)) })

instance Widget LayoutWidget where
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability (MoveableCap _)  = Just Dict
  hasCapability _                = Nothing

instance Moveable LayoutWidget where
  getPos ref = lowPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\low -> low { lowPos = pos })
  getDim ref =
    lowDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\low -> low { lowDim = cb $ lowDim low })

instance Drawable LayoutWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { lowVisibility = v })
  getVisibility ref = lowVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    let
      dimension = case lowOrientation w of
        Vertical   -> (diH $ lowDim w)
        Horizontal -> (diW $ lowDim w)
    visibileItems <- catMaybes <$> mapM (\(sw@(SomeWidgetRef cw)) -> case hasCapability (DrawableCap cw) of
      Just Dict -> do
        b <- getVisibility cw
        case b of
          True -> pure $ Just sw
          _    -> pure Nothing
      Nothing -> pure Nothing) (snd <$> (OMap.assocs $ lowContent w))

    let
      itemCount = Prelude.length visibileItems
      dimensionDistribution = lowDimensionDistribution w itemCount
      resizeCallback d = case lowOrientation w of
        Vertical -> (\dm -> dm { diW = diW $ lowDim w , diH = d})
        Horizontal -> (\dm -> dm { diH = diH $ lowDim w, diW = d })

    foldM_ (\totalDim (idx, (fraction, (SomeWidgetRef cw))) ->
      withCapability (MoveableCap cw) $ do
        let thisDim' =
              if (idx == itemCount) then (dimension - totalDim) else round $ (realToFrac dimension) * fraction
        let thisDim =  max thisDim' 3
        resize cw (resizeCallback thisDim)
        pure (totalDim + thisDim)
        ) 0 (Prelude.zip [1..] (Prelude.zip dimensionDistribution visibileItems))

    case (lowOrientation w) of
      Vertical   -> foldM_ (fny (sX $ lowPos w)) (sY $ lowPos w) visibileItems
      Horizontal -> foldM_ (fn (sY $ lowPos w)) (sX $ lowPos w) visibileItems
    flip mapM_ (lowFloatingContent w) $ \(SomeWidgetRef f) -> do
      withCapability (DrawableCap f) $ draw f
    where
      fny x y w = case w of
        SomeWidgetRef a ->
          withCapability (MoveableCap a) $
            withCapability (DrawableCap a) $ do
              dim <- getDim a
              move a (ScreenPos { sY = y, sX = x })
              draw a
              pure (y + (diH dim))
      fn y x w = case w of
        SomeWidgetRef a ->
          withCapability (MoveableCap a) $
            withCapability (DrawableCap a) $ do
              dim <- getDim a
              move a (ScreenPos { sY = y, sX = x })
              draw a
              pure (x + (diW dim))

layoutWidget
  :: WidgetC m
  => Orientation
  -> (Int -> [Double])
  -> m (WRef LayoutWidget)
layoutWidget ori distr = do
  newWRef $
    LayoutWidget
    { lowDim = Dimensions 0 0
    , lowPos = origin
    , lowContent = OMap.empty
    , lowOrientation = ori
    , lowVisibility = True
    , lowFloatingContent = []
    , lowDimensionDistribution = distr
    }