summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets/AlphaBox.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets/AlphaBox.hs')
-rw-r--r--lib/Phi/Widgets/AlphaBox.hs13
1 files changed, 10 insertions, 3 deletions
diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs
index cd540e3..508f9d4 100644
--- a/lib/Phi/Widgets/AlphaBox.hs
+++ b/lib/Phi/Widgets/AlphaBox.hs
@@ -8,6 +8,7 @@ import Phi.Types
import Phi.Widget
import Control.Monad
+import Control.Monad.State.Strict
import Graphics.Rendering.Cairo
@@ -16,8 +17,11 @@ data AlphaBox w s c = (Widget w s c) => AlphaBox !Double !w
deriving instance Show (AlphaBox w s c)
deriving instance Eq (AlphaBox w s c)
-instance Eq s => Widget (AlphaBox w s c) s () where
+data AlphaBoxCache w s c = (Widget w s c) => AlphaBoxCache !c
+
+instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
initWidget (AlphaBox _ w) = initWidget w
+ initCache (AlphaBox _ w) = AlphaBoxCache $ initCache w
minSize (AlphaBox _ w) = minSize w
@@ -26,10 +30,13 @@ instance Eq s => Widget (AlphaBox w s c) s () where
layout (AlphaBox _ w) = layout w
render (AlphaBox alpha w) s x y width height screen = do
- surfaces <- render w s x y width height screen
+ AlphaBoxCache c <- get
+ (surfaces, c') <- liftIO $ flip runStateT c $ render w s x y width height screen
+ put $ AlphaBoxCache c'
+
let surfacesWidths = zipWith (\(updated, SurfaceSlice x surf) x' -> (updated, x, x'-x, surf)) surfaces (map (\(_, SurfaceSlice x _) -> x) (tail surfaces) ++ [width])
forM surfacesWidths $ \(updated, x, surfWidth, surf) -> do
- surf' <- createImageSurface FormatARGB32 surfWidth height
+ surf' <- liftIO $ createImageSurface FormatARGB32 surfWidth height
renderWith surf' $ do
setOperator OperatorSource
withPatternForSurface surf setSource