{-# LANGUAGE CPP #-}
{- |
   Module      :  Media.Win32
   Copyright   :  2012 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Multimedia API. TODO: provide more functions ...
-}

module Media.Win32
  ( module Media.Win32
  ) where
import Control.Monad                ( unless )
import Prelude               hiding ( ioError, userError )
import System.IO.Error              ( ioError, userError )
import System.Win32.Encoding        ( encodeMultiByte, getCurrentCodePage )
import System.Win32.Types
import System.Win32.String          ( withTStringBufferLen )

type MCIERROR = DWORD

#include "windows_cconv.h"

mciSendString :: String -> IO ()
mciSendString :: String -> IO ()
mciSendString String
cmd
 = String -> (LPTSTR -> IO ()) -> IO ()
forall a. String -> (LPTSTR -> IO a) -> IO a
withTString String
cmd ((LPTSTR -> IO ()) -> IO ()) -> (LPTSTR -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LPTSTR
sendCmd -> do
     MCIERROR
err <- LPTSTR -> LPTSTR -> MCIERROR -> HANDLE -> IO MCIERROR
c_mciSendString LPTSTR
sendCmd LPTSTR
forall a. Ptr a
nullPtr MCIERROR
0 HANDLE
forall a. Ptr a
nullPtr
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MCIERROR
err MCIERROR -> MCIERROR -> Bool
forall a. Eq a => a -> a -> Bool
== MCIERROR
0)
       (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MCIERROR -> IO ()
mciGetErrorString MCIERROR
err

foreign import WINDOWS_CCONV safe "windows.h mciSendStringW"
  c_mciSendString :: LPCTSTR -> LPTSTR -> UINT -> HANDLE -> IO MCIERROR

mciGetErrorString :: MCIERROR -> IO ()
mciGetErrorString :: MCIERROR -> IO ()
mciGetErrorString MCIERROR
err
  = Int -> ((LPTSTR, Int) -> IO ()) -> IO ()
forall a. Int -> ((LPTSTR, Int) -> IO a) -> IO a
withTStringBufferLen Int
256 (((LPTSTR, Int) -> IO ()) -> IO ())
-> ((LPTSTR, Int) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(LPTSTR
cstr, Int
len) ->  do
      String -> IO Bool -> IO ()
failIfFalse_ ([String] -> String
unwords [String
"mciGetErrorString", MCIERROR -> String
forall a. Show a => a -> String
show MCIERROR
err]) (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
        MCIERROR -> LPTSTR -> MCIERROR -> IO Bool
c_mciGetErrorString MCIERROR
err LPTSTR
cstr (MCIERROR -> IO Bool) -> MCIERROR -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> MCIERROR
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      String
msg <- LPTSTR -> IO String
peekTString LPTSTR
cstr
      MCIERROR
cp  <- IO MCIERROR
getCurrentCodePage
      IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ MCIERROR -> String -> String
encodeMultiByte MCIERROR
cp String
msg

foreign import WINDOWS_CCONV unsafe "windows.h mciGetErrorStringW"
  c_mciGetErrorString :: MCIERROR -> LPTSTR -> UINT -> IO BOOL