--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Area
-- Copyright : (c) Henning Thielemann, 2010
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- PRIVATE MODULE.
--
-- Here we have macros to deal with the various information
-- areas present in the library.
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Area where

import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
import qualified Sound.ALSA.Sequencer.Marshal.Port as Port
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer
import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as QuerySubscribe
import qualified Sound.ALSA.Exception as Exc

import qualified Data.EnumSet as EnumSet
import Foreign.C.Types (CInt, )
import Foreign.C.String (CString, peekCString, withCAString, )
import Foreign.Storable (Storable, peek, )
import Foreign.Marshal.Alloc (alloca, )
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr, )
import Foreign.Ptr (Ptr, FunPtr, )
import Data.Word (Word, )


class C area where
   malloc :: IO area
   copy :: area -> area -> IO ()
   clone :: area -> IO area

#{let area x,y =
"data "x"_\n"
"newtype "x" = "x" (ForeignPtr "x"_)\n"
"\n"
"with_"y" :: "x" -> (Ptr "x"_ -> IO a) -> IO a\n"
"with_"y" ("x" p) f = withForeignPtr p f\n"
"\n"
"-- | Allocate an uninitialized object. (Not exported)\n"
y"_malloc :: IO "x"\n"
y"_malloc = alloca $ \\p ->\n"
"  do Exc.checkResult_ \"Sequencer."y"\" =<< snd_seq_"y"_malloc p\n"
"     "x" `fmap` (newForeignPtr snd_seq_"y"_free =<< peek p)\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n"
"  snd_seq_"y"_malloc :: Ptr (Ptr "x"_) -> IO CInt\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h &snd_seq_"y"_free\"\n"
"   snd_seq_"y"_free :: FunPtr (Ptr "x"_ -> IO ())\n"
"\n"
"-- | Copy the content of one object into another.\n"
y"_copy\n"
"  :: "x"     -- ^ Destination\n"
"  -> "x"     -- ^ Source\n"
"  -> IO ()\n"
"\n"
y"_copy to from =\n"
"  with_"y" to $ \\p1 ->\n"
"  with_"y" from $ \\p2 ->\n"
"    snd_seq_"y"_copy p1 p2\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_copy\"\n"
"  snd_seq_"y"_copy :: Ptr "x"_ -> Ptr "x"_ -> IO ()\n"
"\n"
"-- | Copy the content of an object to a newly created object.\n"
y"_clone :: "x" -> IO "x"\n"
y"_clone from =\n"
"  do to <- "y"_malloc\n"
"     "y"_copy to from\n"
"     return to\n"
"\n"
"instance C "x" where\n"
"  malloc = "y"_malloc\n"
"  copy = "y"_copy\n"
"  clone = "y"_clone\n"
}

#{let get_set_name x,y =
y"_get_name :: "x" -> IO String\n"
y"_get_name i = peekCString =<< with_"y" i snd_seq_"y"_get_name\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_name\"\n"
"  snd_seq_"y"_get_name :: Ptr "x"_ -> IO CString\n"
"\n"
y"_set_name :: "x" -> String -> IO ()\n"
y"_set_name i c =\n"
"  withCAString c $ \\p -> with_"y" i (`snd_seq_"y"_set_name` p)\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n"
"  snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n"
}

#{let get_bool x,y,z =
y"_get_"z" :: "x" -> IO Bool\n"
y"_get_"z" i =\n"
"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"
"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"
}

#{let get_set_bool x,y,z =
y"_get_"z" :: "x" -> IO Bool\n"
y"_get_"z" i =\n"
"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"
"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"
"\n"
y"_set_"z" :: "x" -> Bool -> IO ()\n"
y"_set_"z" i c =\n"
"  let x = if c then 1 else 0\n"
"  in with_"y" i (`snd_seq_"y"_set_"z"` x)\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"
"  snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n"
}

#{let get_int x,y,z,t,mk =
y"_get_"z" :: "x" -> IO "t"\n"
y"_get_"z" i =\n"
"  "mk"\n"
"      `fmap` with_"y" i snd_seq_"y"_get_"z"\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"
"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"
}

#{let set_int x,y,z,t,brk =
y"_set_"z" :: "x" -> "t" -> IO ()\n"
y"_set_"z" i c =\n"
"  with_"y" i (`snd_seq_"y"_set_"z"` "brk" c)\n"
"\n"
"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"
"  snd_seq_"y"_set_"z"  :: Ptr "x"_ -> CInt -> IO ()\n"
}



-- Client.T Info -----------------------------------------------------------------
#area "ClientInfo",  "client_info"

-- read/write
#get_set_name "ClientInfo", "client_info"
#get_set_bool "ClientInfo", "client_info", "broadcast_filter"
#get_set_bool "ClientInfo", "client_info", "error_bounce"
#{get_int "ClientInfo", "client_info", "client",
          "Client.T", "Client.imp"}
#{set_int "ClientInfo", "client_info", "client",
          "Client.T", "Client.exp"}

-- read only
#{get_int "ClientInfo", "client_info", "type",
          "Client.Type", "Client.impType"}
#{get_int "ClientInfo", "client_info", "num_ports",
          "Word", "fromIntegral"}
#{get_int "ClientInfo", "client_info", "event_lost",
          "Word", "fromIntegral"}


-- Port Info -------------------------------------------------------------------
#area "PortInfo",    "port_info"

-- read/write
#get_set_name "PortInfo", "port_info"

#get_set_bool "PortInfo", "port_info", "port_specified"
#get_set_bool "PortInfo", "port_info", "timestamping"
#get_set_bool "PortInfo", "port_info", "timestamp_real"

#{get_int "PortInfo", "port_info", "port",
          "Port.T", "Port.imp"}
#{set_int "PortInfo", "port_info", "port",
          "Port.T", "Port.exp"}
#{get_int "PortInfo", "port_info", "client",
          "Client.T","Client.imp"}
#{set_int "PortInfo", "port_info", "client",
          "Client.T","Client.exp"}
#{get_int "PortInfo", "port_info", "capability",
          "Port.Cap","(EnumSet.Cons . fromIntegral)"}
#{set_int "PortInfo", "port_info", "capability",
          "Port.Cap","(fromIntegral . EnumSet.decons)"}

#{get_int "PortInfo", "port_info", "midi_channels",
          "Word","fromIntegral"}
#{set_int "PortInfo", "port_info", "midi_channels",
          "Word","fromIntegral"}
#{get_int "PortInfo", "port_info", "midi_voices",
          "Word","fromIntegral"}
#{set_int "PortInfo", "port_info", "midi_voices",
          "Word","fromIntegral"}
#{get_int "PortInfo", "port_info", "synth_voices",
          "Word","fromIntegral"}
#{set_int "PortInfo", "port_info", "synth_voices",
          "Word","fromIntegral"}

#{get_int "PortInfo", "port_info", "timestamp_queue",
          "Queue.T","Queue.imp"}
#{set_int "PortInfo", "port_info", "timestamp_queue",
          "Queue.T","Queue.exp"}

-- read only
#{get_int "PortInfo", "port_info", "read_use",
          "Word","fromIntegral"}
#{get_int "PortInfo", "port_info", "write_use",
          "Word","fromIntegral"}

-- Subscribe Port ----------------------------------------------------------------
#area "PortSubscribe",	"port_subscribe"

#{get_int "PortSubscribe", "port_subscribe", "queue",
           "Queue.T","Queue.imp"}
#{set_int "PortSubscribe", "port_subscribe", "queue",
           "Queue.T","Queue.exp"}
#get_set_bool "PortSubscribe", "port_subscribe", "exclusive"
#get_set_bool "PortSubscribe", "port_subscribe", "time_update"
#get_set_bool "PortSubscribe", "port_subscribe", "time_real"

-- Subscribe Query ---------------------------------------------------------------
#area "QuerySubscribe", "query_subscribe"

#{get_int "QuerySubscribe", "query_subscribe", "client",
          "Client.T", "Client.imp"}
#{set_int "QuerySubscribe", "query_subscribe", "client",
          "Client.T", "Client.exp"}
#{get_int "QuerySubscribe", "query_subscribe", "port",
          "Port.T", "Port.imp"}
#{set_int "QuerySubscribe", "query_subscribe", "port",
          "Port.T", "Port.exp"}
#{get_int "QuerySubscribe", "query_subscribe", "type",
          "QuerySubscribe.Type", "QuerySubscribe.impType"}
#{set_int "QuerySubscribe", "query_subscribe", "type",
          "QuerySubscribe.Type", "QuerySubscribe.expType"}
#{get_int "QuerySubscribe", "query_subscribe", "index",
          "Word", "fromIntegral"}
#{set_int "QuerySubscribe", "query_subscribe", "index",
          "Word", "fromIntegral"}

-- RO
#{get_int "QuerySubscribe", "query_subscribe", "num_subs",
          "Word", "fromIntegral"}
#{get_int "QuerySubscribe", "query_subscribe", "queue",
          "Queue.T", "Queue.imp"}
#get_bool "QuerySubscribe", "query_subscribe", "exclusive"
#get_bool "QuerySubscribe", "query_subscribe", "time_update"
#get_bool "QuerySubscribe", "query_subscribe", "time_real"

-- Queue.T Info ------------------------------------------------------------------
#area "QueueInfo",   "queue_info"
#get_set_name "QueueInfo", "queue_info"
#get_set_bool "QueueInfo", "queue_info", "locked"

#{get_int "QueueInfo", "queue_info", "owner",
          "Client.T", "Client.imp"}
#{set_int "QueueInfo", "queue_info", "owner",
          "Client.T", "Client.exp"}
#{get_int "QueueInfo", "queue_info", "flags",
          "Word", "fromIntegral"}
#{set_int "QueueInfo", "queue_info", "flags",
          "Word", "fromIntegral"}

-- RO
#{get_int "QueueInfo", "queue_info", "queue",
           "Queue.T","Queue.imp"}

-- Queue.T Status ----------------------------------------------------------------
#area "QueueStatus", "queue_status"

-- Queue.T Tempo -----------------------------------------------------------------
#area "QueueTempo",  "queue_tempo"

-- RO
#{get_int "QueueTempo", "queue_tempo", "queue",
           "Queue.T","Queue.imp"}

-- RW
#{get_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"}
#{set_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"}

#{get_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"}
#{set_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"}

#{get_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"}
#{set_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"}

#{get_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"}
#{set_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"}

-- Queue.T Timer -----------------------------------------------------------------
#area "QueueTimer",  "queue_timer"


-- RO
#{get_int "QueueTimer", "queue_timer", "queue",
           "Queue.T","Queue.imp"}

-- RW

#{get_int "QueueTimer", "queue_timer", "type",
            "QueueTimer.Type", "QueueTimer.impType"}
#{set_int "QueueTimer", "queue_timer", "type",
            "QueueTimer.Type", "QueueTimer.expType"}

#{get_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"}
#{set_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"}