Don't use the widget definition as a part of the render cache state
This commit is contained in:
parent
7a87ba6f2e
commit
eca887df7c
3 changed files with 17 additions and 17 deletions
|
@ -86,7 +86,7 @@ class Eq s => Widget w s c | w -> s, w -> c where
|
||||||
handleMessage _ priv _ = priv
|
handleMessage _ priv _ = priv
|
||||||
|
|
||||||
type IOCache = CacheArrow (Kleisli IO)
|
type IOCache = CacheArrow (Kleisli IO)
|
||||||
type RenderCache w s = IOCache (w, s, Int, Int, Int, Int, Xlib.Rectangle) Surface
|
type RenderCache s = IOCache (s, Int, Int, Int, Int, Xlib.Rectangle) Surface
|
||||||
|
|
||||||
createIOCache :: Eq a => (a -> IO b) -> IOCache a b
|
createIOCache :: Eq a => (a -> IO b) -> IOCache a b
|
||||||
createIOCache = lift . Kleisli
|
createIOCache = lift . Kleisli
|
||||||
|
@ -98,21 +98,21 @@ runIOCache a = do
|
||||||
put cache'
|
put cache'
|
||||||
return b
|
return b
|
||||||
|
|
||||||
createRenderCache :: (w -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ())
|
createRenderCache :: (s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ())
|
||||||
-> CacheArrow (Kleisli IO) (w, s, Int, Int, Int, Int, Xlib.Rectangle) Surface
|
-> CacheArrow (Kleisli IO) (s, Int, Int, Int, Int, Xlib.Rectangle) Surface
|
||||||
createRenderCache f = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
|
createRenderCache f = lift . Kleisli $ \(state, x, y, w, h, screen) -> do
|
||||||
surface <- createImageSurface FormatARGB32 w h
|
surface <- createImageSurface FormatARGB32 w h
|
||||||
renderWith surface $ do
|
renderWith surface $ do
|
||||||
setOperator OperatorClear
|
setOperator OperatorClear
|
||||||
paint
|
paint
|
||||||
setOperator OperatorOver
|
setOperator OperatorOver
|
||||||
f widget state x y w h screen
|
f state x y w h screen
|
||||||
return surface
|
return surface
|
||||||
|
|
||||||
renderCached :: (Eq w, Eq s) => w -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT (RenderCache w s) IO [(Bool, SurfaceSlice)]
|
renderCached :: Eq s => s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT (RenderCache s) IO [(Bool, SurfaceSlice)]
|
||||||
renderCached widget state x y w h screen = do
|
renderCached state x y w h screen = do
|
||||||
cache <- get
|
cache <- get
|
||||||
(surf, updated, cache') <- liftIO $ runKleisli (runCache' cache) (widget, state, x, y, w, h, screen)
|
(surf, updated, cache') <- liftIO $ runKleisli (runCache' cache) (state, x, y, w, h, screen)
|
||||||
put cache'
|
put cache'
|
||||||
return [(updated, SurfaceSlice 0 surf)]
|
return [(updated, SurfaceSlice 0 surf)]
|
||||||
|
|
||||||
|
@ -157,15 +157,15 @@ a <~> b = CompoundWidget a b
|
||||||
|
|
||||||
data Separator = Separator !Int !Float deriving (Show, Eq)
|
data Separator = Separator !Int !Float deriving (Show, Eq)
|
||||||
|
|
||||||
instance Widget Separator () (RenderCache Separator ()) where
|
instance Widget Separator () (RenderCache ()) where
|
||||||
initWidget _ _ _ _ = return ()
|
initWidget _ _ _ _ = return ()
|
||||||
initCache _ = createRenderCache $ \_ _ _ _ _ _ _ -> do
|
initCache _ = createRenderCache $ \_ _ _ _ _ _ -> do
|
||||||
setOperator OperatorClear
|
setOperator OperatorClear
|
||||||
paint
|
paint
|
||||||
|
|
||||||
minSize (Separator s _) _ _ _ = s
|
minSize (Separator s _) _ _ _ = s
|
||||||
weight (Separator _ w) = w
|
weight (Separator _ w) = w
|
||||||
render = renderCached
|
render _ = renderCached
|
||||||
|
|
||||||
|
|
||||||
separator :: Int -> Float -> Separator
|
separator :: Int -> Float -> Separator
|
||||||
|
|
|
@ -42,7 +42,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
|
||||||
|
|
||||||
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
|
data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
|
||||||
|
|
||||||
instance Widget Clock ClockState (RenderCache Clock ClockState) where
|
instance Widget Clock ClockState (RenderCache ClockState) where
|
||||||
initWidget (Clock _) phi _ _ = do
|
initWidget (Clock _) phi _ _ = do
|
||||||
forkIO $ forever $ do
|
forkIO $ forever $ do
|
||||||
time <- getZonedTime
|
time <- getZonedTime
|
||||||
|
@ -54,7 +54,7 @@ instance Widget Clock ClockState (RenderCache Clock ClockState) where
|
||||||
time <- getZonedTime
|
time <- getZonedTime
|
||||||
return $ ClockState time
|
return $ ClockState time
|
||||||
|
|
||||||
initCache _ = createRenderCache $ \(Clock config) (ClockState time) _ _ w h _ -> do
|
initCache (Clock config) = createRenderCache $ \(ClockState time) _ _ w h _ -> do
|
||||||
let (r, g, b, a) = fontColor config
|
let (r, g, b, a) = fontColor config
|
||||||
str = formatTime defaultTimeLocale (clockFormat config) time
|
str = formatTime defaultTimeLocale (clockFormat config) time
|
||||||
setSourceRGBA r g b a
|
setSourceRGBA r g b a
|
||||||
|
@ -78,7 +78,7 @@ instance Widget Clock ClockState (RenderCache Clock ClockState) where
|
||||||
|
|
||||||
minSize (Clock config) _ _ _ = clockSize config
|
minSize (Clock config) _ _ _ = clockSize config
|
||||||
|
|
||||||
render = renderCached
|
render _ = renderCached
|
||||||
|
|
||||||
handleMessage _ priv m = case (fromMessage m) of
|
handleMessage _ priv m = case (fromMessage m) of
|
||||||
Just (UpdateTime time) -> ClockState time
|
Just (UpdateTime time) -> ClockState time
|
||||||
|
|
|
@ -48,14 +48,14 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon
|
||||||
deriving (Show, Typeable)
|
deriving (Show, Typeable)
|
||||||
|
|
||||||
|
|
||||||
instance Widget Systray SystrayState (RenderCache Systray SystrayState) where
|
instance Widget Systray SystrayState (RenderCache SystrayState) where
|
||||||
initWidget (Systray) phi dispvar screens = do
|
initWidget (Systray) phi dispvar screens = do
|
||||||
phi' <- dupPhi phi
|
phi' <- dupPhi phi
|
||||||
forkIO $ systrayRunner phi' dispvar $ snd . head $ screens
|
forkIO $ systrayRunner phi' dispvar $ snd . head $ screens
|
||||||
|
|
||||||
return $ SystrayState phi (fst . head $ screens) 0 []
|
return $ SystrayState phi (fst . head $ screens) 0 []
|
||||||
|
|
||||||
initCache _ = createRenderCache $ \Systray (SystrayState phi systrayScreen reset icons) x y w h screen -> do
|
initCache _ = createRenderCache $ \(SystrayState phi systrayScreen reset icons) x y w h screen -> do
|
||||||
when (screen == systrayScreen) $ do
|
when (screen == systrayScreen) $ do
|
||||||
forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do
|
forM_ (zip [0..] icons) $ \(i, SystrayIconState midParent window) -> do
|
||||||
let x' = x + i*(h+2)
|
let x' = x + i*(h+2)
|
||||||
|
@ -70,7 +70,7 @@ instance Widget Systray SystrayState (RenderCache Systray SystrayState) where
|
||||||
|
|
||||||
weight _ = 0
|
weight _ = 0
|
||||||
|
|
||||||
render = renderCached
|
render _ = renderCached
|
||||||
|
|
||||||
|
|
||||||
handleMessage _ priv@(SystrayState phi screen reset icons) m = case (fromMessage m) of
|
handleMessage _ priv@(SystrayState phi screen reset icons) m = case (fromMessage m) of
|
||||||
|
|
Reference in a new issue