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