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
  , lowTextFocus        :: Maybe SomeKeyInputWidget
  , lowVisibility       :: Bool
  , lowFloatingContent  :: Maybe SomeWidgetRef
  , lowDimensionDistribution :: Int -> [Double]
  }

instance Layout LayoutWidget where
  addWidget ref (coerce -> contentId) child =
    modifyWRef ref (\low -> low { lowContent = (lowContent low) |> (contentId, (SomeWidgetRef child)) })
  setTextFocus ref (coerce -> child) = do
    w <- readWRef ref
    case OMap.lookup child (lowContent w) of
      Nothing -> pure ()
      Just (SomeWidgetRef ti) ->
        withCapability (KeyInputCap ti) $
          modifyWRef ref (\low -> low { lowTextFocus = Just $ SomeKeyInputWidget ti })

instance KeyInput LayoutWidget where
  getCursorInfo _ = pure Nothing
  handleInput ref kv = do
    w <- readWRef ref
    case lowTextFocus w of
      Just (SomeKeyInputWidget tr) -> handleInput tr kv
      Nothing                       -> pure ()

instance Widget LayoutWidget where
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability (MoveableCap _)  = Just Dict
  hasCapability (KeyInputCap _) = 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
    case lowFloatingContent w of
      Just (SomeWidgetRef f) -> do
        withCapability (DrawableCap f) $ do
          draw f
      Nothing -> pure ()
    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])
  -> Maybe SomeKeyInputWidget
  -> m (WRef LayoutWidget)
layoutWidget ori distr tif = do
  newWRef $
    LayoutWidget
    { lowDim = Dimensions 0 0
    , lowPos = origin
    , lowContent = OMap.empty
    , lowOrientation = ori
    , lowTextFocus = tif
    , lowVisibility = True
    , lowFloatingContent = Nothing
    , lowDimensionDistribution = distr
    }