hunk ./Sound/Alsa/Sequencer/Client.hs 22 - , get_client_id -- :: SndSeq -> IO Client - , set_client_name -- :: SndSeq -> String -> IO () + , get_client_id -- :: SndSeq mode -> IO Client + , set_client_name -- :: SndSeq mode -> String -> IO () hunk ./Sound/Alsa/Sequencer/Client.hs 28 - , get_client_info -- :: SndSeq -> IO ClientInfo - , get_any_client_info -- :: SndSeq -> Client -> IO ClientInfo - , query_first_client -- :: SndSeq -> IO ClientInfo - , query_next_client -- :: SndSeq -> ClientInfo -> IO Bool - , set_client_info -- :: SndSeq -> ClientInfo -> IO () + , get_client_info -- :: SndSeq mode -> IO ClientInfo + , get_any_client_info -- :: SndSeq mode -> Client -> IO ClientInfo + , query_first_client -- :: SndSeq mode -> IO ClientInfo + , query_next_client -- :: SndSeq mode -> ClientInfo -> IO Bool + , set_client_info -- :: SndSeq mode -> ClientInfo -> IO () hunk ./Sound/Alsa/Sequencer/Client.hs 68 -get_client_id :: SndSeq -> IO Client +get_client_id :: SndSeq mode -> IO Client hunk ./Sound/Alsa/Sequencer/Client.hs 73 -set_client_name :: SndSeq -> String -> IO () +set_client_name :: SndSeq mode -> String -> IO () hunk ./Sound/Alsa/Sequencer/Client.hs 83 -get_client_info :: SndSeq -> IO ClientInfo +get_client_info :: SndSeq mode -> IO ClientInfo hunk ./Sound/Alsa/Sequencer/Client.hs 94 -get_any_client_info :: SndSeq -> Client -> IO ClientInfo +get_any_client_info :: SndSeq mode -> Client -> IO ClientInfo hunk ./Sound/Alsa/Sequencer/Client.hs 107 -query_first_client :: SndSeq -> IO ClientInfo +query_first_client :: SndSeq mode -> IO ClientInfo hunk ./Sound/Alsa/Sequencer/Client.hs 117 -query_next_client :: SndSeq -> ClientInfo +query_next_client :: SndSeq mode -> ClientInfo hunk ./Sound/Alsa/Sequencer/Client.hs 130 -set_client_info :: SndSeq -> ClientInfo -> IO () +set_client_info :: SndSeq mode -> ClientInfo -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 16 - ( sync_output_queue -- :: SndSeq -> IO () - , event_input -- :: SndSeq -> IO Event - , event_input_pending -- :: SndSeq -> Bool -> IO Word - , event_output -- :: SndSeq -> Event -> IO Word - , event_output_buffer -- :: SndSeq -> Event -> IO Word - , event_output_direct -- :: SndSeq -> Event -> IO Word - , event_output_pending -- :: SndSeq -> IO Word - , extract_output -- :: SndSeq -> IO Event - , remove_output -- :: SndSeq -> IO () - , drain_output -- :: SndSeq -> IO Word - , drop_output -- :: SndSeq -> IO () - , drop_output_buffer -- :: SndSeq -> IO () - , drop_input -- :: SndSeq -> IO () - , drop_input_buffer -- :: SndSeq -> IO () + ( sync_output_queue -- :: SndSeq mode -> IO () + , event_input -- :: SndSeq mode -> IO Event + , event_input_pending -- :: SndSeq mode -> Bool -> IO Word + , event_output -- :: SndSeq mode -> Event -> IO Word + , event_output_buffer -- :: SndSeq mode -> Event -> IO Word + , event_output_direct -- :: SndSeq mode -> Event -> IO Word + , event_output_pending -- :: SndSeq mode -> IO Word + , extract_output -- :: SndSeq mode -> IO Event + , remove_output -- :: SndSeq mode -> IO () + , drain_output -- :: SndSeq mode -> IO Word + , drop_output -- :: SndSeq mode -> IO () + , drop_output_buffer -- :: SndSeq mode -> IO () + , drop_input -- :: SndSeq mode -> IO () + , drop_input_buffer -- :: SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 46 -sync_output_queue :: SndSeq -> IO () +sync_output_queue :: SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 64 -event_input :: SndSeq -> IO Event +event_input :: AllowInput mode => SndSeq mode -> IO Event hunk ./Sound/Alsa/Sequencer/Event.hs 79 - :: SndSeq + :: AllowInput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 97 -event_output :: SndSeq +event_output :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 113 -event_output_buffer :: SndSeq +event_output_buffer :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 130 - :: SndSeq + :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 145 - :: SndSeq + :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 159 - :: SndSeq + :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 169 -remove_output :: SndSeq -> IO () +remove_output :: AllowOutput mode + => SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 187 - :: SndSeq + :: AllowOutput mode + => SndSeq mode hunk ./Sound/Alsa/Sequencer/Event.hs 200 -drop_output :: SndSeq -> IO () +drop_output + :: AllowOutput mode + => SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 211 -drop_output_buffer :: SndSeq -> IO () +drop_output_buffer + :: AllowOutput mode + => SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 223 -drop_input :: SndSeq -> IO () +drop_input + :: AllowInput mode + => SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Event.hs 234 -drop_input_buffer :: SndSeq -> IO () +drop_input_buffer + :: AllowInput mode + => SndSeq mode -> IO () hunk ./Sound/Alsa/Sequencer/Marshal.hsc 32 -newtype OpenMode = OpenMode CInt deriving (Show,Eq,Ord,Storable) +-- This way we prevent the ALSA exception 22 "Invalid argument" +-- when calling @event_output@ on an input-only sequencer. +class OpenMode mode where exp_OpenMode :: mode -> CInt hunk ./Sound/Alsa/Sequencer/Marshal.hsc 36 -#{enum OpenMode, OpenMode - , open_output = SND_SEQ_OPEN_OUTPUT - , open_input = SND_SEQ_OPEN_INPUT - , open_duplex = SND_SEQ_OPEN_DUPLEX - } +class OpenMode mode => AllowInput mode where +class OpenMode mode => AllowOutput mode where + +data OutputMode = OutputMode deriving (Show) +data InputMode = InputMode deriving (Show) +data DuplexMode = DuplexMode deriving (Show) + +{- +open_output :: OutputMode; open_output = OutputMode +open_input :: InputMode ; open_input = InputMode +open_duplex :: DuplexMode; open_duplex = DuplexMode +-} + +instance OpenMode OutputMode where exp_OpenMode _ = #{const SND_SEQ_OPEN_OUTPUT} +instance OpenMode InputMode where exp_OpenMode _ = #{const SND_SEQ_OPEN_INPUT} +instance OpenMode DuplexMode where exp_OpenMode _ = #{const SND_SEQ_OPEN_DUPLEX} + +instance AllowOutput OutputMode where +instance AllowOutput DuplexMode where +instance AllowInput InputMode where +instance AllowInput DuplexMode where hunk ./Sound/Alsa/Sequencer/Marshal.hsc 58 -exp_OpenMode :: OpenMode -> CInt -exp_OpenMode (OpenMode x) = x hunk ./Sound/Alsa/Sequencer/Marshal.hsc 71 -newtype SndSeq = SndSeq (Ptr SndSeq_) deriving Eq +newtype SndSeq mode = SndSeq (Ptr SndSeq_) deriving Eq hunk ./Sound/Alsa/Sequencer/Port.hs 54 - , create_port -- :: SndSeq -> PortInfo -> IO () - , create_simple_port -- :: SndSeq -> String -> PortCap -> PortType -> IO Port - , delete_port -- :: SndSeq -> Port -> IO () + , create_port -- :: SndSeq mode -> PortInfo -> IO () + , create_simple_port -- :: SndSeq mode -> String -> PortCap -> PortType -> IO Port + , delete_port -- :: SndSeq mode -> Port -> IO () hunk ./Sound/Alsa/Sequencer/Port.hs 58 - , get_port_info -- :: SndSeq -> IO PortInfo - , get_any_port_info -- :: SndSeq -> Client -> Port -> IO PortInfo - , query_first_port -- :: SndSeq -> IO PortInfo - , query_next_port -- :: SndSeq -> PortInfo -> IO () - , set_port_info -- :: SndSeq -> Port -> PortInfo -> IO () + , get_port_info -- :: SndSeq mode -> IO PortInfo + , get_any_port_info -- :: SndSeq mode -> Client -> Port -> IO PortInfo + , query_first_port -- :: SndSeq mode -> IO PortInfo + , query_next_port -- :: SndSeq mode -> PortInfo -> IO () + , set_port_info -- :: SndSeq mode -> Port -> PortInfo -> IO () hunk ./Sound/Alsa/Sequencer/Port.hs 113 -create_simple_port :: SndSeq -> String -> PortCap -> PortType -> IO Port +create_simple_port :: SndSeq mode -> String -> PortCap -> PortType -> IO Port hunk ./Sound/Alsa/Sequencer/Port.hs 128 -create_port :: SndSeq -> PortInfo -> IO () +create_port :: SndSeq mode -> PortInfo -> IO () hunk ./Sound/Alsa/Sequencer/Port.hs 136 -delete_port :: SndSeq -> Port -> IO () +delete_port :: SndSeq mode -> Port -> IO () hunk ./Sound/Alsa/Sequencer/Port.hs 145 -get_port_info :: SndSeq -> Port -> IO PortInfo +get_port_info :: SndSeq mode -> Port -> IO PortInfo hunk ./Sound/Alsa/Sequencer/Port.hs 157 -get_any_port_info :: SndSeq -> Client -> Port -> IO PortInfo +get_any_port_info :: SndSeq mode -> Client -> Port -> IO PortInfo hunk ./Sound/Alsa/Sequencer/Port.hs 169 -query_first_port :: SndSeq -> IO PortInfo +query_first_port :: SndSeq mode -> IO PortInfo hunk ./Sound/Alsa/Sequencer/Port.hs 180 -query_next_port :: SndSeq -> PortInfo -> IO () +query_next_port :: SndSeq mode -> PortInfo -> IO () hunk ./Sound/Alsa/Sequencer/Port.hs 189 -set_port_info :: SndSeq -> Port -> PortInfo -> IO () +set_port_info :: SndSeq mode -> Port -> PortInfo -> IO () hunk ./Sound/Alsa/Sequencer/Queue.hs 92 -alloc_queue :: SndSeq -> IO Queue -- ^ Queue identifier. +alloc_queue :: SndSeq mode -> IO Queue -- ^ Queue identifier. hunk ./Sound/Alsa/Sequencer/Queue.hs 100 -alloc_named_queue :: SndSeq -> String -> IO Queue +alloc_named_queue :: SndSeq mode -> String -> IO Queue hunk ./Sound/Alsa/Sequencer/Queue.hs 110 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Queue.hs 122 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Queue.hs 138 -get_queue_info :: SndSeq -> Queue -> IO QueueInfo +get_queue_info :: SndSeq mode -> Queue -> IO QueueInfo hunk ./Sound/Alsa/Sequencer/Queue.hs 149 -set_queue_info :: SndSeq -> Queue -> QueueInfo -> IO () +set_queue_info :: SndSeq mode -> Queue -> QueueInfo -> IO () hunk ./Sound/Alsa/Sequencer/Queue.hs 158 -get_queue_tempo :: SndSeq -> Queue -> IO QueueTempo +get_queue_tempo :: SndSeq mode -> Queue -> IO QueueTempo hunk ./Sound/Alsa/Sequencer/Queue.hs 169 -set_queue_tempo :: SndSeq -> Queue -> QueueTempo -> IO () +set_queue_tempo :: SndSeq mode -> Queue -> QueueTempo -> IO () hunk ./Sound/Alsa/Sequencer/Queue.hs 180 -get_queue_status :: SndSeq -> Queue -> IO QueueStatus +get_queue_status :: SndSeq mode -> Queue -> IO QueueStatus hunk ./Sound/Alsa/Sequencer/Queue.hs 191 -get_queue_timer :: SndSeq -> Queue -> IO QueueTimer +get_queue_timer :: SndSeq mode -> Queue -> IO QueueTimer hunk ./Sound/Alsa/Sequencer/Queue.hs 202 -set_queue_timer :: SndSeq -> Queue -> QueueTimer -> IO () +set_queue_timer :: SndSeq mode -> Queue -> QueueTimer -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 29 - :: String -- ^ The sequencer's \"name\". This is not a name that you + :: OpenMode mode + -- Read\/Write permissions + => String -- ^ The sequencer's \"name\". This is not a name that you hunk ./Sound/Alsa/Sequencer/Sequencer.hs 35 - -> OpenMode -- Read\/Write permissions hunk ./Sound/Alsa/Sequencer/Sequencer.hs 36 - -> IO SndSeq -- Handle to the sequencer. + -> IO (SndSeq mode) -- Handle to the sequencer. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 38 -open t om bm = alloca $ \p -> withCAString t $ \s -> +open t bm = withOpenMode $ \om -> alloca $ \p -> withCAString t $ \s -> hunk ./Sound/Alsa/Sequencer/Sequencer.hs 45 +withOpenMode :: (mode -> IO (SndSeq mode)) -> IO (SndSeq mode) +withOpenMode f = f undefined + hunk ./Sound/Alsa/Sequencer/Sequencer.hs 56 - :: SndSeq -- ^ handle to the sequencer + :: SndSeq mode -- ^ handle to the sequencer hunk ./Sound/Alsa/Sequencer/Sequencer.hs 67 - :: SndSeq -- ^ sequencer handle + :: SndSeq mode -- ^ sequencer handle hunk ./Sound/Alsa/Sequencer/Sequencer.hs 82 - :: SndSeq -- ^ sequencer handle + :: SndSeq mode -- ^ sequencer handle hunk ./Sound/Alsa/Sequencer/Sequencer.hs 96 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 109 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 122 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 135 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 151 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 165 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 178 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 191 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 204 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer/Sequencer.hs 225 -connect_from :: SndSeq -> Port -> Addr -> IO () +connect_from :: SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 235 -connect_to :: SndSeq -> Port -> Addr -> IO () +connect_to :: SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 245 -disconnect_from :: SndSeq -> Port -> Addr -> IO () +disconnect_from :: SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 254 -disconnect_to :: SndSeq -> Port -> Addr -> IO () +disconnect_to :: SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 267 - :: SndSeq -- ^ Sequencer handle. + :: SndSeq mode -- ^ Sequencer handle. hunk ./Sound/Alsa/Sequencer.hs 19 - , open_output - , open_input - , open_duplex + , AllowOutput + , AllowInput + , OutputMode(..) + , InputMode(..) + , DuplexMode(..) hunk ./tests/test1.hs 1 +import qualified Sound.Alsa.Sequencer as ALSA hunk ./tests/test1.hs 3 - BlockMode(Block), open, open_input, default_seq_name, close, + BlockMode(Block), open, default_seq_name, close, hunk ./tests/test1.hs 13 - h <- open default_seq_name open_input Block + h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.InputMode) hunk ./tests/test2.hs 1 +import qualified Sound.Alsa.Sequencer as ALSA hunk ./tests/test2.hs 3 - BlockMode(Block), open, open_output, default_seq_name, close, + BlockMode(Block), open, default_seq_name, close, hunk ./tests/test2.hs 21 - h <- open default_seq_name open_output Block + h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) hunk ./tests/test3.hs 1 +import qualified Sound.Alsa.Sequencer as ALSA hunk ./tests/test3.hs 3 - BlockMode(Block), open, open_output, default_seq_name, close, + BlockMode(Block), open, default_seq_name, close, hunk ./tests/test3.hs 20 - h <- open default_seq_name open_output Block + h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) hunk ./tests/test4.hs 1 +import qualified Sound.Alsa.Sequencer as ALSA hunk ./tests/test4.hs 3 - BlockMode(Block), open, open_output, default_seq_name, close, + BlockMode(Block), open, default_seq_name, close, hunk ./tests/test4.hs 10 -main = do h <- open default_seq_name open_output Block +main = do h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) hunk ./tests/test5.hs 1 +import qualified Sound.Alsa.Sequencer as ALSA hunk ./tests/test5.hs 3 - BlockMode(Block), open, open_duplex, default_seq_name, close, + BlockMode(Block), open, default_seq_name, close, hunk ./tests/test5.hs 27 -main = do h <- open default_seq_name open_duplex Block +main = do h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.DuplexMode) hunk ./Sound/Alsa/Sequencer/Sequencer.hs 225 -connect_from :: SndSeq mode -> Port -> Addr -> IO () +connect_from :: AllowInput mode => SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 235 -connect_to :: SndSeq mode -> Port -> Addr -> IO () +connect_to :: AllowOutput mode => SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 245 -disconnect_from :: SndSeq mode -> Port -> Addr -> IO () +disconnect_from :: AllowInput mode => SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer/Sequencer.hs 254 -disconnect_to :: SndSeq mode -> Port -> Addr -> IO () +disconnect_to :: AllowOutput mode => SndSeq mode -> Port -> Addr -> IO () hunk ./Sound/Alsa/Sequencer.hs 29 + , with hunk ./Sound/Alsa/Sequencer/Port.hs 57 + , delete_simple_port -- :: SndSeq mode -> Port -> IO () + + , with_simple_port -- :: SndSeq mode -> String -> PortCap -> PortType -> (Port -> IO a) -> IO a hunk ./Sound/Alsa/Sequencer/Port.hs 100 +import Sound.Alsa.Sequencer.Marshal +import Sound.Alsa.Sequencer.Area +import Sound.Alsa.Sequencer.Errors + hunk ./Sound/Alsa/Sequencer/Port.hs 108 -import Foreign.Storable +import Foreign.Storable (poke, peek, ) hunk ./Sound/Alsa/Sequencer/Port.hs 110 -import Sound.Alsa.Sequencer.Marshal -import Sound.Alsa.Sequencer.Area -import Sound.Alsa.Sequencer.Errors +import Control.Exception (bracket, ) hunk ./Sound/Alsa/Sequencer/Port.hs 128 +-- | Delete the port. +delete_simple_port :: SndSeq mode -> Port -> IO () +delete_simple_port (SndSeq h) (Port p) = + check_error_ =<< snd_seq_delete_simple_port h (fromIntegral p) + +foreign import ccall "alsa/asoundlib.h snd_seq_delete_simple_port" + snd_seq_delete_simple_port :: Ptr SndSeq_ -> CInt -> IO CInt + + +with_simple_port :: + SndSeq mode -> String -> PortCap -> PortType -> + (Port -> IO a) -> + IO a +with_simple_port ss s c t = + bracket (create_simple_port ss s c t) (delete_simple_port ss) + hunk ./Sound/Alsa/Sequencer/Queue.hs 22 + , with_queue + , with_named_queue hunk ./Sound/Alsa/Sequencer/Queue.hs 94 +import Control.Exception (bracket, ) + + hunk ./Sound/Alsa/Sequencer/Queue.hs 104 +with_queue :: SndSeq mode -> (Queue -> IO a) -> IO a +with_queue s = bracket (alloc_queue s) (free_queue s) + hunk ./Sound/Alsa/Sequencer/Queue.hs 115 +with_named_queue :: SndSeq mode -> String -> (Queue -> IO a) -> IO a +with_named_queue s nm = bracket (alloc_named_queue s nm) (free_queue s) + hunk ./Sound/Alsa/Sequencer/Sequencer.hs 8 +import Sound.Alsa.Sequencer.Marshal +import Sound.Alsa.Sequencer.Errors hunk ./Sound/Alsa/Sequencer/Sequencer.hs 11 -import Foreign.C.Types(CInt,CSize) -import Foreign.C.String(CString,withCAString,peekCString) -import Foreign.Ptr(Ptr) -import Foreign.Marshal.Alloc(alloca) -import Foreign.Storable +import Foreign.C.Types (CInt, CSize, ) +import Foreign.C.String (CString, withCAString, peekCString, ) +import Foreign.Ptr (Ptr, ) +import Foreign.Marshal.Alloc (alloca, ) +import Foreign.Storable (peek, ) hunk ./Sound/Alsa/Sequencer/Sequencer.hs 17 -import Data.Word +import Data.Word (Word, ) hunk ./Sound/Alsa/Sequencer/Sequencer.hs 19 -import Sound.Alsa.Sequencer.Marshal -import Sound.Alsa.Sequencer.Errors +import Control.Exception (bracket, ) hunk ./Sound/Alsa/Sequencer/Sequencer.hs 64 + +with + :: OpenMode mode + -- Read\/Write permissions + => String -- ^ The sequencer's \"name\". This is not a name that you + -- make up for your own purposes; it has special significance + -- to the ALSA library. Usually you need to pass 'default_name' + -- here. + -> BlockMode -- Blocking behavior + -> (SndSeq mode -> IO a) + -- Action on the sequencer, the result must be computed strictly. + -> IO a +with t bm = + bracket (open t bm) close + hunk ./tests/test1.hs 3 - BlockMode(Block), open, default_seq_name, close, - create_simple_port, delete_port, hunk ./tests/test1.hs 9 -main = - do putStrLn "Starting." - h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.InputMode) - set_client_name h "HS1" - putStrLn "Created sequencer." - p1 <- create_simple_port h "one" - (caps [cap_write,cap_subs_write]) type_midi_generic - - p2 <- create_simple_port h "two" - (caps [cap_write,cap_subs_write]) type_midi_generic - putStrLn "Created ports." - let loop = do putStrLn "waiting for an event:" - e <- event_input h - print e - loop - loop - delete_port h p1 - delete_port h p2 - putStrLn "Deleted ports." - close h - putStrLn "Closed sequencer." +main = (do + putStrLn "Starting." + ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do + ALSA.set_client_name (h :: ALSA.SndSeq ALSA.InputMode) "HS1" + putStrLn "Created sequencer." + ALSA.with_simple_port h "one" + (caps [cap_write,cap_subs_write]) type_midi_generic $ \ _p1 -> do + ALSA.with_simple_port h "two" + (caps [cap_write,cap_subs_write]) type_midi_generic $ \ _p2 -> do + putStrLn "Created ports." + let loop = do putStrLn "waiting for an event:" + e <- event_input h + print e + loop + loop) hunk ./tests/test2.hs 3 - BlockMode(Block), open, default_seq_name, close, - create_simple_port, delete_port, hunk ./tests/test2.hs 17 -main = - do putStrLn "Starting." - h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) - set_client_name h "HS test client" - putStrLn "Created sequencer." - p <- create_simple_port h "one" - (caps [cap_read,cap_subs_read]) type_midi_generic - putStrLn "Created port." - x <- get_client_id h - putStrLn ("My id is: " ++ show x) - let me = Addr { addr_client = x, addr_port = p } - getChar - event_output_direct h (e1 me) - getChar - delete_port h p - putStrLn "Deleted port." - close h - putStrLn "Closed sequencer." +main = (do + putStrLn "Starting." + ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do + set_client_name (h :: ALSA.SndSeq ALSA.OutputMode) "HS test client" + putStrLn "Created sequencer." + ALSA.with_simple_port h "one" + (caps [cap_read,cap_subs_read]) type_midi_generic $ \ p -> do + putStrLn "Created port." + x <- get_client_id h + putStrLn ("My id is: " ++ show x) + let me = Addr { addr_client = x, addr_port = p } + getChar + event_output_direct h (e1 me) + getChar + return ()) hunk ./tests/test3.hs 3 - BlockMode(Block), open, default_seq_name, close, hunk ./tests/test3.hs 17 -main = - do putStrLn "Starting." - h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) - set_client_name h "HS3" - putStrLn "Created sequencer." - x <- get_client_id h - putStrLn ("My id is: " ++ show x) - let me = Addr { addr_client = x, addr_port = port_unknown } - -- tgt_addr <- parse_address h "HS1:255" - let tgt_addr = Addr client_broadcast port_unknown - print tgt_addr - getChar - event_output_direct h (e1 me tgt_addr) - getChar - close h - putStrLn "Closed sequencer." +main = (do + putStrLn "Starting." + ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do + set_client_name (h :: ALSA.SndSeq ALSA.OutputMode) "HS3" + putStrLn "Created sequencer." + x <- get_client_id h + putStrLn ("My id is: " ++ show x) + let me = Addr { addr_client = x, addr_port = port_unknown } + -- tgt_addr <- parse_address h "HS1:255" + let tgt_addr = Addr client_broadcast port_unknown + print tgt_addr + getChar + event_output_direct h (e1 me tgt_addr) + getChar + return ()) hunk ./tests/test4.hs 2 -import Sound.Alsa.Sequencer ( - BlockMode(Block), open, default_seq_name, close, - client_info_get_name, query_first_client, query_next_client, - ) hunk ./tests/test4.hs 6 -main = do h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.OutputMode) - i <- query_first_client h - let loop = do putStrLn =<< client_info_get_name i - more <- query_next_client h i - when more loop - loop - close h +main = + ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do + i <- ALSA.query_first_client (h :: ALSA.SndSeq ALSA.OutputMode) + let loop = do putStrLn =<< ALSA.client_info_get_name i + more <- ALSA.query_next_client h i + when more loop + loop hunk ./tests/test5.hs 3 - BlockMode(Block), open, default_seq_name, close, - create_simple_port, delete_port, hunk ./tests/test5.hs 13 - alloc_queue, free_queue, hunk ./tests/test5.hs 24 -main = do h <- open default_seq_name Block :: IO (ALSA.SndSeq ALSA.DuplexMode) - set_client_name h "HS5" - p <- create_simple_port h "1" (caps [cap_read,cap_subs_read,cap_write]) - (types [type_midi_generic,type_application]) - c <- get_client_id h - q <- alloc_queue h - let ev t e = Event - { ev_high_priority = False - , ev_tag = 0 - , ev_queue = q - , ev_timestamp = TickTime t - , ev_source = Addr { addr_client = c, addr_port = p } - , ev_dest = addr_subscribers - , ev_data = e - } - play t chan pitch vel = - do print =<< event_output h (ev t $ - NoteEv NoteOn $ simple_note chan pitch vel) +main = (do + ALSA.with ALSA.default_seq_name ALSA.Block $ \h -> do + set_client_name (h :: ALSA.SndSeq ALSA.DuplexMode) "HS5" + ALSA.with_simple_port h "1" + (caps [cap_read,cap_subs_read,cap_write]) + (types [type_midi_generic,type_application]) $ \p -> do + c <- get_client_id h + ALSA.with_queue h $ \q -> do + let ev t e = Event + { ev_high_priority = False + , ev_tag = 0 + , ev_queue = q + , ev_timestamp = TickTime t + , ev_source = Addr { addr_client = c, addr_port = p } + , ev_dest = addr_subscribers + , ev_data = e + } + play t chan pitch vel = + do print =<< event_output h (ev t $ + NoteEv NoteOn $ simple_note chan pitch vel) hunk ./tests/test5.hs 45 - print =<< event_output h (ev (t+1) $ - NoteEv NoteOn $ simple_note chan pitch 0) + print =<< event_output h (ev (t+1) $ + NoteEv NoteOn $ simple_note chan pitch 0) hunk ./tests/test5.hs 48 - echo t = - print =<< event_output h - ((ev t $ CustomEv Echo $ Custom 0 0 0){ - ev_dest = Addr { addr_client = c, addr_port = p } - }) + echo t = + print =<< event_output h + ((ev t $ CustomEv Echo $ Custom 0 0 0){ + ev_dest = Addr { addr_client = c, addr_port = p } + }) hunk ./tests/test5.hs 54 - putStrLn "Please connect me to a synth" - getChar - control_queue h q QueueStart 0 Nothing - control_queue h q QueueTempo 10000000 Nothing - zipWithM_ (\t -> - maybe (echo t) (\n -> play t 0 n 127)) [0..] $ - (++[Nothing]) $ - concat $ concatMap (replicate 4 . map Just) $ - [57, 59, 60, 64] : - [57, 59, 60, 65] : - [57, 62, 64, 65] : - [57, 59, 60, 64] : - [] - drain_output h - print =<< event_output_pending h + putStrLn "Please connect me to a synth" + getChar + control_queue h q QueueStart 0 Nothing + control_queue h q QueueTempo 10000000 Nothing + zipWithM_ (\t -> + maybe (echo t) (\n -> play t 0 n 127)) [0..] $ + (++[Nothing]) $ + concat $ concatMap (replicate 4 . map Just) $ + [57, 59, 60, 64] : + [57, 59, 60, 65] : + [57, 62, 64, 65] : + [57, 59, 60, 64] : + [] + drain_output h + print =<< event_output_pending h hunk ./tests/test5.hs 71 - let waitForEcho = do - event <- event_input h - print event - case ev_data event of - CustomEv e _d -> - case e of - Echo -> return () - _ -> waitForEcho - _ -> waitForEcho - waitForEcho - free_queue h q - delete_port h p - close h + let waitForEcho = do + event <- event_input h + print event + case ev_data event of + CustomEv e _d -> + case e of + Echo -> return () + _ -> waitForEcho + _ -> waitForEcho + waitForEcho)