X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fprojects%2Ffpprac.git;a=blobdiff_plain;f=FPPrac.hs;fp=FPPrac.hs;h=d8fd94f5c1cf7b6271277c9c2e29dafdb1e029c5;hp=79a6a0ac9405b167d0c76b931c9292bdc49462c4;hb=91c7f38f11d53b661298e723341665b4308fb38a;hpb=ea597e505a69974dfd35dd2728b1e9f3bb109fa9 diff --git a/FPPrac.hs b/FPPrac.hs index 79a6a0a..d8fd94f 100644 --- a/FPPrac.hs +++ b/FPPrac.hs @@ -166,10 +166,14 @@ runGUI w h (IS { .. }) = do -- Repack state let state = IS { .. } - + + -- Process any initial requests + processPostponed state + -- Show the window and start the Gtk mainloop. Gtk.widgetShowAll window Gtk.mainGUI + -- | Copy the given surface to the exposed window on an expose event. onExpose :: IORef Cairo.Surface -> EventM.EventM EventM.EExpose Bool @@ -256,6 +260,13 @@ winHandler s@IS {..} (WinMenu ms) = Just $ mkMenu >>= \ms' -> sFrame `set` -} winHandler _ _ = Nothing +gfxHandler s req = case gfxHandler' s req of + Nothing -> Nothing + Just render -> Just $ do + buf <- readIORef (buffer s) + Cairo.renderWith buf render + Gtk.widgetQueueDraw (window s) + {- gfxHandler IS {..} (GfxLines col ps) = Just $ polyline buffer ps [penColor := col] >> dirtyPts sPanel ps gfxHandler IS {..} (GfxPolygon col ps) = Just $ polygon buffer ps [penColor := col, brushColor := col] >> dirtyPts sPanel ps @@ -264,10 +275,10 @@ gfxHandler IS {..} (GfxRectangle col rt) = Just $ drawRect buffer rt [penColo gfxHandler IS {..} (GfxEllipse col rt) = Just $ ellipse buffer rt [penColor := col, brushKind := BrushTransparent] >> dirtyRect sPanel rt gfxHandler IS {..} (GfxDisc col rt) = Just $ ellipse buffer rt [penColor := col, brushColor := col] >> dirtyRect sPanel rt gfxHandler IS {..} (GfxFont st sz) = Just $ buffer `set` [ fontSize := sz, fontFace := st ] -gfxHandler IS {..} GfxClear = Just $ dcClear buffer >> windowRefresh sPanel False gfxHandler IS {..} (GfxPicture fd pt) = Just $ bitmapCreateFromFile fd >>= \bm -> drawBitmap buffer bm pt False [] >> bitmapGetSize bm >>= dirtyRect' sPanel pt -} -gfxHandler _ _ = Nothing +gfxHandler' IS {..} GfxClear = Just $ Cairo.setSourceRGB 1 1 1 >> Cairo.paint +gfxHandler' _ _ = Nothing {- dirtyPts :: Window a -> [Point] -> IO ()