[htoolkit-cvs] port/src/Port Controls.hs,1.19,1.20 Handlers.hs,1.28,1.29

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

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

Modified Files:
	Controls.hs Handlers.hs 
Log Message:
Add support for icons in Notebook


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Controls.hs,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** Controls.hs	24 Aug 2003 13:57:34 -0000	1.19
--- Controls.hs	30 Aug 2003 22:57:46 -0000	1.20
***************
*** 95,99 ****
  	   -- * NotebookPage
  	   , insertNotebookPage
! 	   , getNotebookPageTitle, setNotebookPageTitle
  	   , getNotebookPagePos
  	   , destroyNotebookPage
--- 95,100 ----
  	   -- * NotebookPage
  	   , insertNotebookPage
! 	   , getNotebookPageTitle,  setNotebookPageTitle
! 	   , getNotebookPageBitmap, setNotebookPageBitmap
  	   , getNotebookPagePos
  	   , destroyNotebookPage
***************
*** 103,109 ****
  import Foreign
  import Foreign.C
  import Graphics.UI.Port.Types
  import Graphics.UI.Port.Handlers  -- just for haddock
! import Data.Maybe(fromMaybe)
  
  -----------------------------------------------------------------------------------------
--- 104,112 ----
  import Foreign
  import Foreign.C
+ import Control.Concurrent.MVar
+ import Data.Maybe(fromMaybe)
  import Graphics.UI.Port.Types
  import Graphics.UI.Port.Handlers  -- just for haddock
! import Graphics.UI.Port.PtrMap as PtrMap
  
  -----------------------------------------------------------------------------------------
***************
*** 500,501 ****
--- 503,520 ----
  getNotebookPageSize hwnd = withCSizeResult (osGetNotebookPageSize hwnd)
  foreign import ccall osGetNotebookPageSize :: WindowHandle -> Ptr CInt -> IO ()
+ 
+ setNotebookPageBitmap :: WindowHandle -> Maybe Bitmap -> IO ()
+ setNotebookPageBitmap hwnd (Just bmp) = do
+   map <- takeMVar windowBitmaps
+   withCBitmap bmp (osSetNotebookPageBitmap hwnd)
+   putMVar windowBitmaps (insert hwnd bmp map)
+ setNotebookPageBitmap hwnd Nothing    = do
+   map <- takeMVar windowBitmaps
+   osSetNotebookPageBitmap hwnd nullPtr
+   putMVar windowBitmaps (delete hwnd map)
+ foreign import ccall osSetNotebookPageBitmap :: WindowHandle -> BitmapHandle -> IO ()
+ 
+ getNotebookPageBitmap :: WindowHandle -> IO (Maybe Bitmap)
+ getNotebookPageBitmap hwnd = do
+   map <- readMVar windowBitmaps
+   return (PtrMap.lookup hwnd map)

Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -d -r1.28 -r1.29
*** Handlers.hs	25 Aug 2003 17:35:49 -0000	1.28
--- Handlers.hs	30 Aug 2003 22:57:46 -0000	1.29
***************
*** 60,71 ****
                  ,setMenuUpdateHandler,  setMenuUpdateDefHandler,  getMenuUpdateHandler
                  ,setMenuDestroyHandler, setMenuDestroyDefHandler, getMenuDestroyHandler
!                 -- ** Internals
!                 ,menuBitmaps 
!                 
                  -- * ToolBar events
                  ,setToolCommandHandler, setToolCommandDefHandler, getToolCommandHandler
  		,setToolDestroyHandler,     setToolDestroyDefHandler,    getToolDestroyHandler
  		-- ** Internals
! 		,toolBitmaps
                  ) where
  
--- 60,70 ----
                  ,setMenuUpdateHandler,  setMenuUpdateDefHandler,  getMenuUpdateHandler
                  ,setMenuDestroyHandler, setMenuDestroyDefHandler, getMenuDestroyHandler
! 
                  -- * ToolBar events
                  ,setToolCommandHandler, setToolCommandDefHandler, getToolCommandHandler
  		,setToolDestroyHandler,     setToolDestroyDefHandler,    getToolDestroyHandler
+ 
  		-- ** Internals
! 		,toolBitmaps, menuBitmaps, windowBitmaps
                  ) where
  
***************
*** 167,170 ****
--- 166,173 ----
    = unsafePerformIO (newMVar empty)
  
+ {-# NOINLINE windowBitmaps #-}
+ windowBitmaps :: MVar (PtrMap WindowHandle Bitmap)
+ windowBitmaps = unsafePerformIO (newMVar empty)
+ 
  setWindowDestroyHandler :: WindowHandle -> IO () -> IO ()
  setWindowDestroyHandler hwnd handler
***************
*** 189,192 ****
--- 192,197 ----
           Nothing -> return ()
           Just io -> safeio io
+        map <- takeMVar windowBitmaps
+        putMVar windowBitmaps (delete hwnd map)
         unregisterWindow hwnd