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 :: [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 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]) -> 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 = [] , lowDimensionDistribution = distr }