X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=FPPrac.hs;h=14e8c4f872036b122449cf12242e3338936520c5;hb=25a54fccc78a8c85e3196428c677e213c1eab23e;hp=fcbf33e15c00def5e1ada934f01a03d24b340cdc;hpb=8b21eea5d5be2a1ac267693382e77b772a10d73a;p=matthijs%2Fprojects%2Ffpprac.git diff --git a/FPPrac.hs b/FPPrac.hs index fcbf33e..14e8c4f 100644 --- a/FPPrac.hs +++ b/FPPrac.hs @@ -236,6 +236,8 @@ transKey _ _ = return () -} +-- | Handlers for various requests. +miscHandler, winHandler, gfxHandler :: IState -> Request -> Maybe (IO ()) {- miscHandler s@IS {..} (FRead fn ) = Just $ readFile fn >>= post s . FileContents fn miscHandler IS {..} (FWrite fn cnts) = Just $ writeFile fn cnts @@ -261,7 +263,7 @@ winHandler s@IS {..} (WinMenu ms) = Just $ mkMenu >>= \ms' -> sFrame `set` -} winHandler _ _ = Nothing -gfxHandler s req = case gfxHandler' s req of +gfxHandler s req = case gfxHandler' req of Nothing -> Nothing Just render -> Just $ do buf <- readIORef (buffer s) @@ -278,12 +280,19 @@ gfxHandler IS {..} (GfxDisc col rt) = Just $ ellipse buffer rt [penColor gfxHandler IS {..} (GfxFont st sz) = Just $ buffer `set` [ fontSize := sz, fontFace := st ] gfxHandler IS {..} (GfxPicture fd pt) = Just $ bitmapCreateFromFile fd >>= \bm -> drawBitmap buffer bm pt False [] >> bitmapGetSize bm >>= dirtyRect' sPanel pt -} -gfxHandler' IS {..} (GfxText col (Point x y) st) = Just $ do +-- | Helper function for gfxHanlder +gfxHandler' :: Request -> Maybe (Cairo.Render ()) +gfxHandler' (GfxText col (Point x y) st) = Just $ do + -- Set the source color, move to the requested position and draw the + -- text setSourceColor col Cairo.moveTo (fromIntegral x) (fromIntegral y) Cairo.showText st -gfxHandler' IS {..} GfxClear = Just $ Cairo.setSourceRGB 1 1 1 >> Cairo.paint -gfxHandler' _ _ = Nothing +gfxHandler' GfxClear = Just $ do + -- Set the source to white and paint the entire surface with it + Cairo.setSourceRGB 1 1 1 + Cairo.paint +gfxHandler' _ = Nothing -- | Sets the source to a pattern fill of the given color setSourceColor :: Color -> Cairo.Render ()