mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-21 00:38:01 +03:00
Make _widgetPreferredSize pure
This commit is contained in:
parent
fc0529041d
commit
ef82909d27
@ -169,7 +169,7 @@ drawText_ :: (Monad m) => Renderer m -> Rect -> Maybe TextStyle -> T.Text -> m (
|
|||||||
drawText_ renderer viewport style txt = do
|
drawText_ renderer viewport style txt = do
|
||||||
void $ drawText renderer viewport style txt
|
void $ drawText renderer viewport style txt
|
||||||
|
|
||||||
calcTextBounds :: (Monad m) => Renderer m -> Maybe TextStyle -> T.Text -> m Size
|
calcTextBounds :: (Monad m) => Renderer m -> Maybe TextStyle -> T.Text -> Size
|
||||||
calcTextBounds renderer Nothing txt = calcTextBounds renderer (Just mempty) txt
|
calcTextBounds renderer Nothing txt = calcTextBounds renderer (Just mempty) txt
|
||||||
calcTextBounds renderer (Just TextStyle{..}) txt =
|
calcTextBounds renderer (Just TextStyle{..}) txt =
|
||||||
let
|
let
|
||||||
|
@ -5,6 +5,7 @@ module Monomer.Graphics.NanoVGRenderer (makeRenderer) where
|
|||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Data.Default
|
import Data.Default
|
||||||
|
import System.IO.Unsafe
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified NanoVG as VG
|
import qualified NanoVG as VG
|
||||||
@ -114,8 +115,8 @@ makeRenderer c dpr = Renderer {..} where
|
|||||||
|
|
||||||
return $ Rect (tx / dpr) ((ty - realToFrac asc) / dpr) (realToFrac tw / dpr) (realToFrac th / dpr)
|
return $ Rect (tx / dpr) ((ty - realToFrac asc) / dpr) (realToFrac tw / dpr) (realToFrac th / dpr)
|
||||||
|
|
||||||
textBounds _ _ "" = return def
|
textBounds _ _ "" = def
|
||||||
textBounds font fontSize message = do
|
textBounds font fontSize message = unsafePerformIO $ do
|
||||||
liftIO $ VG.fontFace c font
|
liftIO $ VG.fontFace c font
|
||||||
liftIO $ VG.fontSize c $ realToFrac $ fontSize
|
liftIO $ VG.fontSize c $ realToFrac $ fontSize
|
||||||
VG.Bounds (VG.V4 x1 y1 x2 y2) <- liftIO $ VG.textBounds c 0 0 message
|
VG.Bounds (VG.V4 x1 y1 x2 y2) <- liftIO $ VG.textBounds c 0 0 message
|
||||||
|
@ -39,6 +39,6 @@ data Renderer m = (Monad m) => Renderer {
|
|||||||
quadTo :: Point -> Point -> m (),
|
quadTo :: Point -> Point -> m (),
|
||||||
ellipse :: Rect -> m (),
|
ellipse :: Rect -> m (),
|
||||||
-- Text
|
-- Text
|
||||||
text :: Rect -> Font -> FontSize -> Align -> T.Text -> m (Rect),
|
text :: Rect -> Font -> FontSize -> Align -> T.Text -> m Rect,
|
||||||
textBounds :: Font -> FontSize -> T.Text -> m Size
|
textBounds :: Font -> FontSize -> T.Text -> Size
|
||||||
}
|
}
|
||||||
|
@ -7,6 +7,7 @@ import Control.Concurrent (threadDelay)
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Extra
|
import Control.Monad.Extra
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.State
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Sequence (Seq(..), (<|), (|>), (><))
|
import Data.Sequence (Seq(..), (<|), (|>), (><))
|
||||||
import Lens.Micro.Mtl
|
import Lens.Micro.Mtl
|
||||||
@ -48,11 +49,10 @@ runWidgets window c mapp = do
|
|||||||
|
|
||||||
windowSize .= newWindowSize
|
windowSize .= newWindowSize
|
||||||
ticks <- SDL.ticks
|
ticks <- SDL.ticks
|
||||||
widgetRoot <- doInDrawingContext window c $ updateUI renderer mapp empty
|
ctx <- get
|
||||||
|
let widgetRoot = updateUI renderer mapp ctx empty
|
||||||
|
|
||||||
let newFocus = findNextFocusable rootPath widgetRoot
|
focused .= findNextFocusable rootPath widgetRoot
|
||||||
|
|
||||||
focused .= newFocus
|
|
||||||
|
|
||||||
mainLoop window c renderer mapp (fromIntegral ticks) 0 0 widgetRoot
|
mainLoop window c renderer mapp (fromIntegral ticks) 0 0 widgetRoot
|
||||||
|
|
||||||
@ -86,9 +86,12 @@ mainLoop window c renderer mapp !prevTicks !tsAccum !frames widgets = do
|
|||||||
(seApp, seAppEvents, seWidgets) <- handleSystemEvents renderer mapp currentApp systemEvents wTasksWidgets
|
(seApp, seAppEvents, seWidgets) <- handleSystemEvents renderer mapp currentApp systemEvents wTasksWidgets
|
||||||
|
|
||||||
newApp <- handleAppEvents mapp seApp (seAppEvents >< (Seq.fromList uTasksEvents) >< wTasksEvents)
|
newApp <- handleAppEvents mapp seApp (seAppEvents >< (Seq.fromList uTasksEvents) >< wTasksEvents)
|
||||||
|
mctx <- get
|
||||||
|
|
||||||
newWidgets <- bindIf (currentApp /= newApp) (updateUI renderer mapp) seWidgets
|
let updatedWidgets = if currentApp /= newApp
|
||||||
>>= bindIf (resized || wTasksResize) (resizeWindow window renderer newApp)
|
then updateUI renderer mapp mctx seWidgets
|
||||||
|
else seWidgets
|
||||||
|
newWidgets <- return updatedWidgets >>= bindIf (resized || wTasksResize) (resizeWindow window renderer newApp)
|
||||||
|
|
||||||
currentFocus <- use focused
|
currentFocus <- use focused
|
||||||
renderWidgets window c renderer (PathContext currentFocus rootPath rootPath) newApp newWidgets startTicks
|
renderWidgets window c renderer (PathContext currentFocus rootPath rootPath) newApp newWidgets startTicks
|
||||||
@ -103,6 +106,7 @@ mainLoop window c renderer mapp !prevTicks !tsAccum !frames widgets = do
|
|||||||
liftIO $ threadDelay nextFrameDelay
|
liftIO $ threadDelay nextFrameDelay
|
||||||
unless quit (mainLoop window c renderer mapp startTicks newTsAccum newFrameCount newWidgets)
|
unless quit (mainLoop window c renderer mapp startTicks newTsAccum newFrameCount newWidgets)
|
||||||
|
|
||||||
|
|
||||||
handleAppEvents :: (MonomerM s e m) => MonomerApp s e m -> s -> Seq e -> m s
|
handleAppEvents :: (MonomerM s e m) => MonomerApp s e m -> s -> Seq e -> m s
|
||||||
handleAppEvents mapp app events = do
|
handleAppEvents mapp app events = do
|
||||||
let (newApp, tasks) = reduceAppEvents (_appEventHandler mapp) app events
|
let (newApp, tasks) = reduceAppEvents (_appEventHandler mapp) app events
|
||||||
@ -124,33 +128,29 @@ renderWidgets !window !c !renderer ctx app widgetRoot ticks =
|
|||||||
doInDrawingContext window c $ do
|
doInDrawingContext window c $ do
|
||||||
_widgetRender (_instanceWidget widgetRoot) renderer ticks ctx app widgetRoot
|
_widgetRender (_instanceWidget widgetRoot) renderer ticks ctx app widgetRoot
|
||||||
|
|
||||||
resizeUI :: (Monad m) => Renderer m -> s -> Rect -> WidgetInstance s e m -> m (WidgetInstance s e m)
|
resizeUI :: (Monad m) => Renderer m -> s -> Rect -> WidgetInstance s e m -> WidgetInstance s e m
|
||||||
resizeUI renderer app assignedRect widgetRoot = do
|
resizeUI renderer app assignedRect widgetRoot = newWidgetRoot where
|
||||||
preferredSizes <- _widgetPreferredSize (_instanceWidget widgetRoot) renderer app widgetRoot
|
widget = _instanceWidget widgetRoot
|
||||||
|
preferredSizes = _widgetPreferredSize widget renderer app widgetRoot
|
||||||
|
newWidgetRoot = _widgetResize widget app assignedRect assignedRect widgetRoot preferredSizes
|
||||||
|
|
||||||
return $ _widgetResize (_instanceWidget widgetRoot) app assignedRect assignedRect widgetRoot preferredSizes
|
updateUI :: (MonomerM s e m) => Renderer m -> MonomerApp s e m -> MonomerContext s e -> WidgetInstance s e m -> WidgetInstance s e m
|
||||||
|
updateUI renderer mapp mctx oldWidgets = resizeUI renderer app windowSize mergedRoot where
|
||||||
updateUI :: (MonomerM s e m) => Renderer m -> MonomerApp s e m -> WidgetInstance s e m -> m (WidgetInstance s e m)
|
app = _appContext mctx
|
||||||
updateUI renderer mapp oldWidgets = do
|
windowSize = _windowSize mctx
|
||||||
windowSize <- use windowSize
|
newWidgets = _uiBuilder mapp app
|
||||||
app <- use appContext
|
mergedRoot = _widgetMerge (_instanceWidget newWidgets) app newWidgets oldWidgets
|
||||||
|
|
||||||
let newWidgets = _uiBuilder mapp app
|
|
||||||
let mergedRoot = _widgetMerge (_instanceWidget newWidgets) app newWidgets oldWidgets
|
|
||||||
|
|
||||||
resizeUI renderer app windowSize mergedRoot
|
|
||||||
|
|
||||||
resizeWindow :: (MonomerM s e m) => SDL.Window -> Renderer m -> s -> WidgetInstance s e m -> m (WidgetInstance s e m)
|
resizeWindow :: (MonomerM s e m) => SDL.Window -> Renderer m -> s -> WidgetInstance s e m -> m (WidgetInstance s e m)
|
||||||
resizeWindow window renderer app widgetRoot = do
|
resizeWindow window renderer app widgetRoot = do
|
||||||
dpr <- use devicePixelRate
|
dpr <- use devicePixelRate
|
||||||
drawableSize <- getDrawableSize window
|
drawableSize <- getDrawableSize window
|
||||||
newWindowSize <- getWindowSize window dpr
|
newWindowSize <- getWindowSize window dpr
|
||||||
newRoot <- resizeUI renderer app newWindowSize widgetRoot
|
|
||||||
|
|
||||||
windowSize .= newWindowSize
|
windowSize .= newWindowSize
|
||||||
liftIO $ GL.viewport GL.$= (GL.Position 0 0, GL.Size (round $ _rw drawableSize) (round $ _rh drawableSize))
|
liftIO $ GL.viewport GL.$= (GL.Position 0 0, GL.Size (round $ _rw drawableSize) (round $ _rh drawableSize))
|
||||||
|
|
||||||
return newRoot
|
return $ resizeUI renderer app newWindowSize widgetRoot
|
||||||
|
|
||||||
preProcessEvents :: (MonomerM s e m) => (WidgetInstance s e m) -> [SystemEvent] -> m [SystemEvent]
|
preProcessEvents :: (MonomerM s e m) => (WidgetInstance s e m) -> [SystemEvent] -> m [SystemEvent]
|
||||||
preProcessEvents widgets events = do
|
preProcessEvents widgets events = do
|
||||||
|
@ -26,7 +26,7 @@ import qualified Monomer.Common.Tree as Tr
|
|||||||
|
|
||||||
type WidgetMergeHandler s e m = s -> Maybe WidgetState -> WidgetInstance s e m -> WidgetInstance s e m
|
type WidgetMergeHandler s e m = s -> Maybe WidgetState -> WidgetInstance s e m -> WidgetInstance s e m
|
||||||
type WidgetEventHandler s e m = PathContext -> SystemEvent -> s -> WidgetInstance s e m -> Maybe (EventResult s e m)
|
type WidgetEventHandler s e m = PathContext -> SystemEvent -> s -> WidgetInstance s e m -> Maybe (EventResult s e m)
|
||||||
type WidgetPreferredSizeHandler s e m = Monad m => Renderer m -> s -> Seq (WidgetInstance s e m, Tr.Tree SizeReq) -> m (Tr.Tree SizeReq)
|
type WidgetPreferredSizeHandler s e m = Monad m => Renderer m -> s -> Seq (WidgetInstance s e m, Tr.Tree SizeReq) -> Tr.Tree SizeReq
|
||||||
type WidgetResizeHandler s e m = s -> Rect -> Rect -> Seq (WidgetInstance s e m, Tr.Tree SizeReq) -> Seq (Rect, Rect)
|
type WidgetResizeHandler s e m = s -> Rect -> Rect -> Seq (WidgetInstance s e m, Tr.Tree SizeReq) -> Seq (Rect, Rect)
|
||||||
|
|
||||||
createContainer :: (Monad m) => Widget s e m
|
createContainer :: (Monad m) => Widget s e m
|
||||||
@ -143,7 +143,7 @@ containerHandleCustom ctx arg app widgetInstance
|
|||||||
|
|
||||||
-- | Preferred size
|
-- | Preferred size
|
||||||
defaultPreferredSize :: WidgetPreferredSizeHandler s e m
|
defaultPreferredSize :: WidgetPreferredSizeHandler s e m
|
||||||
defaultPreferredSize renderer app childrenPairs = return (Tr.Node current childrenReqs) where
|
defaultPreferredSize renderer app childrenPairs = Tr.Node current childrenReqs where
|
||||||
current = SizeReq {
|
current = SizeReq {
|
||||||
_sizeRequested = Size 0 0,
|
_sizeRequested = Size 0 0,
|
||||||
_sizePolicyWidth = FlexibleSize,
|
_sizePolicyWidth = FlexibleSize,
|
||||||
@ -151,13 +151,10 @@ defaultPreferredSize renderer app childrenPairs = return (Tr.Node current childr
|
|||||||
}
|
}
|
||||||
childrenReqs = fmap snd childrenPairs
|
childrenReqs = fmap snd childrenPairs
|
||||||
|
|
||||||
containerPreferredSize :: (Monad m) => WidgetPreferredSizeHandler s e m -> Renderer m -> s -> WidgetInstance s e m -> m (Tr.Tree SizeReq)
|
containerPreferredSize :: (Monad m) => WidgetPreferredSizeHandler s e m -> Renderer m -> s -> WidgetInstance s e m -> Tr.Tree SizeReq
|
||||||
containerPreferredSize psHandler renderer app widgetInstance = do
|
containerPreferredSize psHandler renderer app widgetInstance = psHandler renderer app (Seq.zip children childrenReqs) where
|
||||||
let children = _instanceChildren widgetInstance
|
children = _instanceChildren widgetInstance
|
||||||
|
childrenReqs = flip fmap children $ \child -> _widgetPreferredSize (_instanceWidget child) renderer app child
|
||||||
childrenReqs <- forM children $ \child -> _widgetPreferredSize (_instanceWidget child) renderer app child
|
|
||||||
|
|
||||||
psHandler renderer app (Seq.zip children childrenReqs)
|
|
||||||
|
|
||||||
-- | Resize
|
-- | Resize
|
||||||
defaultResize :: WidgetResizeHandler s e m
|
defaultResize :: WidgetResizeHandler s e m
|
||||||
|
@ -51,8 +51,8 @@ ignoreHandleEvent ctx evt app widgetInstance = Nothing
|
|||||||
ignoreHandleCustom :: forall i s e m . Typeable i => PathContext -> i -> s -> WidgetInstance s e m -> Maybe (EventResult s e m)
|
ignoreHandleCustom :: forall i s e m . Typeable i => PathContext -> i -> s -> WidgetInstance s e m -> Maybe (EventResult s e m)
|
||||||
ignoreHandleCustom ctx evt app widgetInstance = Nothing
|
ignoreHandleCustom ctx evt app widgetInstance = Nothing
|
||||||
|
|
||||||
ignorePreferredSize :: (Monad m) => Renderer m -> s -> WidgetInstance s e m -> m (Tr.Tree SizeReq)
|
ignorePreferredSize :: (Monad m) => Renderer m -> s -> WidgetInstance s e m -> Tr.Tree SizeReq
|
||||||
ignorePreferredSize renderer app widgetInstance = return $ Tr.singleton SizeReq {
|
ignorePreferredSize renderer app widgetInstance = Tr.singleton SizeReq {
|
||||||
_sizeRequested = Size 0 0,
|
_sizeRequested = Size 0 0,
|
||||||
_sizePolicyWidth = FlexibleSize,
|
_sizePolicyWidth = FlexibleSize,
|
||||||
_sizePolicyHeight = FlexibleSize
|
_sizePolicyHeight = FlexibleSize
|
||||||
|
@ -73,7 +73,7 @@ data Widget s e m =
|
|||||||
-- Renderer (mainly for text sizing functions)
|
-- Renderer (mainly for text sizing functions)
|
||||||
--
|
--
|
||||||
-- Returns: the minimum size desired by the widget
|
-- Returns: the minimum size desired by the widget
|
||||||
_widgetPreferredSize :: Renderer m -> s -> WidgetInstance s e m -> m (Tree SizeReq),
|
_widgetPreferredSize :: Renderer m -> s -> WidgetInstance s e m -> Tree SizeReq,
|
||||||
-- | Resizes the children of this widget
|
-- | Resizes the children of this widget
|
||||||
--
|
--
|
||||||
-- Vieport assigned to the widget
|
-- Vieport assigned to the widget
|
||||||
|
@ -33,11 +33,10 @@ makeButton label onClick = createWidget {
|
|||||||
events = if isPressed then [onClick] else []
|
events = if isPressed then [onClick] else []
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
preferredSize renderer app widgetInstance = do
|
preferredSize renderer app widgetInstance = singleton sizeReq where
|
||||||
let Style{..} = _instanceStyle widgetInstance
|
Style{..} = _instanceStyle widgetInstance
|
||||||
|
size = calcTextBounds renderer _textStyle label
|
||||||
size <- calcTextBounds renderer _textStyle label
|
sizeReq = SizeReq size FlexibleSize FlexibleSize
|
||||||
return $ singleton (SizeReq size FlexibleSize FlexibleSize)
|
|
||||||
|
|
||||||
render renderer ts ctx app WidgetInstance{..} =
|
render renderer ts ctx app WidgetInstance{..} =
|
||||||
do
|
do
|
||||||
|
@ -34,7 +34,7 @@ makeFixedGrid isHorizontal = createContainer {
|
|||||||
_widgetResize = containerResize resize
|
_widgetResize = containerResize resize
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
preferredSize renderer app childrenPairs = return (Tr.Node reqSize children) where
|
preferredSize renderer app childrenPairs = Tr.Node reqSize children where
|
||||||
children = fmap snd childrenPairs
|
children = fmap snd childrenPairs
|
||||||
visiblePairs = Seq.filter (_instanceVisible . fst) childrenPairs
|
visiblePairs = Seq.filter (_instanceVisible . fst) childrenPairs
|
||||||
childrenReqs = fmap (Tr.nodeValue . snd) visiblePairs
|
childrenReqs = fmap (Tr.nodeValue . snd) visiblePairs
|
||||||
|
@ -23,11 +23,10 @@ makeLabel caption = createWidget {
|
|||||||
_widgetRender = render
|
_widgetRender = render
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
preferredSize renderer app widgetInstance = do
|
preferredSize renderer app widgetInstance = singleton sizeReq where
|
||||||
let Style{..} = _instanceStyle widgetInstance
|
Style{..} = _instanceStyle widgetInstance
|
||||||
|
size = calcTextBounds renderer _textStyle (if caption == "" then " " else caption)
|
||||||
size <- calcTextBounds renderer _textStyle (if caption == "" then " " else caption)
|
sizeReq = SizeReq size FlexibleSize FlexibleSize
|
||||||
return . singleton $ SizeReq size FlexibleSize FlexibleSize
|
|
||||||
|
|
||||||
render renderer ts ctx app WidgetInstance{..} =
|
render renderer ts ctx app WidgetInstance{..} =
|
||||||
do
|
do
|
||||||
|
@ -67,11 +67,10 @@ makeSandbox onClick state = createWidget {
|
|||||||
Just val -> if val == SandboxData2 then Nothing else Nothing
|
Just val -> if val == SandboxData2 then Nothing else Nothing
|
||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
|
|
||||||
preferredSize renderer app widgetInstance = do
|
preferredSize renderer app widgetInstance = Tr.singleton sizeReq where
|
||||||
let Style{..} = _instanceStyle widgetInstance
|
Style{..} = _instanceStyle widgetInstance
|
||||||
|
size = calcTextBounds renderer _textStyle (T.pack (show (_clickCount state)))
|
||||||
size <- calcTextBounds renderer _textStyle (T.pack (show (_clickCount state)))
|
sizeReq = SizeReq size FlexibleSize FlexibleSize
|
||||||
return . Tr.singleton $ SizeReq size FlexibleSize FlexibleSize
|
|
||||||
|
|
||||||
render renderer ts ctx app WidgetInstance{..} =
|
render renderer ts ctx app WidgetInstance{..} =
|
||||||
do
|
do
|
||||||
|
@ -81,14 +81,10 @@ makeScroll state@(ScrollState dx dy cs@(Size cw ch)) = createContainer {
|
|||||||
then currScroll + reqDelta
|
then currScroll + reqDelta
|
||||||
else viewportLimit - childPos
|
else viewportLimit - childPos
|
||||||
|
|
||||||
--preferredSize renderer app childrenPairs = return (Tr.Node reqSize children) where
|
preferredSize renderer app childrenPairs = Tr.Node sizeReq childrenReqs where
|
||||||
preferredSize renderer app childrenPairs = return (Tr.Node sizeReq childrenReqs) where
|
|
||||||
--reqsTree = fmap snd childrenPairs
|
|
||||||
--childrenReqs = fmap (Tr.nodeValue . snd) childrenPairs
|
|
||||||
childrenReqs = fmap snd childrenPairs
|
childrenReqs = fmap snd childrenPairs
|
||||||
sizeReq = SizeReq (_sizeRequested . Tr.nodeValue $ Seq.index childrenReqs 0) FlexibleSize FlexibleSize
|
sizeReq = SizeReq (_sizeRequested . Tr.nodeValue $ Seq.index childrenReqs 0) FlexibleSize FlexibleSize
|
||||||
|
|
||||||
--resize app viewport renderArea childrenPairs = assignedAreas where
|
|
||||||
resize app viewport renderArea childrenPairs = Seq.singleton (childViewport, childRenderArea) where
|
resize app viewport renderArea childrenPairs = Seq.singleton (childViewport, childRenderArea) where
|
||||||
Rect l t w h = viewport
|
Rect l t w h = viewport
|
||||||
Size cw2 ch2 = _sizeRequested (Tr.nodeValue . snd $ Seq.index childrenPairs 0)
|
Size cw2 ch2 = _sizeRequested (Tr.nodeValue . snd $ Seq.index childrenPairs 0)
|
||||||
|
@ -22,4 +22,5 @@ makeSpacer = createWidget {
|
|||||||
_widgetPreferredSize = preferredSize
|
_widgetPreferredSize = preferredSize
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
preferredSize renderer app widgetInstance = return . singleton $ SizeReq (Size defaultSpace defaultSpace) RemainderSize RemainderSize
|
preferredSize renderer app widgetInstance = singleton sizeReq where
|
||||||
|
sizeReq = SizeReq (Size defaultSpace defaultSpace) RemainderSize RemainderSize
|
||||||
|
@ -32,7 +32,7 @@ makeStack isHorizontal = createContainer {
|
|||||||
focusable = False
|
focusable = False
|
||||||
handleEvent _ _ _ = Nothing
|
handleEvent _ _ _ = Nothing
|
||||||
|
|
||||||
preferredSize renderer app childrenPairs = return (Node reqSize childrenReqs) where
|
preferredSize renderer app childrenPairs = Node reqSize childrenReqs where
|
||||||
reqSize = SizeReq (calcPreferredSize childrenPairs) FlexibleSize FlexibleSize
|
reqSize = SizeReq (calcPreferredSize childrenPairs) FlexibleSize FlexibleSize
|
||||||
childrenReqs = fmap snd childrenPairs
|
childrenReqs = fmap snd childrenPairs
|
||||||
|
|
||||||
|
@ -87,11 +87,10 @@ makeTextField userField tfs@(TextFieldState currText currPos) = createWidget {
|
|||||||
newState = TextFieldState newText newPos
|
newState = TextFieldState newText newPos
|
||||||
newInstance = widgetInstance { _instanceWidget = makeTextField userField newState }
|
newInstance = widgetInstance { _instanceWidget = makeTextField userField newState }
|
||||||
|
|
||||||
preferredSize renderer app widgetInstance = do
|
preferredSize renderer app widgetInstance = Tr.singleton sizeReq where
|
||||||
let Style{..} = _instanceStyle widgetInstance
|
Style{..} = _instanceStyle widgetInstance
|
||||||
|
size = calcTextBounds renderer _textStyle (if currText == "" then " " else currText)
|
||||||
size <- calcTextBounds renderer _textStyle (if currText == "" then " " else currText)
|
sizeReq = SizeReq size FlexibleSize FlexibleSize
|
||||||
return . Tr.singleton $ SizeReq size FlexibleSize FlexibleSize
|
|
||||||
|
|
||||||
render renderer ts ctx app WidgetInstance{..} =
|
render renderer ts ctx app WidgetInstance{..} =
|
||||||
let textStyle = _textStyle _instanceStyle
|
let textStyle = _textStyle _instanceStyle
|
||||||
@ -103,6 +102,6 @@ makeTextField userField tfs@(TextFieldState currText currPos) = createWidget {
|
|||||||
Rect tl tt _ _ <- drawText renderer renderArea textStyle currText
|
Rect tl tt _ _ <- drawText renderer renderArea textStyle currText
|
||||||
|
|
||||||
when True $ do
|
when True $ do
|
||||||
Size sw sh <- calcTextBounds renderer textStyle (if part1 == "" then " " else part1)
|
let Size sw sh = calcTextBounds renderer textStyle (if part1 == "" then " " else part1)
|
||||||
drawRect renderer (Rect (tl + sw) tt caretWidth sh) (Just textColor) Nothing
|
drawRect renderer (Rect (tl + sw) tt caretWidth sh) (Just textColor) Nothing
|
||||||
return ()
|
return ()
|
||||||
|
Loading…
Reference in New Issue
Block a user