{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.QueueTimer
-- Copyright : (c) Henning Thielemann, 2010
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- PRIVATE MODULE.
--
-- Here we have the various types used by the library,
-- and how they are imported\/exported to C.
--
-- NOTE: In the translations bellow we make the following assumptions
-- about the sizes of C types.
-- CChar  = 8 bits
-- CShort = 16 bit
-- CInt   = 32 bits
--------------------------------------------------------------------------------

module Sound.ALSA.Sequencer.Marshal.QueueTimer where


{-# LINE 26 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
import Foreign.C.Types (CInt, )


data Type =
     Alsa
   | MidiClock
   | MidiTick
   deriving (Show, Eq, Ord, Enum)

expType :: Type -> CInt
expType t  = case t of
  Alsa       -> 0
{-# LINE 38 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
  MidiClock  -> 1
{-# LINE 39 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
  MidiTick   -> 2
{-# LINE 40 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}

impType :: CInt -> Type
impType t  = case t of
  0         -> Alsa
{-# LINE 44 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
  1   -> MidiClock
{-# LINE 45 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
  2    -> MidiTick
{-# LINE 46 "src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc" #-}
  _ -> error ("QueueTimer.impType: unknown timer type (" ++ show t ++ ")")