diff --git a/Sound/Tidal/Dirt.hs b/Sound/Tidal/Dirt.hs --- a/Sound/Tidal/Dirt.hs +++ b/Sound/Tidal/Dirt.hs @@ -45,7 +45,7 @@ F "bandf" (Just 0), F "bandq" (Just 0) ], - timestamp = True + timestamp = MessageStamp } @@ -54,7 +54,7 @@ params = [ I "ksymbol" Nothing, F "kpitch" (Just 1) ], - timestamp = True + timestamp = MessageStamp } dirtstart name = start "127.0.0.1" 7771 dirt diff --git a/Sound/Tidal/Stream.hs b/Sound/Tidal/Stream.hs --- a/Sound/Tidal/Stream.hs +++ b/Sound/Tidal/Stream.hs @@ -31,9 +31,12 @@ instance Show Param where show p = name p +data TimeStamp = BundleStamp | MessageStamp | NoStamp + deriving Eq + data OscShape = OscShape {path :: String, params :: [Param], - timestamp :: Bool + timestamp :: TimeStamp } type OscMap = Map.Map Param (Maybe Datum) @@ -82,7 +85,8 @@ usec = floor $ 1000000 * (logicalOnset - (fromIntegral sec)) oscdata = catMaybes $ mapMaybe (\x -> Map.lookup x m') (params shape) oscdata' = ((int32 sec):(int32 usec):oscdata) - osc | timestamp shape = sendOSC s $ Message (path shape) oscdata' + osc | timestamp shape == BundleStamp = sendOSC s $ Bundle (ut_to_ntpr logicalOnset) [Message (path shape) oscdata] + | timestamp shape == MessageStamp = sendOSC s $ Message (path shape) oscdata' | otherwise = doAt logicalOnset $ sendOSC s $ Message (path shape) oscdata return osc @@ -140,6 +144,7 @@ makeF :: OscShape -> String -> Pattern Double -> OscPattern makeF = make float +makeI :: OscShape -> String -> Pattern Int -> OscPattern makeI = make int32 param :: OscShape -> String -> Param diff --git a/Sound/Tidal/VolcaKeys.hs b/Sound/Tidal/VolcaKeys.hs new file mode 100644 --- /dev/null +++ b/Sound/Tidal/VolcaKeys.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Sound.Tidal.VolcaKeys where + +import qualified Sound.ALSA.Sequencer.Address as Addr +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 Sound.ALSA.Sequencer.Connect as Connect +import GHC.Word +import GHC.Int + +import Sound.OSC.FD +import qualified Data.Map as Map +import Control.Applicative +import Control.Concurrent.MVar +--import Visual +import Data.Hashable +import Data.Bits +import Data.Maybe +import System.Process +import Control.Concurrent + +import Sound.Tidal.Stream +import Sound.Tidal.Pattern +import Sound.Tidal.Parse + +channel = Event.Channel 0 + +keys :: OscShape +keys = OscShape {path = "/note", + params = [ I "note" Nothing, + F "dur" (Just (0.05)), + F "portamento" (Just (-1)), + F "expression" (Just (-1)), + F "voice" (Just (-1)), + F "octave" (Just (-1)), + F "detune" (Just (-1)), + F "vcoegint" (Just (-1)), + F "kcutoff" (Just (-1)), + F "vcfegint" (Just (-1)), + F "lforate" (Just (-1)), + F "lfopitchint" (Just (-1)), + F "lfocutoffint" (Just (-1)), + F "attack" (Just (-1)), + F "decay" (Just (-1)), + F "sustain" (Just (-1)), + F "dtime" (Just (-1)), + F "dfeedback" (Just (-1)) + ], + timestamp = NoStamp + } + +keyStream = stream "127.0.0.1" 7303 keys + +note = makeI keys "note" +dur = makeF keys "dur" +portamento = makeF keys "portamento" +expression = makeF keys "expression" +octave = makeF keys "octave" +voice = makeF keys "voice" +detune = makeF keys "detune" +vcoegint = makeF keys "vcoegint" +kcutoff = makeF keys "kcutoff" +vcfegint = makeF keys "vcfegint" +lforate = makeF keys "lforate" +lfopitchint = makeF keys "lfopitchint" +lfocutoffint = makeF keys "lfocutoffint" +attack = makeF keys "attack" +decay = makeF keys "decay" +sustain = makeF keys "sustain" +dtime = makeF keys "dtime" +dfeedback = makeF keys "dfeedback" + + +keynames = map name (tail $ tail $ params keys) + +keyproxy latency midiport = + do h <- SndSeq.openDefault SndSeq.Block + Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Tidal" + c <- Client.getId h + p <- Port.createSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric + conn <- Connect.createTo h p =<< Addr.parse h midiport + x <- udpServer "127.0.0.1" 7303 + forkIO $ loop h conn x + return () + where loop h conn x = do m <- recvMessage x + act h conn m + loop h conn x + act h conn (Just (Message "/note" (note:dur:ctrls))) = + do -- print $ "Got note " ++ show note + let note' = (fromJust $ d_get note) :: Int + dur' = (fromJust $ d_get dur) :: Float + ctrls' = (map (fromJust . d_get) ctrls) :: [Float] + sendmidi latency h conn (fromIntegral note', dur') ctrls' + return () + + +sendmidi latency h conn (note,dur) ctrls = + do forkIO $ do threadDelay latency + Event.outputDirect h $ noteOn conn note 60 + threadDelay (floor $ 1000000 * dur) + Event.outputDirect h $ noteOff conn note + return () + let ctrls' = map (floor . (* 127)) ctrls + ctrls'' = filter ((>=0) . snd) (zip keynames ctrls') + --ctrls''' = map (\x -> (x, fromJust $ lookup x ctrls'')) usectrls + --putStrLn $ show ctrls'' + sequence_ $ map (\(name, ctrl) -> Event.outputDirect h $ makeCtrl conn (ctrlN name ctrl)) ctrls'' + return () + +ctrlN "portamento" v = (5, v) +ctrlN "expression" v = (11, v) +ctrlN "voice" v = (40, v) +ctrlN "octave" v = (41, v) +ctrlN "detune" v = (42, v) +ctrlN "vcoegint" v = (43, v) +ctrlN "kcutoff" v = (44, v) +ctrlN "vcfegint" v = (45, v) +ctrlN "lforate" v = (46, v) +ctrlN "lfopitchint" v = (47, v) +ctrlN "lfocutoffint" v = (48, v) +ctrlN "attack" v = (49, v) +ctrlN "decay" v = (50, v) +ctrlN "sustain" v = (51, v) +ctrlN "dtime" v = (52, v) +ctrlN "dfeedback" v = (53, v) +ctrlN s _ = error $ "no match for " ++ s + + + + +noteOn :: Connect.T -> Word8 -> Word8 -> Event.T +noteOn conn val vel = + Event.forConnection conn + $ Event.NoteEv Event.NoteOn + $ Event.simpleNote channel + (Event.Pitch (val)) + (Event.Velocity vel) + +noteOff :: Connect.T -> Word8 -> Event.T +noteOff conn val = + Event.forConnection conn + $ Event.NoteEv Event.NoteOff + $ Event.simpleNote channel + (Event.Pitch (val)) + (Event.normalVelocity) + +makeCtrl :: Connect.T -> (Word32, GHC.Int.Int32) -> Event.T +makeCtrl conn (c, n) = + Event.forConnection conn + $ Event.CtrlEv Event.Controller $ Event.Ctrl + channel + (Event.Parameter c) + (Event.Value n) diff --git a/tidal.cabal b/tidal.cabal --- a/tidal.cabal +++ b/tidal.cabal @@ -1,5 +1,5 @@ name: tidal -version: 0.4.17 +version: 0.4.19 synopsis: Pattern language for improvised music -- description: homepage: http://yaxu.org/tidal/ @@ -26,6 +26,7 @@ Sound.Tidal.Tempo Sound.Tidal.Time Sound.Tidal.Context + Sound.Tidal.VolcaKeys Sound.Tidal.Utils - Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt + Build-depends: base < 5, process, parsec, hosc > 0.13, hashable, colour, containers, time, websockets > 0.8, text, mtl >=2.1, transformers, mersenne-random-pure64,binary, bytestring, hmt, alsa-seq, alsa-core diff --git a/tidal.el b/tidal.el --- a/tidal.el +++ b/tidal.el @@ -55,7 +55,8 @@ tidal-interpreter-arguments) (tidal-see-output)) (tidal-send-string ":set prompt \"\"") - (tidal-send-string ":module Sound.Tidal.Context") + (tidal-send-string "import Sound.Tidal.Context") + (tidal-send-string "import Sound.Tidal.VolcaKeys") ; (tidal-send-string "import Volca.Beat") ; (tidal-send-string "import Volca.Key") ; (tidal-send-string "(note, [portamento, expression, voice, octave, detune, vcoegint, kcutoff, vcfegint, lforate, lfopitchint, lfocutoffint, attack, decay, sustain, dtime , dfeedback], keystop) <- keystart") @@ -70,9 +71,10 @@ (tidal-send-string "d8 <- dirtStream") (tidal-send-string "d9 <- dirtStream") (tidal-send-string "d10 <- dirtStream") + (tidal-send-string "k1 <- keyStream") (tidal-send-string "(cps, getNow) <- bpsUtils") (tidal-send-string "let bps x = cps (x/2)") - (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10]") + (tidal-send-string "let hush = mapM_ ($ silence) [d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,k1]") (tidal-send-string "let solo = (>>) hush") (tidal-send-string ":set prompt \"tidal> \"") )