Add a lot of caching framework

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