live-sequencer 0.0.1 → 0.0.2
raw patch · 5 files changed
+216/−29 lines, 5 filesdep +unixdep ~stmdep ~transformersnew-component:exe:live-mplayer-control
Dependencies added: unix
Dependency ranges changed: stm, transformers
Files
- data/base/Chords.hs +11/−13
- data/base/Midi.hs +9/−0
- live-sequencer.cabal +54/−11
- src/ALSA.hs +9/−5
- src/MPlayer.hs +133/−0
data/base/Chords.hs view
@@ -2,28 +2,26 @@ import Midi ++chord ::+ Integer -> [Integer] ->+ [Midi.Event Midi.Message] ;+chord dur =+ mergeMany . map (note dur) ;++ chord3 :: Integer -> Integer -> Integer -> Integer -> [Midi.Event Midi.Message] ;-chord3 dur p0 p1 p2 =- mergeMany [- note dur p0,- note dur p1,- note dur p2- ] ;+chord3 dur p0 p1 p2 = chord dur [p0, p1, p2] ; chord4 :: Integer -> Integer -> Integer -> Integer -> Integer -> [Midi.Event Midi.Message] ;-chord4 dur p0 p1 p2 p3 =- mergeMany [- note dur p0,- note dur p1,- note dur p2,- note dur p3- ] ;+chord4 dur p0 p1 p2 p3 = chord dur [p0, p1, p2, p3] ;+ major, major7, minor, minor7 :: Integer -> Integer -> [Midi.Event Midi.Message] ;
data/base/Midi.hs view
@@ -14,6 +14,7 @@ controller, channel, transpose, transposeEvent,+ changeTempo, changeTempoEvent, controlCurve, normalVelocity, emphasize,@@ -95,6 +96,14 @@ transposeEvent d (Event (On pitch velocity)) = Event (On (pitch+d) velocity) ; transposeEvent d (Event (Off pitch velocity)) = Event (Off (pitch+d) velocity) ; transposeEvent _d event = event ;+++changeTempo :: Integer -> [Event Message] -> [Event Message] ;+changeTempo d = map ( changeTempoEvent d ) ;++changeTempoEvent :: Integer -> Event a -> Event a ;+changeTempoEvent c (Wait d) = Wait (c*d) ;+changeTempoEvent _c event = event ; controlCurve :: Time -> Controller -> [Integer] -> [Event Message] ;
live-sequencer.cabal view
@@ -1,5 +1,5 @@ Name: live-sequencer-Version: 0.0.1+Version: 0.0.2 Author: Henning Thielemann and Johannes Waldmann Maintainer: Johannes Waldmann <waldmann@imn.htwk-leipzig.de>, Henning Thielemann <haskell@henning-thielemann.de> Category: Sound, Music, GUI@@ -13,6 +13,9 @@ An editor shows a textual description of music (like Haskore), an interpreter computes and emits a stream of MIDI events, and (that's the main point) the user can change the program on the fly.+ Additionally the state of the interpreter is shown+ in the form of the current reduced term+ for educational and debugging purposes. . 1. example usage ***** .@@ -50,20 +53,32 @@ in order to assign the event to the particular MIDI channel. If you omit this constructor then the event is put to channel 0. .+ In each step, the head of the @main@ stream gets reduced+ to head normal form (with @:@ at the top),+ and the first arg of the @:@ gets fully expanded+ and it must be a MIDI event.+ . 2. input language ***** .- The used language is Haskell with+ The used language is syntactically almost a subset of Haskell with only strict pattern matching and pattern matching only at the definition level (no case), no local bindings (no lambda, let, where),- no types (no type inference, type signatures and type declarations are skipped)+ no types (no type inference, type signatures and type declarations are skipped),+ and with diet syntax (i.e. drastically reduced syntactic sugar,+ like no layout rule, no do syntax, no list comprehension, no operator sections). . Semantics is similar to lazy evaluation, but we have no sharing.- In each step, the head of the @main@ stream gets reduced- to head normal form (with @:@ at the top),- and the first arg of the @:@ gets fully expanded- and it must be a midi event.+ The design goal is that code can be changed+ while the program is running.+ This implies that evaluation of one expression+ may give different results at different times+ (e.g., during a live performance,+ one changes some chords of a musical theme).+ In turn, this implies that we do not store+ and share results of evaluations,+ hence, we don't have local bindings. . You may import and use the special functions 'Controls.checkBox', 'Controls.slider'@@ -285,13 +300,17 @@ Source-Repository this Type: git- Tag: 0.0+ Tag: 0.0.2 Location: http://code.haskell.org/~thielema/livesequencer/ Flag gui Description: Build the wxWidgets GUI for the sequencer Default: True +Flag mplayer+ Description: Build the remote controller to the mplayer+ Default: True+ Flag httpServer Description: Enable access to modules via a web browser Default: True@@ -354,7 +373,7 @@ If impl(ghc>=7.0) GHC-Options: -fwarn-unused-do-bind -fwarn-missing-import-lists Build-Depends:- transformers >=0.2.2 && <0.3,+ transformers >=0.2.2 && <0.4, explicit-exception >=0.1.5 && <0.2, parsec >=2.1 && <3.2, pretty >=1.0 && <1.2,@@ -377,8 +396,8 @@ Build-Depends: wx >=0.12.1 && <0.13, wxcore >=0.12.1 && <0.13,- stm >=2.2 && <2.3,- transformers >=0.2.2 && <0.3,+ stm >=2.2 && <2.4,+ transformers >=0.2.2 && <0.4, explicit-exception >=0.1.5 && <0.2, parsec >=2.1 && <3.2, pretty >=1.0 && <1.2,@@ -442,3 +461,27 @@ Other-Modules: HTTPServer.Option HTTPServer.GUI++Executable live-mplayer-control+ If flag(mplayer)+ Build-Depends:+ midi-alsa >=0.1.1 && <0.2,+ midi >=0.1.5 && <0.2,+ alsa-seq >=0.5 && <0.6,+ alsa-core >=0.5 && <0.6,+ unix >=2.4 && <2.6,+ directory >=1.0 && <1.2,+ transformers >=0.2.2 && <0.4,+ base >=4.2 && <5+ Else+ Buildable: False++ Hs-Source-Dirs: src+ Main-is: MPlayer.hs++ Other-Modules:+ Option.Utility++ GHC-Options: -threaded -Wall+ If impl(ghc>=7.0)+ GHC-Options: -fwarn-tabs -fwarn-incomplete-uni-patterns
src/ALSA.hs view
@@ -22,6 +22,7 @@ import Control.Monad.Trans.Cont ( ContT(ContT), runContT, mapContT ) import Control.Monad ( (<=<) ) import Control.Functor.HT ( void )+import qualified Data.Foldable as Fold import Data.Foldable ( Foldable, forM_, foldMap ) import Data.Monoid ( mappend ) @@ -102,11 +103,14 @@ Sequencer mode -> IO [Event.T] allNotesOff sq = do c <- Client.getId (handle sq)- return $- map (Event.simple (Addr.Cons c (publicPort sq)) .- Event.CtrlEv Event.Controller .- flip MIDI.modeEvent ModeMsg.AllNotesOff)- [minBound .. maxBound]+ return $ do+ port <- Fold.toList $ ports sq+ chan <- [minBound .. maxBound]+ return $+ Event.simple (Addr.Cons c port) $+ Event.CtrlEv Event.Controller $+ MIDI.modeEvent chan ModeMsg.AllNotesOff+ parseAndConnect :: (SndSeq.AllowInput mode, SndSeq.AllowOutput mode) =>
+ src/MPlayer.hs view
@@ -0,0 +1,133 @@+{- |+This program receives MIDI commands+and controls MPlayer accordingly.++The program listens to MIDI channel 0.++When the program receives AllNotesOff or AllNotesOn it pauses MPlayer.++If the program receives a MIDI-CC 0 with value 0,+then it seeks a certain position in the movie and triggers playback.++You can set the seek time by sending the following controller changes:++* CC 1: 100th seconds++* CC 2: seconds++* CC 3: minutes++* CC 4: hours+-}+module Main where++import qualified Sound.MIDI.Message.Channel as ChannelMsg+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg+import qualified Sound.MIDI.Message.Channel.Mode as ModeMsg+import qualified Sound.MIDI.ALSA.Check as Check++import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc++import qualified Control.Monad.Trans.State as MS+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad (when, forever, )+import Data.Foldable (forM_, )++import qualified System.Directory as Dir+import qualified System.Posix.Files as File+import qualified System.IO as IO+import qualified System.Environment as Env+import qualified Control.Exception as Exc++import qualified Text.Printf as Printf++import Option.Utility (exitFailureMsg)+++defltPipeName :: FilePath+defltPipeName = "/tmp/mppipe"++seqName :: String+seqName = "MPlayer control"++channel :: ChannelMsg.Channel+channel = ChannelMsg.toChannel 0++commands :: MonadIO io => IO.Handle -> [String] -> io ()+commands pipe =+ liftIO . mapM_ (\cmd -> putStrLn cmd >> IO.hPutStrLn pipe cmd)+++data Time = Time {hours, minutes, seconds, fracSecs :: Int}+ deriving (Show)+++main :: IO ()+main = do+ args <- Env.getArgs+ case args of+ _:_:_ -> exitFailureMsg "too many arguments"+ [pipeName] -> process pipeName+ [] ->+ Exc.bracket_+ (File.createNamedPipe defltPipeName 0o644 >>+ putStrLn ("Created pipe: " ++ defltPipeName))+ (Dir.removeFile defltPipeName)+ (process defltPipeName)++process :: FilePath -> IO ()+process pipeName = (do+ pipe <- IO.openFile pipeName IO.WriteMode+ IO.hSetBuffering pipe IO.LineBuffering+ putStrLn $ "Start MPlayer like this:"+ putStrLn $ "mplayer -input file=" ++ pipeName+ putStrLn ""++ SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+ Client.setName (h :: SndSeq.T SndSeq.InputMode) seqName+ putStrLn $ "Created sequencer: " ++ seqName+ putStrLn $ "Start the live sequencer like this:"+ putStrLn $ "live-sequencer --new-out-port control --connect-to " ++ show seqName+ putStrLn ""+ putStrLn $ "or connect with the live sequencer like this:"+ putStrLn $ "aconnect Rewrite:1 " ++ show seqName+ putStrLn ""++ Port.withSimple h "control"+ (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do++ flip MS.evalStateT (Time 0 0 0 0) $ forever $ do+ ev <- liftIO $ Event.input h+ -- print ev+ forM_ (Check.mode channel ev) $ \mode ->+ case mode of+ {-+ 'pause' toggles the playing mode+ To make sure, that 'pause' stops,+ we have to run the movie with 'seek' first.+ -}+ ModeMsg.AllNotesOff -> commands pipe ["seek 0", "pause"]+ ModeMsg.AllSoundOff -> commands pipe ["seek 0", "pause"]+ _ -> return ()++ forM_ (Check.anyController channel ev) $ \(ctrl, val) -> do+ let setTime update cc =+ when (ctrl == VoiceMsg.toController cc) $+ MS.modify update++ setTime (\t -> t {fracSecs = val}) 1+ setTime (\t -> t {seconds = val}) 2+ setTime (\t -> t {minutes = val}) 3+ setTime (\t -> t {hours = val}) 4++ when (ctrl == VoiceMsg.toController 0 && val == 0) $ do+ (Time hr m s f) <- MS.get+ commands pipe [Printf.printf "seek %d.%02d 2" (hr*3600 + m*60 + s) f]++ )+ `AlsaExc.catch` \e ->+ putStrLn $ "alsa_exception: " ++ AlsaExc.show e