htoolkit-cvs

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

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

Added Files:
	CommonDialogs.hs 
Removed Files:
	ColorDialog.hs FileDialog.hs FontDialog.hs 
Log Message:
Replace ColorDialog.hs FileDialog.hs and FontDialog.hs with single CommonDialogs.hs module


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

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

    Standard file selection dialogs.
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.Port.CommonDialogs
           ( runDirectoryDialog
           , runInputFileDialog
           , runInputFilesDialog
           , runOutputFileDialog
           , runColorDialog
           , runFontDialog
           ) where

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

-----------------------------------------------------------------------------------------
-- File Dialogs  
-----------------------------------------------------------------------------------------

-- | Run a dialog to select an input file. Returns 'Nothing' when cancelled.
runInputFileDialog :: String -> [(String,[String])] -> IO (Maybe FilePath)
runInputFileDialog title filter
  = withCString title $ \ctitle ->
    withCFilter filter $ \cfilter ->
    do cin <- osSelectInputFile ctitle cfilter
       maybeCString cin
foreign import ccall osSelectInputFile :: CString -> Ptr CChar -> IO CString

-- | Run a dialog to select multiple input files. Returns empty list when canceled.
runInputFilesDialog :: String -> [(String,[String])] -> IO [FilePath]
runInputFilesDialog title filter
  = withCString title $ \ctitle ->
    withCFilter filter $ \cfilter ->
    do cin <- osSelectInputFiles ctitle cfilter
       peekCStrings cin
foreign import ccall osSelectInputFiles :: CString -> Ptr CChar -> IO (Ptr CChar)

-- | Run a dialog to select an output file. Takes both a dialog title and a 
-- suggested filename as arguments. Returns 'Nothing' when cancelled.
runOutputFileDialog :: String -> [(String,[String])] -> FilePath -> IO (Maybe FilePath)
runOutputFileDialog title filter fname
  = withCString title $ \ctitle ->
    withCString fname $ \cname ->
    withCFilter filter $ \cfilter ->
    do cout <- osSelectOutputFile ctitle cfilter cname
       maybeCString cout
foreign import ccall osSelectOutputFile :: CString -> Ptr CChar -> CString -> IO CString

-- | Runs a dialog to select a directory. Returns 'Nothing' when cancelled.
runDirectoryDialog :: String -> IO (Maybe FilePath)
runDirectoryDialog title
  = do cdir <- withCString title osSelectDirectory
       maybeCString cdir
foreign import ccall osSelectDirectory :: CString -> IO CString

maybeCString :: CString -> IO (Maybe String)
maybeCString cstr
  | cstr == nullPtr = return Nothing
  | otherwise       = do str <- peekCString cstr; free cstr; return (Just str)
  
withCFilter :: [(String,[String])] -> (Ptr CChar -> IO a) -> IO a
withCFilter filter io = 
  let filterSize []               = 2
      filterSize ((name,exts):rs) = (length name+1)+(foldr (\x n -> length x+1+n) 0 exts)+filterSize rs
      
      pokeFilter []               cfilter = do
        pokeElemOff cfilter 0 (castCharToCChar '\0')
        pokeElemOff cfilter 1 (castCharToCChar '\0')
      pokeFilter ((name,exts):rs) cfilter = do
        pokeArray0 (castCharToCChar '\0') cfilter (map castCharToCChar name)
        cfilter <- pokeExts name exts (cfilter `plusPtr` (length name+1))
        pokeFilter rs cfilter
        
      pokeExts name []    cfilter = error ("Filter \"" ++ name ++ "\" has empty list of file extensions")
      pokeExts name [ext] cfilter = do
        pokeArray0 (castCharToCChar '\0') cfilter (map castCharToCChar ext)
        return (cfilter `plusPtr` (length ext+1))
      pokeExts name (ext:exts) cfilter = do
        pokeArray0 (castCharToCChar ';')  cfilter (map castCharToCChar ext)
        pokeExts name exts (cfilter `plusPtr` (length ext+1))
  in
      allocaArray (filterSize filter) $ \cfilter -> do
        pokeFilter filter cfilter
        io cfilter


-----------------------------------------------------------------------------------------
-- Color selection dialog
-----------------------------------------------------------------------------------------

-- | Run a dialog to select a color. Returns 'Nothing' when cancelled.
runColorDialog :: IO (Maybe Color)
runColorDialog = alloca $ \cref -> do
	res <- osRunColorDialog cref
	if res 
	  then do
		c <- peek cref
		return (Just (fromCColor c)) 
	  else return Nothing
foreign import ccall osRunColorDialog :: Ptr CColor -> IO Bool 

-----------------------------------------------------------------------------------------
-- Font selection dialog
-----------------------------------------------------------------------------------------

-- | 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


--- ColorDialog.hs DELETED ---

--- FileDialog.hs DELETED ---

--- FontDialog.hs DELETED ---