From: Matthijs Kooijman Date: Sun, 23 Aug 2009 14:40:01 +0000 (+0200) Subject: Make runTina available again. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=cb9aa250052bfae8f8c34cb74701f0c381ada2c6;p=matthijs%2Fprojects%2Ffpprac.git Make runTina available again. Actual GUI creation and event handling is not working yet. --- diff --git a/FPPrac.hs b/FPPrac.hs index 61fd9ef..ddf421e 100644 --- a/FPPrac.hs +++ b/FPPrac.hs @@ -44,9 +44,6 @@ point, pt :: Int -> Int -> Point point = Point pt = Point -runTina :: TinaProgram -> IO () -runTina p = return () - data Request = GfxLines Color [Point] -- coloured line through a list of points | GfxPolygon Color [Point] -- filled polygon of given colour @@ -103,9 +100,6 @@ data IState = forall s. IS , usrState :: IORef s , usrProg :: TinaStep s } -{- -dbgLog IS {..} s = do - return () processPostponed :: IState -> IO () processPostponed s@IS {..} = do @@ -135,12 +129,12 @@ runTina :: TinaProgram -> IO () runTina Main {..} = do usrState <- newIORef initialState postponed <- newIORef (GfxText (rgb 0 0 0) (pt 50 50) "foo" : GfxClear :initialRequests) - let state = IS { sFrame = undefined, sPanel = undefined, buffer = undefined, usrProg = eventHandler, .. } - run $ runGUI (sz windowWidth windowHeight) state - putStrLn "XX" - runGUI (sz windowWidth windowHeight) state + let state = IS { usrProg = eventHandler, .. } + runGUI {-(sz windowWidth windowHeight) -}state -runGUI :: Size -> IState -> IO () +runGUI :: {-Size ->-} IState -> IO () +runGUI s = do return () +{- runGUI s IS {..} = do sFrame <- frame [ text := "FP Practicum" @@ -175,7 +169,6 @@ runGUI s IS {..} = do ] windowSetFocus sFrame processPostponed state - onPaint :: IState -> DC a -> Rect -> IO () onPaint IS {..} dest va = do dcBlit dest va buffer (Point 0 0) wxCOPY False >> return () @@ -188,14 +181,16 @@ transKey prod KeyReturn = prod '\n' transKey prod KeyTab = prod '\t' transKey _ _ = return () +-} - - +{- miscHandler s@IS {..} (FRead fn ) = Just $ readFile fn >>= post s . FileContents fn miscHandler IS {..} (FWrite fn cnts) = Just $ writeFile fn cnts miscHandler IS {..} ReqQuit = Just $ putStrLn "Quiting" >> wxcAppExit +-} miscHandler IS {..} _ = Nothing +{- winHandler s@IS {..} (WinPrompt st1 st2 st3) = Just $ textDialog sFrame st1 st2 st3 >>= post s . PromptResponse st1 st2 winHandler IS {..} (WinTitle st) = Just $ sFrame `set` [text := st] winHandler s@IS {..} (WinMenu ms) = Just $ mkMenu >>= \ms' -> sFrame `set` [menuBar := ms'] @@ -210,8 +205,10 @@ winHandler s@IS {..} (WinMenu ms) = Just $ mkMenu >>= \ms' -> sFrame `set` | item <- items ] return p | (name,items) <- ms ] +-} winHandler _ _ = Nothing +{- 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 gfxHandler IS {..} (GfxText col xy st) = Just $ drawText buffer st xy [textColor := col] >> getTextExtent buffer st >>= dirtyRect' sPanel xy @@ -221,8 +218,10 @@ gfxHandler IS {..} (GfxDisc col rt) = Just $ ellipse buffer rt [penColor 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 +{- dirtyPts :: Window a -> [Point] -> IO () dirtyPts dc ps = dirtyRect' dc (pt x y) Size {..} where