--------------------------------------------------------------------------------
-- |
-- 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.Exception as Exc

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 \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n"
"  snd_seq_"y"_malloc :: Ptr (Ptr "x"_) -> IO CInt\n"
"\n"
"foreign import ccall \"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 \"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 \"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 \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n"
"  snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n"
}

#{let get_set_bool x,y,z =
y"_get_"z" :: "x" -> IO Bool\n"
y"_get_"z" i =\n"
"  (1 ==) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"
"\n"
"foreign import ccall \"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 \"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 \"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 \"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","(Port.Cap . fromIntegral)"}
#{set_int "PortInfo", "port_info", "capability",
          "Port.Cap","(fromIntegral . Port.unCap)"}

#{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"}

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