-- | Emulate new api using the old functions
module Sound.ALSA.Sequencer.Client.Info.EventFilter where

import Sound.ALSA.Sequencer.Marshal.ClientInfo (T, T_, with, )
import qualified Sound.ALSA.Sequencer.Marshal.Event as Event

import Foreign.C.Types (CUInt, )
import Foreign.Ptr (Ptr, nullPtr, )
import Foreign.Marshal.Array (allocaArray, copyArray, )
import Foreign.Storable (sizeOf, peekElemOff, pokeElemOff, )
import Data.Bits (testBit, setBit, clearBit, )


{- |
Although alsa/seq.h says CUChar, that's not true,
because internally it uses CUInt and
that makes a difference between little and big endian memory access.
-}
type EventTypeSubset = CUInt
type EventTypeSet = Ptr EventTypeSubset


clear :: T -> IO ()
add :: Event.Type e => T -> e -> IO ()
delete :: Event.Type e => T -> e -> IO ()
check :: Event.Type e => T -> e -> IO Bool

clear :: T -> IO ()
clear T
i = forall a. T -> (Ptr T_ -> IO a) -> IO a
with T
i (forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr T_ -> EventTypeSet -> IO ()
set_ forall a. Ptr a
nullPtr)

bit :: Event.Type e => e -> (Int, Int)
bit :: forall e. Type e => e -> (Int, Int)
bit e
e =
  forall a. Integral a => a -> a -> (a, a)
divMod
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ EType -> Word8
Event.unEType forall a b. (a -> b) -> a -> b
$ forall e. Type e => e -> EType
Event.expEv e
e)
    (Int
8 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: EventTypeSubset))

size :: Int
size :: Int
size = forall a. Integral a => a -> a -> a
div Int
32 (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: EventTypeSubset))
  -- succ $ fst $ bit Event.maxEventType

get :: T -> IO EventTypeSet
get :: T -> IO EventTypeSet
get T
i = forall a. T -> (Ptr T_ -> IO a) -> IO a
with T
i Ptr T_ -> IO EventTypeSet
get_

check :: forall e. Type e => T -> e -> IO Bool
check T
i e
e = do
  EventTypeSet
ef <- T -> IO EventTypeSet
get T
i
  let (Int
o,Int
b) = forall e. Type e => e -> (Int, Int)
bit e
e
  EventTypeSubset
w <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff EventTypeSet
ef Int
o
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> Bool
testBit EventTypeSubset
w Int
b

set :: T -> EventTypeSet -> IO ()
set :: T -> EventTypeSet -> IO ()
set T
i EventTypeSet
ef = forall a. T -> (Ptr T_ -> IO a) -> IO a
with T
i (forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr T_ -> EventTypeSet -> IO ()
set_ EventTypeSet
ef)

modify :: T -> (EventTypeSet -> IO ()) -> IO ()
modify :: T -> (EventTypeSet -> IO ()) -> IO ()
modify T
i EventTypeSet -> IO ()
f =
  forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size forall a b. (a -> b) -> a -> b
$ \EventTypeSet
ef' -> do
    EventTypeSet
ef <- T -> IO EventTypeSet
get T
i
    forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray EventTypeSet
ef' EventTypeSet
ef Int
size
    EventTypeSet -> IO ()
f EventTypeSet
ef'
    T -> EventTypeSet -> IO ()
set T
i EventTypeSet
ef'

modifyByte ::
  (Event.Type e) =>
  (EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO ()
modifyByte :: forall e.
Type e =>
(EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO ()
modifyByte EventTypeSubset -> Int -> EventTypeSubset
f T
i e
e =
  T -> (EventTypeSet -> IO ()) -> IO ()
modify T
i forall a b. (a -> b) -> a -> b
$ \EventTypeSet
ef ->
  let (Int
o,Int
b) = forall e. Type e => e -> (Int, Int)
bit e
e
  in  forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff EventTypeSet
ef Int
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip EventTypeSubset -> Int -> EventTypeSubset
f Int
b forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff EventTypeSet
ef Int
o

add :: forall e. Type e => T -> e -> IO ()
add    = forall e.
Type e =>
(EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO ()
modifyByte forall a. Bits a => a -> Int -> a
setBit
delete :: forall e. Type e => T -> e -> IO ()
delete = forall e.
Type e =>
(EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO ()
modifyByte forall a. Bits a => a -> Int -> a
clearBit

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_get_event_filter"
  get_ :: Ptr T_ -> IO EventTypeSet

foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_set_event_filter"
  set_ :: Ptr T_ -> EventTypeSet -> IO ()