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

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

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

Added Files:
	FontDialog.hs 
Log Message:
add implementation for FontDialog


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

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    Standard font selection dialogs.
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.Port.FontDialog( runFontDialog ) where

import Foreign
import Foreign.C
import Graphics.UI.Port.Types

-- | Run a dialog to select a font. Returns 'Nothing' when cancelled.
runFontDialog :: IO (Maybe FontDef)
runFontDialog =
	alloca $ \fnameref ->
	alloca $ \fsizeref ->
	alloca $ \fweightref ->
	alloca $ \fstyleref ->
	alloca $ \funderlineref ->
	alloca $ \fstrikeoutref -> do
		print 1
		res <- osRunFontDialog fnameref fsizeref fweightref fstyleref funderlineref fstrikeoutref
		print 2
		if res 
		 then do
		 	cname <- peek fnameref			
			csize <- peek fsizeref
			cweight <- peek fweightref
			cstyle <- peek fstyleref
			cunderline <- peek funderlineref
			cstrikeout <- peek fstrikeoutref
			fontdef <- fromCFontDef cname csize cweight cstyle cunderline cstrikeout
			free cname
			return (Just fontdef)
		 else return Nothing
foreign import ccall osRunFontDialog :: Ptr CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CBool -> Ptr CBool -> IO Bool