1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) General
4--
5--  Author : Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts
6--
7--  Created: 11 October 2005
8--
9--  Copyright (C) 2000..2005 Axel Simon, Manuel M. T. Chakravarty, Duncan Coutts
10--
11--  This library is free software; you can redistribute it and/or
12--  modify it under the terms of the GNU Lesser General Public
13--  License as published by the Free Software Foundation; either
14--  version 2.1 of the License, or (at your option) any later version.
15--
16--  This library is distributed in the hope that it will be useful,
17--  but WITHOUT ANY WARRANTY; without even the implied warranty of
18--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19--  Lesser General Public License for more details.
20--
21-- |
22-- Maintainer  : gtk2hs-users@lists.sourceforge.net
23-- Stability   : provisional
24-- Portability : portable (depends on GHC)
25--
26-- main event loop, and events
27--
28module System.Glib.MainLoop (
29  HandlerId,
30  timeoutAdd,
31  timeoutAddFull,
32  timeoutRemove,
33  idleAdd,
34  idleRemove,
35  IOCondition(..),
36  inputAdd,
37  inputRemove,
38  Priority,
39  priorityLow,
40  priorityDefaultIdle,
41  priorityHighIdle,
42  priorityDefault,
43  priorityHigh,
44  MainLoop,
45  mainLoopNew,
46  mainLoopRun,
47  mainLoopQuit,
48  mainLoopIsRunning,
49  MainContext,
50  mainContextNew,
51  mainContextDefault,
52  mainContextIteration,
53  mainContextFindSourceById,
54  Source(..),
55  sourceAttach,
56  sourceSetPriority,
57  sourceGetPriority,
58  sourceDestroy,
59#if GLIB_CHECK_VERSION(2,12,0)
60  sourceIsDestroyed
61#endif
62  ) where
63
64import Control.Monad    (liftM)
65
66import System.Glib.FFI
67import System.Glib.Flags
68import System.Glib.GObject      (DestroyNotify, destroyFunPtr)
69
70{#context lib="glib" prefix ="g"#}
71
72{#pointer SourceFunc#}
73
74foreign import ccall "wrapper" mkSourceFunc :: (Ptr () -> IO {#type gint#}) -> IO SourceFunc
75
76type HandlerId = {#type guint#}
77
78-- Turn a function into a function pointer and a destructor pointer.
79--
80makeCallback :: IO {#type gint#} -> IO (SourceFunc, DestroyNotify)
81makeCallback fun = do
82  funPtr <- mkSourceFunc (const fun)
83  return (funPtr, destroyFunPtr)
84
85-- | Sets a function to be called at regular intervals, with the default
86-- priority 'priorityDefault'. The function is called repeatedly until it
87-- returns @False@, after which point the timeout function will not be called
88-- again. The first call to the function will be at the end of the first interval.
89--
90-- Note that timeout functions may be delayed, due to the processing of other
91-- event sources. Thus they should not be relied on for precise timing. After
92-- each call to the timeout function, the time of the next timeout is
93-- recalculated based on the current time and the given interval (it does not
94-- try to 'catch up' time lost in delays).
95--
96timeoutAdd :: IO Bool -> Int -> IO HandlerId
97timeoutAdd fun msec = timeoutAddFull fun priorityDefault msec
98
99-- | Sets a function to be called at regular intervals, with the given
100-- priority. The function is called repeatedly until it returns @False@, after
101-- which point the timeout function will not be called again. The first call
102-- to the function will be at the end of the first interval.
103--
104-- Note that timeout functions may be delayed, due to the processing of other
105-- event sources. Thus they should not be relied on for precise timing. After
106-- each call to the timeout function, the time of the next timeout is
107-- recalculated based on the current time and the given interval (it does not
108-- try to 'catch up' time lost in delays).
109--
110timeoutAddFull :: IO Bool -> Priority -> Int -> IO HandlerId
111timeoutAddFull fun pri msec = do
112  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
113  {#call unsafe g_timeout_add_full#}
114    (fromIntegral pri)
115    (fromIntegral msec)
116    funPtr
117    (castFunPtrToPtr funPtr)
118    dPtr
119
120-- | Remove a previously added timeout handler by its 'HandlerId'.
121--
122timeoutRemove :: HandlerId -> IO ()
123timeoutRemove id = {#call source_remove#} id >> return ()
124
125-- | Add a callback that is called whenever the system is idle.
126--
127-- * A priority can be specified via an integer. This should usually be
128--   'priorityDefaultIdle'.
129--
130-- * If the function returns @False@ it will be removed.
131--
132idleAdd :: IO Bool -> Priority -> IO HandlerId
133idleAdd fun pri = do
134  (funPtr, dPtr) <- makeCallback (liftM fromBool fun)
135  {#call unsafe idle_add_full#} (fromIntegral pri) funPtr
136    (castFunPtrToPtr funPtr) dPtr
137
138-- | Remove a previously added idle handler by its 'HandlerId'.
139--
140idleRemove :: HandlerId -> IO ()
141idleRemove id = {#call source_remove#} id >> return ()
142
143-- | Flags representing a condition to watch for on a file descriptor.
144--
145-- [@IOIn@]             There is data to read.
146-- [@IOOut@]            Data can be written (without blocking).
147-- [@IOPri@]            There is urgent data to read.
148-- [@IOErr@]            Error condition.
149-- [@IOHup@]            Hung up (the connection has been broken, usually for
150--                      pipes and sockets).
151-- [@IOInvalid@]        Invalid request. The file descriptor is not open.
152--
153{# enum IOCondition {
154          G_IO_IN   as IOIn,
155          G_IO_OUT  as IOOut,
156          G_IO_PRI  as IOPri,
157          G_IO_ERR  as IOErr,
158          G_IO_HUP  as IOHup,
159          G_IO_NVAL as IOInvalid
160        } deriving (Eq, Bounded) #}
161instance Flags IOCondition
162
163{#pointer *IOChannel newtype#}
164{#pointer IOFunc#}
165
166foreign import ccall "wrapper" mkIOFunc :: (Ptr IOChannel -> CInt -> Ptr () -> IO {#type gboolean#}) -> IO IOFunc
167
168type FD = Int
169
170-- | Adds the file descriptor into the main event loop with the given priority.
171--
172inputAdd ::
173    FD            -- ^ a file descriptor
174 -> [IOCondition] -- ^ the condition to watch for
175 -> Priority      -- ^ the priority of the event source
176 -> IO Bool       -- ^ the function to call when the condition is satisfied.
177                  --   The function should return False if the event source
178                  --   should be removed.
179 -> IO HandlerId  -- ^ the event source id
180inputAdd fd conds pri fun = do
181  funPtr <- mkIOFunc (\_ _ _ -> liftM fromBool fun)
182  channel <- {#call unsafe g_io_channel_unix_new #} (fromIntegral fd)
183  {#call unsafe g_io_add_watch_full#}
184    (IOChannel channel)
185    (fromIntegral pri)
186    ((fromIntegral . fromFlags) conds)
187    funPtr
188    (castFunPtrToPtr funPtr)
189    destroyFunPtr
190
191inputRemove :: HandlerId -> IO ()
192inputRemove id = {#call source_remove#} id >> return ()
193
194-- Standard priorities
195
196#define G_PRIORITY_HIGH            -100
197#define G_PRIORITY_DEFAULT          0
198#define G_PRIORITY_HIGH_IDLE        100
199#define G_PRIORITY_DEFAULT_IDLE     200
200#define G_PRIORITY_LOW              300
201
202-- | Priorities for installing callbacks.
203--
204type Priority = Int
205
206priorityHigh :: Int
207priorityHigh = G_PRIORITY_HIGH
208
209priorityDefault :: Int
210priorityDefault = G_PRIORITY_DEFAULT
211
212priorityHighIdle :: Int
213priorityHighIdle = G_PRIORITY_HIGH_IDLE
214
215priorityDefaultIdle :: Int
216priorityDefaultIdle = G_PRIORITY_DEFAULT_IDLE
217
218priorityLow :: Int
219priorityLow = G_PRIORITY_LOW
220
221-- | A main event loop abstraction.
222{# pointer *GMainLoop as MainLoop foreign newtype #}
223
224-- | An opaque datatype representing a set of sources to be handled in
225--   a main loop.
226{# pointer *GMainContext as MainContext foreign newtype #}
227
228-- | Create a new 'MainLoop'.
229mainLoopNew :: Maybe MainContext -- ^ @context@ - the context to use, or 'Nothing' to use the default context
230            -> Bool              -- ^ @isRunning@ - 'True' to indicate that the loop is running; 'False' otherwise
231            -> IO MainLoop       -- ^ the new 'MainLoop'
232mainLoopNew context isRunning =
233    do let context' = maybe (MainContext nullForeignPtr) id context
234       loopPtr <- {# call main_loop_new #} context' $ fromBool isRunning
235       liftM MainLoop $ newForeignPtr loopPtr mainLoopFinalizer
236foreign import ccall unsafe "&g_main_loop_unref"
237    mainLoopFinalizer :: FunPtr (Ptr MainLoop -> IO ())
238
239-- | Runs a main loop until 'mainLoopQuit' is called on the
240--   loop. If this is called for the thread of the loop's
241--   'MainContext', it will process events from the loop, otherwise it
242--   will simply wait.
243mainLoopRun :: MainLoop
244            -> IO ()
245mainLoopRun loop =
246    {# call main_loop_run #} loop
247
248-- | Stops a 'MainLoop' from running. Any calls to mainLoopRun for the
249--   loop will return.
250mainLoopQuit :: MainLoop
251             -> IO ()
252mainLoopQuit loop =
253    {# call main_loop_quit #} loop
254
255-- | Checks to see if the main loop is currently being run via mainLoopRun.
256mainLoopIsRunning :: MainLoop
257                  -> IO Bool
258mainLoopIsRunning loop =
259    liftM toBool $ {# call main_loop_is_running #} loop
260
261-- | Gets a 'MainLoop's context.
262mainLoopGetContext :: MainLoop
263                   -> MainContext
264mainLoopGetContext loop =
265    MainContext $ unsafePerformIO $
266        {# call main_loop_get_context #} loop >>=
267            flip newForeignPtr mainContextFinalizer
268
269foreign import ccall unsafe "&g_main_context_unref"
270    mainContextFinalizer :: FunPtr (Ptr MainContext -> IO ())
271
272-- | Creates a new 'MainContext'.
273mainContextNew :: IO MainContext
274mainContextNew =
275    newContextMarshal {# call main_context_new #}
276
277-- | The default 'MainContext'. This is the main context used for main
278--   loop functions when a main loop is not explicitly specified.
279mainContextDefault :: MainContext
280mainContextDefault =
281    unsafePerformIO $ newContextMarshal {# call main_context_default #}
282
283newContextMarshal action =
284    do ptr <- action
285       liftM MainContext $ newForeignPtr ptr mainContextFinalizer
286
287-- | Runs a single iteration for the given main loop. This involves
288--   checking to see if any event sources are ready to be processed,
289--   then if no events sources are ready and @mayBlock@ is 'True',
290--   waiting for a source to become ready, then dispatching the
291--   highest priority events sources that are ready. Note that even
292--   when @mayBlock@ is 'True', it is still possible for
293--   'mainContextIteration' to return 'False', since the the wait
294--   may be interrupted for other reasons than an event source
295--   becoming ready.
296mainContextIteration :: MainContext
297                     -> Bool
298                     -> IO Bool
299mainContextIteration context mayBlock =
300    liftM toBool $ {# call main_context_iteration #} context (fromBool mayBlock)
301
302mainContextFindSourceById :: MainContext
303                          -> HandlerId
304                          -> IO Source
305mainContextFindSourceById context id =
306    {# call main_context_find_source_by_id #} context (fromIntegral id) >>= newSource . castPtr
307
308{# pointer *GSource as Source foreign newtype #}
309newSource :: Ptr Source
310          -> IO Source
311newSource sourcePtr =
312    liftM Source $ newForeignPtr sourcePtr sourceFinalizer
313foreign import ccall unsafe "&g_source_unref"
314    sourceFinalizer :: FunPtr (Ptr Source -> IO ())
315
316sourceAttach :: Source
317             -> MainContext
318             -> IO HandlerId
319sourceAttach source context =
320    liftM fromIntegral $ {# call source_attach #} source context
321
322sourceSetPriority :: Source
323                  -> Priority
324                  -> IO ()
325sourceSetPriority source priority =
326    {# call source_set_priority #} source $ fromIntegral priority
327
328sourceGetPriority :: Source
329                  -> IO Priority
330sourceGetPriority source =
331    liftM fromIntegral $ {# call source_get_priority #} source
332
333sourceDestroy :: Source
334              -> IO ()
335sourceDestroy source =
336    {# call source_destroy #} source
337
338#if GLIB_CHECK_VERSION(2,12,0)
339sourceIsDestroyed :: Source
340                  -> IO Bool
341sourceIsDestroyed source =
342    liftM toBool $ {# call source_is_destroyed #} source
343#endif
344
345sourceRemove :: HandlerId
346             -> IO Bool
347sourceRemove tag =
348    liftM toBool $ {# call source_remove #} $ fromIntegral tag
349