module UI.Widgets.Layout where 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 :: [SomeWidgetRef] , lowOrientation :: Orientation , lowVisibility :: Bool , lowFloatingContent :: [SomeWidgetRef] , lowDimensionDistribution :: [[Double]] } instance Layout LayoutWidget where addWidget ref child = modifyWRef ref (\low -> low { lowContent = (lowContent low) ++ [(SomeWidgetRef child)] }) addWidget' _ _ _ = undefined focusNext _ = undefined instance Widget LayoutWidget where hasCapability (DrawableCap _) = Just Dict hasCapability (MoveableCap _) = Just Dict hasCapability (LayoutCap _) = 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) (lowContent w) let itemCount = Prelude.length visibileItems dimensionDistribution = if itemCount < (Prelude.length (lowDimensionDistribution w)) then (lowDimensionDistribution w) !! itemCount else error ("Dimension distribution has too few items: " <> (show (itemCount, lowDimensionDistribution w))) 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 -> [[Double]] -> m (WRef LayoutWidget) layoutWidget ori distr = do newWRef $ LayoutWidget { lowDim = Dimensions 0 0 , lowPos = origin , lowContent = [] , lowOrientation = ori , lowVisibility = True , lowFloatingContent = [] , lowDimensionDistribution = distr }