--
-- |
-- Module      : WXExts
-- Authors     : Sean Seefried (http://www.cse.unsw.edu.au/~sseefried)
-- Copyright   : (c) 2005
-- License     : BSD3
-- Created     : 29 Jun 2005
--
--
-- Some extensions to wxHaskell
--
module WXExts
where

import Data.List
import Graphics.UI.WXCore

-- Local imports
import Utils

--
-- Wildcards for accepted image file formats
--
imageFileFormats = [ ("PNG",    ["*.png"])
                   , ("JPEG",   ["*.jpeg", "*.jpg"])
                   , ("GIF",    ["*.gif"])
                   , ("Bitmap", ["*.bmp"])
                   , ("PCX",    ["*.pcx"])
                   , ("PNM",    ["*.pnm"])
                   , ("TIFF",   ["*.tiff", "*.tif"])
                   , ("XPM",    ["*.xpm"])
                   ]

--
-- Returns the image filetype as well
--
fileSaveDialogImage :: Window a -> Bool -> Bool -> String 
                    -> IO (Maybe (FilePath, Int))
fileSaveDialogImage parent rememberCurrentDir overwritePrompt message 
  = fileDialog parent result flags message imageFileFormats "" "untitled.png"
  where
    flags
      = wxSAVE .+. (if rememberCurrentDir then wxCHANGE_DIR else 0) .+. 
                   (if overwritePrompt then wxOVERWRITE_PROMPT else 0)
    result fd r
      = if (r /= wxID_OK)
         then return Nothing
         else do fname <- fileDialogGetPath fd
                 i     <- fileDialogGetFilterIndex fd
                 let fileType = imageTypeFromFileName
                                     ((head . snd) (imageFileFormats !! i))
                 return (Just (fname, fileType))




wildCardsToExtList :: String -> [String]
wildCardsToExtList str = map toFirstExt wildCards
  where
    wildCards = dropOdds (map tail (splitAtIndices indices str))
    indices   = findIndices (=='|') str

--
-- Takes a string of the form "*.xxx;*.yyy;*.zzz[...]" and returns the ".xxx"
--
toFirstExt :: String -> String
toFirstExt "" = error "toFirstExt: Empty string"
toFirstExt ('*':'.':rest) = '.' : takeWhile (/= ';') rest
toFirstExt _ = error "toFirstExt: Wildcard doesn't begin with a *"


dropOdds :: [a] -> [a]
dropOdds = dropOdds' True
  where dropOdds' _ [] = []
        dropOdds' True (x:xs)  = dropOdds' False xs
        dropOdds' False (x:xs) = x:dropOdds' True xs


splitAtIndices :: [Int] -> [a] -> [[a]]
splitAtIndices []     str = [str]
splitAtIndices (i:is) str =
  case splitAt i str of
    ([], _) -> []
    (first, []) -> [first]
    (first, second) -> first : splitAtIndices (map (\x -> x - i) is) second