{-# LANGUAGE RecordWildCards, ExistentialQuantification #-}
module FPPrac (
- module Graphics.UI.WXCore.WxcTypes,
Request(..),
Response(..),
TinaProgram(..),
+ Color, Rect(..), Point(..),
+ rgb, pt, point,
runTina
) where
-import Graphics.UI.WXCore.WxcTypes
-import Graphics.UI.WX hiding (empty)
-import Graphics.UI.WXCore hiding (empty)
+import qualified Graphics.UI.Gtk as Gtk
+import Graphics.UI.Gtk (AttrOp(..)) -- For the := constructor
+import qualified Graphics.Rendering.Cairo as Cairo
+import qualified Graphics.UI.Gtk.Gdk.EventM as EventM
+
+import Control.Monad.Trans -- for liftIO
import Data.IORef
import Control.Applicative
import Control.Monad
import Char
import System.Exit
+-- | A rectangle in two dimensional space
+data Rect = Rect
+ { rectLeft :: !Int
+ , rectTop :: !Int
+ , rectWidth :: !Int
+ , rectHeight :: !Int
+} deriving (Show, Eq)
+
+data Point = Point !Int !Int deriving (Show, Eq)
+
+type Color = Gtk.Color
+
+-- Create a Color from Red, Green and Blue values. The inputs should be
+-- between 0 and 255 (inclusive).
+rgb :: Int -> Int -> Int -> Color
+rgb r g b = Gtk.Color (conv r) (conv g) (conv b)
+ where conv = fromInteger . toInteger . (*256)
+
+-- | Some predefined colours
+red = rgb 0xff 0 0
+green = rgb 0 0xff 0
+blue = rgb 0 0 0xff
+white = rgb 0xff 0xff 0xff
+
+-- | Helper functions for creating a Point
+point, pt :: Int -> Int -> Point
+point = Point
+pt = Point
+
data Request
= GfxLines Color [Point] -- coloured line through a list of points
| GfxPolygon Color [Point] -- filled polygon of given colour
}
data IState = forall s. IS
- { sFrame :: Frame ()
+ { {-sFrame :: Frame ()
, sPanel :: Panel ()
, buffer :: MemoryDC ()
- , postponed :: IORef [Request]
+ , -}postponed :: IORef [Request]
, usrState :: IORef s
, usrProg :: TinaStep s
}
-dbgLog IS {..} s = do
- return ()
-
processPostponed :: IState -> IO ()
processPostponed s@IS {..} = do
ps <- readIORef postponed
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 s = do
+ -- Init GTK.
+ Gtk.initGUI
+
+ -- Create a window, which will make the mainloop terminated when
+ -- it is closed.
+ window <- Gtk.windowNew
+ Gtk.set window [ Gtk.containerBorderWidth := 10
+ , Gtk.windowTitle := "FP Practicum" ]
+ Gtk.onDestroy window Gtk.mainQuit
+
+ -- Show the window and start the Gtk mainloop.
+ Gtk.widgetShowAll window
+ Gtk.mainGUI
-runGUI :: Size -> IState -> IO ()
+
+{-
runGUI s IS {..} = do
sFrame <- frame
[ text := "FP Practicum"
]
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 ()
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']
| 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
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
, rectWidth = rectWidth + 2 * n
, rectHeight = rectHeight + 2 * n }
-
+-}