module UI.Widgets.Spade.Layout where import Data.Maybe import Data.List (sortBy) import Common import UI.Widgets.Common data Orientation = Vertical | Horizontal deriving Show newtype ContentId = ContentId Text deriving (Show, Ord, Eq) data LayoutWidget = LayoutWidget { lowDim :: Dimensions , lowPos :: ScreenPos , lowContent :: [StackedWidget] , lowOrientation :: Orientation , lowVisibility :: Bool , lowFloatingContent :: [SomeWidgetRef] , lowDimensionDistribution :: [[Double]] , lowFocusWidget :: Maybe (Int, SomeWidgetRef) , lowFocused :: Bool , lowResizeChildren :: Bool } instance Focusable LayoutWidget where getFocus ref = lowFocused <$> readWRef ref setFocus ref b = do modifyWRef ref (\w' -> w' { lowFocused = b }) w <- readWRef ref case lowFocusWidget w of Just (_, SomeWidgetRef elm) -> do withCapability (FocusableCap elm) $ setFocus elm b Nothing -> void $ setFocusAt ref 0 1 True instance KeyInput LayoutWidget where getCursorInfo _ = pure Nothing handleInput ref keyEvent = do case keyEvent of KeyCtrl _ False _ Tab -> void $ focusNext ref 1 KeyCtrl _ True _ Tab -> void $ focusNext ref (-1) _ -> do w <- readWRef ref case lowFocusWidget w of Just (_, (SomeWidgetRef r)) -> case hasCapability (KeyInputCap r) of Just Dict -> handleInput r keyEvent Nothing -> pass Nothing -> pass computeDim :: forall m. WidgetC m => Dimensions -> Orientation -> Bool -> [StackedWidget] -> m Dimensions computeDim dim _ True _ = pure dim computeDim _ _ False [] = pure $ Dimensions 0 0 computeDim _ ori False children = do dimensions <- mapM getChildDimension children let heights = diH <$> dimensions let widths = diW <$> dimensions case ori of Vertical -> pure $ Dimensions (Prelude.maximum widths) (sum heights) Horizontal -> do pure $ Dimensions (sum widths) (Prelude.maximum heights) where getChildDimension :: StackedWidget -> m Dimensions getChildDimension (StackedWidget _ (SomeWidgetRef ref)) = withCapability (MoveableCap ref) $ getDim ref instance Layout LayoutWidget where addWidget' ref so child = modifyWRefM ref (\low -> do let newContent = (lowContent low) ++ [(StackedWidget so (SomeWidgetRef child))] pure low { lowContent = newContent }) focusNext ref d = do w <- readWRef ref case lowFocusWidget w of Just (cidx, (SomeWidgetRef cref)) -> do case hasCapability (LayoutCap cref) of Nothing -> do setFocusAt ref (cidx + d) d True >>= \case True -> setFocusAt ref cidx d False _ -> pure False Just Dict -> do focusNext cref d >>= \case True -> pure True False -> do setFocusAt ref (cidx + d) d True >>= \case True -> setFocusAt ref cidx d False _ -> pure False Nothing -> pure False setFocusAt :: WidgetC m => WRef LayoutWidget -> Int -> Int -> Bool -> m Bool setFocusAt ref idx dir b = do w <- readWRef ref let cSize = Prelude.length (lowContent w) if idx >= 0 && idx < cSize then do case (lowContent w) !! idx of (StackedWidget _ (SomeWidgetRef c)) -> do r <- case hasCapability (FocusableCap c) of Just Dict -> do setFocus c b if b then modifyWRef ref (\w' -> w' { lowFocusWidget = Just (idx, SomeWidgetRef c) }) else pass case hasCapability (KeyInputCap c) of Just Dict -> do modifyWidgetState (\ws -> ws { wsCursorVisible = True, wsCursorWidget = Just (SomeKeyInputWidget c) }) _ -> pass pure True Nothing -> do setFocusAt ref (idx + dir) dir b pure r else pure False instance Widget LayoutWidget where hasCapability (DrawableCap _) = Just Dict hasCapability (MoveableCap _) = Just Dict hasCapability (LayoutCap _) = Just Dict hasCapability (FocusableCap _) = 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 = do low <- readWRef ref computeDim (lowDim low) (lowOrientation low) (lowResizeChildren low) (lowContent low) 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@(StackedWidget _ (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) (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 }) if (lowResizeChildren w) then do foldM_ (\totalDim (idx, (fraction, StackedWidget _ (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)) else do let resizeCallback' = case lowOrientation w of Vertical -> (\dm -> dm { diW = diW $ lowDim w }) Horizontal -> (\dm -> dm { diH = diH $ lowDim w }) mapM_ (\(StackedWidget _ (SomeWidgetRef cw)) -> withCapability (MoveableCap cw) $ resize cw resizeCallback') (lowContent w) case (lowOrientation w) of Vertical -> foldM_ (fny (sX $ lowPos w)) (sY $ lowPos w) $ swSw <$> visibileItems Horizontal -> foldM_ (fn (sY $ lowPos w)) (sX $ lowPos w) $ swSw <$> visibileItems mapM_ (\(SomeWidgetRef a) -> withCapability (DrawableCap a) $ draw a) $ sortBySo visibileItems flip mapM_ (lowFloatingContent w) $ \(SomeWidgetRef f) -> do withCapability (DrawableCap f) $ draw f where sortBySo :: [StackedWidget] -> [SomeWidgetRef] sortBySo ws = swSw <$> (sortBy (\a b -> compare (swSo a) (swSo b)) ws) fny x y w = case w of SomeWidgetRef a -> withCapability (MoveableCap a) $ do dim <- getDim a move a (ScreenPos { sY = y, sX = x }) pure (y + (diH dim)) fn y x w = case w of SomeWidgetRef a -> withCapability (MoveableCap a) $ do dim <- getDim a move a (ScreenPos { sY = y, sX = x }) pure (x + (diW dim)) layoutWidget :: WidgetC m => Orientation -> [[Double]] -> [SomeWidgetRef] -> m (WRef LayoutWidget) layoutWidget ori distr children = do newWRef $ LayoutWidget { lowDim = Dimensions 1 1 , lowPos = origin , lowContent = (\c -> StackedWidget 0 c) <$> children , lowOrientation = ori , lowVisibility = True , lowFloatingContent = [] , lowDimensionDistribution = distr , lowFocusWidget = Nothing , lowFocused = False , lowResizeChildren = True } simpleLayoutWidget :: WidgetC m => Orientation -> [SomeWidgetRef] -> m (WRef LayoutWidget) simpleLayoutWidget ori children = do newWRef $ LayoutWidget { lowDim = Dimensions 1 1 , lowPos = origin , lowContent = (\c -> StackedWidget 0 c) <$> children , lowOrientation = ori , lowVisibility = True , lowFloatingContent = [] , lowDimensionDistribution = [] , lowFocusWidget = Nothing , lowFocused = False , lowResizeChildren = False }