[htoolkit-cvs] port/src/Port Process.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv19641/port/src/Port

Added Files:
	Process.hs 
Log Message:
The process related features are extracted into newly created module "Process". Added new process attribute "title" instead of title as parameter.


--- NEW FILE: Process.hs ---
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------------------
{-| Module      :  Process
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.Port.Process
	( start, quit, halt
	, getProcessTitle, setProcessTitle
	) where

import Graphics.UI.Port.Types
import Graphics.UI.Port.Window
import Graphics.UI.Port.Timer
import Graphics.UI.Port.Handlers
import Foreign.C
import System.Mem( performGC )
import Control.Monad(when)

-- | Start the event loop. Runs until 'quit' is called.
start :: DocumentInterface -> IO a -> IO a
start di io = do
	osInit (toCDocumentInterface di)
	setProcessDismissHandler (quit >> return ())
	r <- io
	osStart
	return r
	
-- | 'quit' exits the main event loop, closes any windows and menus, destroys all timers
-- and unregisters any event handlers. This function is automatically called when all
-- windows are closed.
quit :: IO Bool
quit = do
	r <- dismissAllWindows
	when r $ do
		destroyAllTimers
		osQuit
		performGC                -- to release any foreign objects
	return r
		
-- | 'quit' exits the main event loop, closes any windows and menus, destroys all timers
-- and unregisters any event handlers. This function is automatically called when all
-- windows are closed.
halt :: IO ()
halt = do
	destroyAllWindows
	destroyAllTimers
	osQuit
	performGC                -- to release any foreign objects

foreign import ccall "osInit"  osInit  :: CInt -> IO ()
foreign import ccall "osStart" osStart :: IO ()
foreign import ccall osQuit :: IO ()

getProcessTitle = osGetProcessTitle >>= peekCString
foreign import ccall osGetProcessTitle :: IO CString

setProcessTitle appName = withCString appName osSetProcessTitle
foreign import ccall osSetProcessTitle :: CString -> IO ()