[htoolkit-cvs] port/src/Port Bitmap.hs,1.6,1.7 Canvas.hs,1.14,1.15 Font.hs,1.4,1.5 Handlers.hs,1.22,1.23 Types.hs,1.19,1.20 Window.hs,1.11,1.12

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

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

Modified Files:
	Bitmap.hs Canvas.hs Font.hs Handlers.hs Types.hs Window.hs 
Log Message:
Make HToolkit compatible with GHC-6.0


Index: Bitmap.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Bitmap.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Bitmap.hs	30 May 2003 21:46:47 -0000	1.6
--- Bitmap.hs	8 Jun 2003 19:42:14 -0000	1.7
***************
*** 34,40 ****
  
  import Graphics.UI.Port.Types
! import Control.Monad
  import System.IO.Error
- import System.IO( bracket )
  
  {-----------------------------------------------------------------------------------------
--- 34,40 ----
  
  import Graphics.UI.Port.Types
! import Control.Monad(when)
! import Control.Exception(bracket)
  import System.IO.Error
  
  {-----------------------------------------------------------------------------------------

Index: Canvas.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Canvas.hs,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Canvas.hs	30 May 2003 21:46:47 -0000	1.14
--- Canvas.hs	8 Jun 2003 19:42:14 -0000	1.15
***************
*** 58,62 ****
  import Foreign.Marshal.Alloc
  import Foreign.Storable
! import System.IO( bracket )
  
  import Graphics.UI.Port.Types
--- 58,62 ----
  import Foreign.Marshal.Alloc
  import Foreign.Storable
! import Control.Exception( bracket )
  
  import Graphics.UI.Port.Types
***************
*** 382,384 ****
  
  -- | Translate (or move) the canvas in a horizontal and vertical direction.
! foreign import ccall "osTranslateCanvas" translateCanvas :: Double -> Double -> CanvasHandle -> IO ()
\ No newline at end of file
--- 382,384 ----
  
  -- | Translate (or move) the canvas in a horizontal and vertical direction.
! foreign import ccall "osTranslateCanvas" translateCanvas :: Double -> Double -> CanvasHandle -> IO ()

Index: Font.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Font.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Font.hs	30 Jan 2003 21:56:14 -0000	1.4
--- Font.hs	8 Jun 2003 19:42:14 -0000	1.5
***************
*** 1,223 ****
! {-# OPTIONS -fglasgow-exts -#include Font.h #-}
! -----------------------------------------------------------------------------------------
! {-| Module      :  Font
!     Copyright   :  (c) Krasimir Angelov & Daan Leijen 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya... da...@cs...
!     Stability   :  provisional
!     Portability :  portable
! 
!     Fonts.
! -}
! -----------------------------------------------------------------------------------------
! module Graphics.UI.Port.Font
!         ( 
!         -- * Fonts
!           createFont
!         , defaultFont
!         , dialogFont
! 
!         -- * Metrics (on a certain canvas).
!         , getFontMetrics
!         , getFontCharWidth
!         , getFontStringWidth
!         
!         -- * Enumerate fonts
!         , getFontNames, getFontVariants 
! 
!         -- * Standard font definitions.
!         , defaultFontDef
!         , dialogFontDef
!         , serifFontDef
!         , sansSerifFontDef
!         , nonProportionalFontDef
!         , smallFontDef
!         , symbolFontDef
!         ) where
! 
! import Graphics.UI.Port.Types
! 
! import Foreign.C
! import Foreign.Ptr
! import Foreign.Marshal.Alloc
! import Foreign.Storable
! import Foreign.ForeignPtr
! 
! import Data.FiniteMap
! import Data.List( sort, nub )
! import Control.Monad    ( when )
! import System.IO.Unsafe ( unsafePerformIO )
! import System.IO.Error  ( mkIOError, doesNotExistErrorType )
! import System.IO( bracket )
! 
! 
! {-----------------------------------------------------------------------------------------
!   Create
! -----------------------------------------------------------------------------------------}
! -- | Create a new font from a font definition.
! createFont :: FontDef -> IO Font
! createFont fontDef
!   = withCFontDef fontDef $ \cname csize cweight cstyle cunderline cstrikeout ->
!     do handle <- osCreateFont cname csize cweight cstyle cunderline cstrikeout
!        when (nullPtr == handle) (ioError (mkIOError doesNotExistErrorType "createFont" Nothing (Just (show fontDef))))
!        fromCFont fontDef handle
! foreign import ccall osCreateFont :: CString -> CInt -> CInt -> CInt -> CBool -> CBool -> IO FontHandle
! 
! 
! 
! {-----------------------------------------------------------------------------------------
!   Font properties
! -----------------------------------------------------------------------------------------}
! 
! insertUniq :: (Ord a) => a -> [a] -> [a]
! insertUniq a list@(b:x)
! 	| a<b       = a:list
! 	| a>b       = b:(insertUniq a x)
! 	| otherwise = list
! insertUniq a _ = [a]
! 		
! sortAndRemoveDuplicates :: (Ord a) => [a] -> [a]
! sortAndRemoveDuplicates (e:es) = insertUniq e (sortAndRemoveDuplicates es)
! sortAndRemoveDuplicates _ = []
! 
! -- | Enumerate all the available font names.
! getFontNames :: IO [FontName]
! getFontNames 
!   = do names <- resultCStrings (osGetAvailableFontNames)
!        return (sortAndRemoveDuplicates names)
! foreign import ccall osGetAvailableFontNames :: IO CString;
! 		  
! -- | The expression (@getFontVariants fontname min max@) returns all avaiable font definitions
! -- where the font name is @fontname@ and the font size is between @min@ and @max@ (inclusive).
! -- The keys in the returned map are all posible combinations between weight and style,
! -- and the value coresponding to them in the map is a list of sizes for which this combination is
! -- available.
! getFontVariants :: FontName -> FontSize -> FontSize -> IO (FiniteMap (FontWeight, FontStyle) [FontSize])
! getFontVariants fontname low high
! 	= withCString fontname $ \cname ->
! 	  bracket (osGetAvailableFontVariants cname (toCInt low') (toCInt high')) free decodeVariants
! 	where
! 		low'  = max low  2
! 		high' = max high 2
! 		allFontSizes = [low'..high']
! 		
! 		decodeVariants :: Ptr CInt -> IO (FiniteMap (FontWeight, FontStyle) [FontSize])
! 		decodeVariants pints 
! 			| pints == nullPtr = ioError (mkIOError doesNotExistErrorType "getFontVariants" Nothing (Just ("\"" ++ fontname ++ "\" fonts family")))
! 		decodeVariants pints = do
! 			cweight <- peekElemOff pints 0
! 			if cweight == 0
! 			  then return emptyFM
! 			  else do
! 			  	cstyle  <- peekElemOff pints 1
! 			  	csize   <- peekElemOff pints 2
! 				variants <- decodeVariants (pints `plusPtr` (sizeOf cweight * 3))
! 				let sizes = if csize == 0 then allFontSizes else [fromCInt csize]
! 				return (addToFM_C (foldr insertUniq) variants (fromCWeight cweight,fromCStyle cstyle) sizes)
! foreign import ccall osGetAvailableFontVariants :: CString -> CInt -> CInt -> IO (Ptr CInt);
! 
! {-----------------------------------------------------------------------------------------
!   Font metrics
! -----------------------------------------------------------------------------------------}
! -- | Get the font metrics of a specified font. 
! getFontMetrics :: Font -> CanvasHandle -> IO FontMetrics
! getFontMetrics font canvas
!   = withCFont font $ \cfont ->
!     withCFontMetricsResult $ \pascent pdescent pmaxwidth pleading ->
!     osGetFontMetrics cfont canvas pascent pdescent pmaxwidth pleading
! foreign import ccall osGetFontMetrics :: FontHandle -> CanvasHandle -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! -- | Get the pixel width of a character.
! getFontCharWidth :: Font -> Char -> CanvasHandle -> IO Int
! getFontCharWidth font c canvas
!   = withCFont font $ \cfont ->
!     do cw <- osGetFontCharWidth (toCChar c) cfont canvas
!        return (fromCInt cw)
! foreign import ccall osGetFontCharWidth :: CChar -> FontHandle -> CanvasHandle -> IO CInt
! 	
! -- | Get the pixel width of a string.
! getFontStringWidth :: Font -> String -> CanvasHandle -> IO Int
! getFontStringWidth font str canvas
!   = withCFont font $ \cfont ->
!     withCString str $ \cstr ->
!     do cw <- osGetFontStringWidth cstr cfont canvas
!        return (fromCInt cw)
! foreign import ccall osGetFontStringWidth :: CString -> FontHandle -> CanvasHandle -> IO CInt
! 
! 
! {-----------------------------------------------------------------------------------------
!   Default fonts
! -----------------------------------------------------------------------------------------}
! {-# NOINLINE defaultFont #-}
! -- | The default window font.
! defaultFont :: Font
! defaultFont 
!   = unsafePerformIO $
!     createFont defaultFontDef
! 
! {-# NOINLINE dialogFont #-}
! -- | The default dialog font.
! dialogFont :: Font
! dialogFont 
!   = unsafePerformIO $
!     createFont dialogFontDef
! 
! {-# NOINLINE defaultFontDef #-}
! defaultFontDef :: FontDef
! defaultFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osDefaultFontDef pname psize pweight pstyle
! foreign import ccall osDefaultFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE dialogFontDef #-}
! dialogFontDef :: FontDef
! dialogFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout  -> 
!     osDialogFontDef pname psize pweight pstyle
! foreign import ccall osDialogFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE serifFontDef #-}
! serifFontDef :: FontDef
! serifFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSerifFontDef pname psize pweight pstyle
! foreign import ccall osSerifFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE sansSerifFontDef #-}
! sansSerifFontDef :: FontDef
! sansSerifFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSansSerifFontDef pname psize pweight pstyle
! foreign import ccall osSansSerifFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE smallFontDef #-}
! smallFontDef :: FontDef
! smallFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSmallFontDef pname psize pweight pstyle
! foreign import ccall osSmallFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE nonProportionalFontDef #-}
! nonProportionalFontDef :: FontDef
! nonProportionalFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osNonProportionalFontDef pname psize pweight pstyle
! foreign import ccall osNonProportionalFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE symbolFontDef #-}
! symbolFontDef :: FontDef
! symbolFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSymbolFontDef pname psize pweight pstyle
! foreign import ccall osSymbolFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! 
! 
--- 1,223 ----
! {-# OPTIONS -fglasgow-exts -#include Font.h #-}
! -----------------------------------------------------------------------------------------
! {-| Module      :  Font
!     Copyright   :  (c) Krasimir Angelov & Daan Leijen 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya... da...@cs...
!     Stability   :  provisional
!     Portability :  portable
! 
!     Fonts.
! -}
! -----------------------------------------------------------------------------------------
! module Graphics.UI.Port.Font
!         ( 
!         -- * Fonts
!           createFont
!         , defaultFont
!         , dialogFont
! 
!         -- * Metrics (on a certain canvas).
!         , getFontMetrics
!         , getFontCharWidth
!         , getFontStringWidth
!         
!         -- * Enumerate fonts
!         , getFontNames, getFontVariants 
! 
!         -- * Standard font definitions.
!         , defaultFontDef
!         , dialogFontDef
!         , serifFontDef
!         , sansSerifFontDef
!         , nonProportionalFontDef
!         , smallFontDef
!         , symbolFontDef
!         ) where
! 
! import Graphics.UI.Port.Types
! 
! import Foreign.C
! import Foreign.Ptr
! import Foreign.Marshal.Alloc
! import Foreign.Storable
! import Foreign.ForeignPtr
! 
! import Data.FiniteMap
! import Data.List( sort, nub )
! import Control.Monad    ( when )
! import Control.Exception ( bracket )
! import System.IO.Unsafe ( unsafePerformIO )
! import System.IO.Error  ( mkIOError, doesNotExistErrorType )
! 
! 
! {-----------------------------------------------------------------------------------------
!   Create
! -----------------------------------------------------------------------------------------}
! -- | Create a new font from a font definition.
! createFont :: FontDef -> IO Font
! createFont fontDef
!   = withCFontDef fontDef $ \cname csize cweight cstyle cunderline cstrikeout ->
!     do handle <- osCreateFont cname csize cweight cstyle cunderline cstrikeout
!        when (nullPtr == handle) (ioError (mkIOError doesNotExistErrorType "createFont" Nothing (Just (show fontDef))))
!        fromCFont fontDef handle
! foreign import ccall osCreateFont :: CString -> CInt -> CInt -> CInt -> CBool -> CBool -> IO FontHandle
! 
! 
! 
! {-----------------------------------------------------------------------------------------
!   Font properties
! -----------------------------------------------------------------------------------------}
! 
! insertUniq :: (Ord a) => a -> [a] -> [a]
! insertUniq a list@(b:x)
! 	| a<b       = a:list
! 	| a>b       = b:(insertUniq a x)
! 	| otherwise = list
! insertUniq a _ = [a]
! 		
! sortAndRemoveDuplicates :: (Ord a) => [a] -> [a]
! sortAndRemoveDuplicates (e:es) = insertUniq e (sortAndRemoveDuplicates es)
! sortAndRemoveDuplicates _ = []
! 
! -- | Enumerate all the available font names.
! getFontNames :: IO [FontName]
! getFontNames 
!   = do names <- resultCStrings (osGetAvailableFontNames)
!        return (sortAndRemoveDuplicates names)
! foreign import ccall osGetAvailableFontNames :: IO CString;
! 		  
! -- | The expression (@getFontVariants fontname min max@) returns all avaiable font definitions
! -- where the font name is @fontname@ and the font size is between @min@ and @max@ (inclusive).
! -- The keys in the returned map are all posible combinations between weight and style,
! -- and the value coresponding to them in the map is a list of sizes for which this combination is
! -- available.
! getFontVariants :: FontName -> FontSize -> FontSize -> IO (FiniteMap (FontWeight, FontStyle) [FontSize])
! getFontVariants fontname low high
! 	= withCString fontname $ \cname ->
! 	  bracket (osGetAvailableFontVariants cname (toCInt low') (toCInt high')) free decodeVariants
! 	where
! 		low'  = max low  2
! 		high' = max high 2
! 		allFontSizes = [low'..high']
! 		
! 		decodeVariants :: Ptr CInt -> IO (FiniteMap (FontWeight, FontStyle) [FontSize])
! 		decodeVariants pints 
! 			| pints == nullPtr = ioError (mkIOError doesNotExistErrorType "getFontVariants" Nothing (Just ("\"" ++ fontname ++ "\" fonts family")))
! 		decodeVariants pints = do
! 			cweight <- peekElemOff pints 0
! 			if cweight == 0
! 			  then return emptyFM
! 			  else do
! 			  	cstyle  <- peekElemOff pints 1
! 			  	csize   <- peekElemOff pints 2
! 				variants <- decodeVariants (pints `plusPtr` (sizeOf cweight * 3))
! 				let sizes = if csize == 0 then allFontSizes else [fromCInt csize]
! 				return (addToFM_C (foldr insertUniq) variants (fromCWeight cweight,fromCStyle cstyle) sizes)
! foreign import ccall osGetAvailableFontVariants :: CString -> CInt -> CInt -> IO (Ptr CInt);
! 
! {-----------------------------------------------------------------------------------------
!   Font metrics
! -----------------------------------------------------------------------------------------}
! -- | Get the font metrics of a specified font. 
! getFontMetrics :: Font -> CanvasHandle -> IO FontMetrics
! getFontMetrics font canvas
!   = withCFont font $ \cfont ->
!     withCFontMetricsResult $ \pascent pdescent pmaxwidth pleading ->
!     osGetFontMetrics cfont canvas pascent pdescent pmaxwidth pleading
! foreign import ccall osGetFontMetrics :: FontHandle -> CanvasHandle -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! -- | Get the pixel width of a character.
! getFontCharWidth :: Font -> Char -> CanvasHandle -> IO Int
! getFontCharWidth font c canvas
!   = withCFont font $ \cfont ->
!     do cw <- osGetFontCharWidth (toCChar c) cfont canvas
!        return (fromCInt cw)
! foreign import ccall osGetFontCharWidth :: CChar -> FontHandle -> CanvasHandle -> IO CInt
! 	
! -- | Get the pixel width of a string.
! getFontStringWidth :: Font -> String -> CanvasHandle -> IO Int
! getFontStringWidth font str canvas
!   = withCFont font $ \cfont ->
!     withCString str $ \cstr ->
!     do cw <- osGetFontStringWidth cstr cfont canvas
!        return (fromCInt cw)
! foreign import ccall osGetFontStringWidth :: CString -> FontHandle -> CanvasHandle -> IO CInt
! 
! 
! {-----------------------------------------------------------------------------------------
!   Default fonts
! -----------------------------------------------------------------------------------------}
! {-# NOINLINE defaultFont #-}
! -- | The default window font.
! defaultFont :: Font
! defaultFont 
!   = unsafePerformIO $
!     createFont defaultFontDef
! 
! {-# NOINLINE dialogFont #-}
! -- | The default dialog font.
! dialogFont :: Font
! dialogFont 
!   = unsafePerformIO $
!     createFont dialogFontDef
! 
! {-# NOINLINE defaultFontDef #-}
! defaultFontDef :: FontDef
! defaultFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osDefaultFontDef pname psize pweight pstyle
! foreign import ccall osDefaultFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE dialogFontDef #-}
! dialogFontDef :: FontDef
! dialogFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout  -> 
!     osDialogFontDef pname psize pweight pstyle
! foreign import ccall osDialogFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE serifFontDef #-}
! serifFontDef :: FontDef
! serifFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSerifFontDef pname psize pweight pstyle
! foreign import ccall osSerifFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE sansSerifFontDef #-}
! sansSerifFontDef :: FontDef
! sansSerifFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSansSerifFontDef pname psize pweight pstyle
! foreign import ccall osSansSerifFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE smallFontDef #-}
! smallFontDef :: FontDef
! smallFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSmallFontDef pname psize pweight pstyle
! foreign import ccall osSmallFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE nonProportionalFontDef #-}
! nonProportionalFontDef :: FontDef
! nonProportionalFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osNonProportionalFontDef pname psize pweight pstyle
! foreign import ccall osNonProportionalFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! {-# NOINLINE symbolFontDef #-}
! symbolFontDef :: FontDef
! symbolFontDef 
!   = unsafePerformIO $ 
!     withCFontDefResult $ \pname psize pweight pstyle punderline pstrikeout -> 
!     osSymbolFontDef pname psize pweight pstyle
! foreign import ccall osSymbolFontDef :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
! 
! 
! 

Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** Handlers.hs	27 Apr 2003 18:19:13 -0000	1.22
--- Handlers.hs	8 Jun 2003 19:42:14 -0000	1.23
***************
*** 37,41 ****
                  ,setTimerHandler,            setTimerDefHandler,            getTimerHandler
                  ,setTimerDestroyHandler,     setTimerDestroyDefHandler,     getTimerDestroyHandler
-                 ,getAllTimerHandles
                  
                  -- * Windows
--- 37,40 ----

Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** Types.hs	1 Jun 2003 13:00:10 -0000	1.19
--- Types.hs	8 Jun 2003 19:42:15 -0000	1.20
***************
*** 1,3 ****
! {-# OPTIONS -fglasgow-exts -#include Font.h -#include Bitmap.h #-} 
  -- the previous line is just needed for "osDeleteFont" and "osDeleteBitmap" :-(
  -- #hide 
--- 1,3 ----
! {-# OPTIONS -fglasgow-exts -#include Font.h -#include Bitmap.h #-}
  -- the previous line is just needed for "osDeleteFont" and "osDeleteBitmap" :-(
  -- #hide 
***************
*** 116,120 ****
  import Foreign.C
  import Foreign.Marshal.Alloc
! import System.IO( bracket )
  import Data.Bits
  import Graphics.UI.Port.Colors
--- 116,120 ----
  import Foreign.C
  import Foreign.Marshal.Alloc
! import Control.Exception( bracket )
  import Data.Bits
  import Graphics.UI.Port.Colors
***************
*** 854,860 ****
  fromCBitmap :: BitmapHandle -> IO Bitmap
  fromCBitmap bh
!   = do bm <- newForeignPtr bh (osDeleteBitmap bh)
         return (Bitmap bm)
! foreign import ccall osDeleteBitmap :: BitmapHandle -> IO ()
  
  withCBitmap :: Bitmap -> (BitmapHandle -> IO a) -> IO a
--- 854,860 ----
  fromCBitmap :: BitmapHandle -> IO Bitmap
  fromCBitmap bh
!   = do bm <- newForeignPtr bh osDeleteBitmap
         return (Bitmap bm)
! foreign import ccall "&osDeleteBitmap" osDeleteBitmap :: FinalizerPtr BH
  
  withCBitmap :: Bitmap -> (BitmapHandle -> IO a) -> IO a
***************
*** 941,947 ****
  fromCFont :: FontDef -> FontHandle -> IO Font
  fromCFont fontdef handle
!   = do fhandle <- newForeignPtr handle (osDeleteFont handle)
         return (Font fhandle fontdef)
! foreign import ccall osDeleteFont :: FontHandle -> IO ()
  
  toCStyle :: FontStyle -> CInt
--- 941,947 ----
  fromCFont :: FontDef -> FontHandle -> IO Font
  fromCFont fontdef handle
!   = do fhandle <- newForeignPtr handle osDeleteFont
         return (Font fhandle fontdef)
! foreign import ccall "&osDeleteFont" osDeleteFont :: FinalizerPtr FH
  
  toCStyle :: FontStyle -> CInt

Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Window.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Window.hs	30 May 2003 21:46:47 -0000	1.11
--- Window.hs	8 Jun 2003 19:42:15 -0000	1.12
***************
*** 40,45 ****
  import Foreign.Ptr
  import Foreign.Marshal.Alloc
- import System.IO( bracket )
  import System.IO.Unsafe( unsafePerformIO )
  import Control.Concurrent.MVar
  import Control.Monad(when)
--- 40,45 ----
  import Foreign.Ptr
  import Foreign.Marshal.Alloc
  import System.IO.Unsafe( unsafePerformIO )
+ import Control.Exception( bracket )
  import Control.Concurrent.MVar
  import Control.Monad(when)