1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
module GraphicsWindows
( runGraphics
, Window, mkWindow, openWindow, openWindowEx, closeWindow, redraw
, windowRect
, Picture, getPicture, setPicture
, Event(..), getEvent
, getTick
, windowHWND
) where
import GraphicsWND(
WND, openWND, closeWND, redrawWND, getHWND,
handleEvents, closeAllHWNDs,
wndRect
)
import GraphicsEvents( Events, newEvents )
import GraphicsTypes
import GraphicsPicture(
empty, DrawFun, drawPicture, drawBufferedPicture
)
import GraphicsEvent( Event )
import qualified GraphicsEvents as Events( getEvent )
import GraphicsUtilities( safeTry )
import qualified Win32
import Word( Word32 )
import IOExts
import Concurrent( forkIO )
import IO ( try )
----------------------------------------------------------------
-- The interface
----------------------------------------------------------------
data Window = MkWindow {
wnd :: WND, -- the real window
events :: Events, -- the event stream
picture :: IORef Picture -- the current picture
}
runGraphics :: IO () -> IO ()
openWindow :: String -> Point -> IO Window
openWindowEx :: String -> Maybe Point -> Maybe Point ->
(Picture -> DrawFun) -> Maybe Word32 ->
IO Window
mkWindow :: WND -> Events -> IORef Picture -> IO Window
closeWindow :: Window -> IO ()
redraw :: Window -> IO ()
windowRect :: Window -> IO (Point, Point)
getPicture :: Window -> IO Picture
setPicture :: Window -> Picture -> IO ()
getEvent :: Window -> IO Event
getTick :: Window -> IO ()
-- in case you need low level access
windowHWND :: Window -> IO Win32.HWND
----------------------------------------------------------------
-- The implementation
----------------------------------------------------------------
-- We took a lot of effort to make sure that we always close the
-- windows - even if "m" fails.
--
-- Note though that we use "try" instead of "safeTry" on the call to
-- "m" because it is quite normal for "m" to block (and safeTry treats
-- blocking as failure).
runGraphics m = do
closeAllHWNDs -- just in case any are already open!
quit <- newIORef False
safeTry $ do
forkIO (try m >> writeIORef quit True)
handleEvents (readIORef quit)
closeAllHWNDs
openWindow name size = openWindowEx name Nothing (Just size) drawPicture Nothing
openWindowEx name pos size repaint tickRate = do
picture <- newIORef empty
events <- newEvents
let draw = \ hwnd hdc -> do
p <- readIORef picture
repaint p hwnd hdc
wnd <- openWND name (map fromPoint pos) (map fromPoint size)
events draw tickRate
mkWindow wnd events picture
mkWindow wnd events picture = do
return (MkWindow { wnd, events, picture })
closeWindow w = closeWND (wnd w)
windowRect w = wndRect (wnd w)
redraw w = redrawWND (wnd w)
windowHWND w = getHWND (wnd w)
getPicture w = readIORef (picture w)
setPicture w p = writeIORef (picture w) p >> redrawWND (wnd w)
getEvent w = Events.getEvent (events w)
getTick w = Events.getTick (events w)
-- peekEvent :: Window -> IO (Maybe Event)
-- peekEvent w = Events.peekEvent (events w)
|
