[htoolkit-cvs] port/src/Port Handlers.hs,1.30,1.31 StatusBar.hs,1.4,1.5 Types.hs,1.33,1.34

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

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

Modified Files:
	Handlers.hs StatusBar.hs Types.hs 
Log Message:
Added support for status bar indicators. (Linux only)


Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** Handlers.hs	12 Oct 2003 21:33:46 -0000	1.30
--- Handlers.hs	16 Nov 2003 13:25:20 -0000	1.31
***************
*** 18,22 ****
  -}
  -----------------------------------------------------------------------------------------
! module Graphics.UI.Port.Handlers 
                  (
                  -- * Clean up
--- 18,22 ----
  -}
  -----------------------------------------------------------------------------------------
! module Graphics.UI.Port.Handlers
                  (
                  -- * Clean up
***************
*** 63,66 ****
--- 63,70 ----
  		,setToolDestroyHandler,     setToolDestroyDefHandler,    getToolDestroyHandler
  
+ 		-- * Indicator events
+                 ,setIndicatorCommandHandler, setIndicatorCommandDefHandler, getIndicatorCommandHandler
+ 		,setIndicatorDestroyHandler,     setIndicatorDestroyDefHandler,    getIndicatorDestroyHandler
+ 
  		-- ** Internals
  		,toolBitmaps, menuBitmaps, windowBitmaps
***************
*** 749,752 ****
--- 753,817 ----
           Just io -> safeio io
  
+ -----------------------------------------------------------------------------------------
+ -- IndicatorCommand
+ -----------------------------------------------------------------------------------------
+ 
+ {-# NOINLINE handlersIndicatorCommand #-}
+ handlersIndicatorCommand :: MVar (PtrMap IndicatorHandle (IO ()))
+ handlersIndicatorCommand
+   = unsafePerformIO (newMVar empty)
+ 
+ handleIndicatorCommand :: IndicatorHandle -> IO ()
+ handleIndicatorCommand hindicator
+   = invokeHandler hindicator handlersIndicatorCommand id
+ 
+ setIndicatorCommandHandler :: IndicatorHandle -> IO () -> IO ()
+ setIndicatorCommandHandler hindicator handler
+   = setHandler hindicator handler handlersIndicatorCommand
+ 
+ setIndicatorCommandDefHandler :: IndicatorHandle -> IO ()
+ setIndicatorCommandDefHandler hindicator
+   = setDefHandler hindicator handlersIndicatorCommand
+ 
+ getIndicatorCommandHandler :: IndicatorHandle -> IO (IO ())
+ getIndicatorCommandHandler hindicator
+   = getHandler hindicator (return ()) handlersIndicatorCommand
+ 
+ -----------------------------------------------------------------------------------------
+ -- IndicatorDestroy
+ -----------------------------------------------------------------------------------------
+ 
+ {-# NOINLINE indicatorBitmaps #-}
+ indicatorBitmaps :: MVar (PtrMap IndicatorHandle Bitmap)
+ indicatorBitmaps = unsafePerformIO (newMVar empty)
+ 
+ {-# NOINLINE handlersIndicatorDestroy #-}
+ handlersIndicatorDestroy :: MVar (PtrMap IndicatorHandle (IO ()))
+ handlersIndicatorDestroy
+   = unsafePerformIO (newMVar empty)
+ 
+ setIndicatorDestroyHandler :: IndicatorHandle -> IO () -> IO ()
+ setIndicatorDestroyHandler hindicator handler
+   = setHandler hindicator handler handlersIndicatorDestroy
+ 
+ setIndicatorDestroyDefHandler :: IndicatorHandle -> IO ()
+ setIndicatorDestroyDefHandler hindicator
+   = setDefHandler hindicator handlersIndicatorDestroy
+ 
+ getIndicatorDestroyHandler :: IndicatorHandle -> IO (IO ())
+ getIndicatorDestroyHandler hindicator
+   = getHandler hindicator (return ()) handlersIndicatorDestroy
+ 
+ handleIndicatorDestroy :: IndicatorHandle -> IO ()
+ handleIndicatorDestroy hindicator
+   = do map <- takeMVar handlersIndicatorDestroy
+        bmps <- takeMVar indicatorBitmaps
+        putMVar indicatorBitmaps (delete hindicator bmps)
+        setIndicatorCommandDefHandler hindicator
+        putMVar handlersIndicatorDestroy (delete hindicator map)
+        case lookup hindicator map of
+          Nothing -> return ()
+          Just io -> safeio io
+ 
  {-----------------------------------------------------------------------------------------
    foreign exports
***************
*** 772,774 ****
  foreign export ccall handleProcessDestroy :: IO ()
  foreign export ccall handleToolCommand :: ToolHandle -> IO ()
! foreign export ccall handleToolDestroy :: ToolHandle -> IO ()
\ No newline at end of file
--- 837,841 ----
  foreign export ccall handleProcessDestroy :: IO ()
  foreign export ccall handleToolCommand :: ToolHandle -> IO ()
! foreign export ccall handleToolDestroy :: ToolHandle -> IO ()
! foreign export ccall handleIndicatorCommand :: IndicatorHandle -> IO ()
! foreign export ccall handleIndicatorDestroy :: IndicatorHandle -> IO ()

Index: StatusBar.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/StatusBar.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** StatusBar.hs	16 Nov 2003 09:01:58 -0000	1.4
--- StatusBar.hs	16 Nov 2003 13:25:20 -0000	1.5
***************
*** 8,26 ****
      Stability   :  provisional
      Portability :  portable
!     
      Defines an API for status bar creation.
      A status bar is a horizontal band at the bottom of an application window
!     in which the application can display various kinds of status information.    
  
  -}
  -----------------------------------------------------------------------------------------
  module Graphics.UI.Port.StatusBar
! 	( setStatusBarVisible,  getStatusBarVisible	
! 	, setStatusBarTitle,    getStatusBarTitle
  	, pushStatusBarContext, popStatusBarContext
  	) where
  
  import Foreign
  import Foreign.C
  import Graphics.UI.Port.Types
  
--- 8,33 ----
      Stability   :  provisional
      Portability :  portable
! 
      Defines an API for status bar creation.
      A status bar is a horizontal band at the bottom of an application window
!     in which the application can display various kinds of status information.
  
  -}
  -----------------------------------------------------------------------------------------
  module Graphics.UI.Port.StatusBar
! 	( -- * StatusBar
! 	  setStatusBarVisible,  getStatusBarVisible
! 	, setStatusBarTitle,     getStatusBarTitle
  	, pushStatusBarContext, popStatusBarContext
+ 
+ 	  -- * Indicator
+ 	, createIndicator
+ 	, destroyIndicator
+ 	, setIndicatorTitle, getIndicatorTitle
  	) where
  
  import Foreign
  import Foreign.C
+ import Data.Maybe( fromMaybe )
  import Graphics.UI.Port.Types
  
***************
*** 47,48 ****
--- 54,74 ----
  -- message, if any.  It is fine to call this with an empty stack.
  foreign import ccall "osPopStatusBarContext"  popStatusBarContext :: IO ()
+ 
+ 
+ --------------------------------------------------------------------
+ -- Status bar indicators
+ --------------------------------------------------------------------
+ 
+ createIndicator :: Maybe Int -> IO IndicatorHandle
+ createIndicator pos = osCreateIndicator (fromMaybe (-1) pos)
+ foreign import ccall osCreateIndicator :: Int -> IO IndicatorHandle
+ 
+ foreign import ccall "osDestroyIndicator" destroyIndicator :: IndicatorHandle -> IO ()
+ 
+ getIndicatorTitle :: IndicatorHandle -> IO String
+ getIndicatorTitle hwnd = resultCString (osGetIndicatorTitle hwnd)
+ foreign import ccall osGetIndicatorTitle :: IndicatorHandle -> IO CString
+ 
+ setIndicatorTitle :: IndicatorHandle -> String -> IO ()
+ setIndicatorTitle hwnd title = withCString title (osSetIndicatorTitle hwnd)
+ foreign import ccall osSetIndicatorTitle :: IndicatorHandle -> CString -> IO ()

Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** Types.hs	25 Aug 2003 20:41:08 -0000	1.33
--- Types.hs	16 Nov 2003 13:25:20 -0000	1.34
***************
*** 82,86 ****
              , BitmapHandle
              , TimerHandle
! 	    , ToolHandle
              , nullHandle
  
--- 82,87 ----
              , BitmapHandle
              , TimerHandle
!             , ToolHandle
!             , IndicatorHandle
              , nullHandle
  
***************
*** 109,113 ****
              , toCPositionType, fromCPositionType
  
!             , fromCInt, toCInt 
              , CWord, fromCWord, toCWord
              , CBool, fromCBool, toCBool
--- 110,114 ----
              , toCPositionType, fromCPositionType
  
!             , fromCInt, toCInt
              , CWord, fromCWord, toCWord
              , CBool, fromCBool, toCBool
***************
*** 153,156 ****
--- 154,161 ----
  type ToolHandle = Ptr TLH
  data TLH = TLH
+ 
+ -- | Abstract handle to a indicator in the status bar
+ type IndicatorHandle = Ptr IH
+ data IH = IH
  
  -- | A null handle. Use with care.