csound-expression-typed 0.0.8 → 0.0.9

raw patch · 17 files changed

+194/−19 lines, 17 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +15/−1
• data/hrtf-44100-left.dat binary
• data/hrtf-44100-right.dat binary
• data/hrtf-48000-left.dat binary
• data/hrtf-48000-right.dat binary
• data/hrtf-96000-left.dat binary
• data/hrtf-96000-right.dat binary
• src/Csound/Typed.hs +3/−1
• src/Csound/Typed/Control/Midi.hs +1/−1
• src/Csound/Typed/GlobalState.hs +1/−0
• src/Csound/Typed/GlobalState/Elements.hs +10/−6
• src/Csound/Typed/GlobalState/GE.hs +35/−3
• src/Csound/Typed/GlobalState/Opcodes.hs +38/−5
• src/Csound/Typed/GlobalState/Options.hs +0/−1
• src/Csound/Typed/Gui/Widget.hs +1/−1
• src/Csound/Typed/Misc.hs +59/−0
• src/Csound/Typed/Types/Prim.hs +31/−0

@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.0.8+Version:       0.0.9 Cabal-Version: >= 1.22 License:       BSD3 License-file:  LICENSE@@ -13,6 +13,17 @@  Description:    +Data-Files :+    data/hrtf-44100-left.dat+    data/hrtf-44100-right.dat++    data/hrtf-48000-left.dat+    data/hrtf-48000-right.dat++    data/hrtf-96000-left.dat+    data/hrtf-96000-right.dat++ Homepage:        https://github.com/anton-k/csound-expression-typed Bug-Reports:     https://github.com/anton-k/csound-expression-typed/issues @@ -69,8 +80,11 @@     Csound.Typed.Gui.BoxModel      Csound.Typed.Constants+    Csound.Typed.Misc      Csound.Typed.Lib.StableMaps.Dynamic     Csound.Typed.Lib.StableMaps.Dynamic.Map++    Paths_csound_expression_typed    Default-Language: Haskell2010

binary file changed (absent → 188416 bytes)

binary file changed (absent → 188416 bytes)

binary file changed (absent → 188416 bytes)

binary file changed (absent → 188416 bytes)

binary file changed (absent → 376832 bytes)

binary file changed (absent → 376832 bytes)

@@ -2,10 +2,12 @@     module Csound.Typed.Types,     module Csound.Typed.Control,     module Csound.Typed.Render,-    module Csound.Typed.Constants+    module Csound.Typed.Constants,+    module Csound.Typed.Misc ) where  import Csound.Typed.Types import Csound.Typed.Control import Csound.Typed.Render import Csound.Typed.Constants+import Csound.Typed.Misc

@@ -85,4 +85,4 @@ -- midi volume factor  scaleMidiVolumeFactor :: Sigs a => a -> a-scaleMidiVolumeFactor = mapTuple (C.midiVolumeFactor (pn 1) * )+scaleMidiVolumeFactor = mapTuple (setRate Ir (C.midiVolumeFactor (pn 1)) * )

@@ -10,6 +10,7 @@     getIn, chnUpdateUdo, renderGlobals, turnoff, turnoff2, exitnow,      oscListen, oscInit, oscSend,     chnSet, chnGet, freeChn,+    tableK, tableI,     readChnEvtLoop,     masterUpdateChnAlive,     servantUpdateChnAlive,

@@ -3,7 +3,7 @@     -- * Identifiers     IdMap(..), saveId, newIdMapId,     -- ** Gens-    GenMap, newGen, newGenId, nextGlobalGenCounter,+    GenMap, newGen, newGenId, nextGlobalGenCounter, newTabOfGens,     -- Sf2     SfFluid(..), SfSpec(..), SfMap, newSf, sfVar, renderSf,     -- ** Band-limited waveforms@@ -30,11 +30,11 @@  import Control.Monad.Trans.State.Strict import Control.Monad(zipWithM_)-import Control.Applicative(liftA2) import Data.Default import qualified Data.Map as M import qualified Data.IntMap as IM +import qualified Csound.Typed.GlobalState.Opcodes as C(midiVolumeFactor)  import Csound.Dynamic.Types import Csound.Dynamic.Build@@ -74,6 +74,10 @@ newGen :: Gen -> State GenMap E newGen = fmap int . saveId +newTabOfGens :: [Gen] -> State GenMap E+newTabOfGens = fmap int . (saveId . intTab =<<) . mapM saveId+    where intTab ns = Gen (length ns) (-2) (fmap fromIntegral ns) Nothing+ newGenId :: State GenMap Int newGenId = newIdMapId @@ -356,12 +360,12 @@     return (fmap readOnlyVar vars, zipWithM_ (appendVarBy (+)) vars sigs)  sendChn :: Monad m => Int -> Int -> [E] -> DepT m ()-sendChn arityIns arityOuts sigs = writeChn (chnRefFromParg (chnPargId arityIns) arityOuts) sigs+sendChn arityIns arityOuts sigs = writeChn (chnRefFromParg (chnPargId arityIns) arityOuts) (fmap scaleVolumeFactor sigs)  chnPargId :: Int -> Int chnPargId arityIns = 4 + arityIns --- guis--+scaleVolumeFactor :: E -> E+scaleVolumeFactor = (setRate Ir (C.midiVolumeFactor (pn 1)) * ) +-- guis

@@ -1,3 +1,4 @@+{-# Language TupleSections #-} module Csound.Typed.GlobalState.GE(     GE, Dep, History(..), withOptions, withHistory, getOptions, evalGE, execGE,     getHistory, putHistory,@@ -14,7 +15,7 @@     -- * Notes     addNote,     -- * GEN routines-    saveGen, getNextGlobalGenId,+    saveGen, saveTabs, getNextGlobalGenId,     -- * Sf2     saveSf, sfTable,     -- * Band-limited waves@@ -28,9 +29,13 @@     newGuiVar, getPanels, guiHandleToVar,     guiInstrExp,     listenKeyEvt, Key(..), KeyEvt(..), Guis(..),-    getKeyEventListener+    getKeyEventListener,+    -- * Hrtf pan+    simpleHrtfmove, simpleHrtfstat ) where +import Paths_csound_expression_typed+ import Control.Applicative import Control.Monad import Data.Boolean@@ -49,6 +54,7 @@ import Csound.Typed.GlobalState.Cache import Csound.Typed.GlobalState.Elements import Csound.Typed.Constants(infiniteDur)+import Csound.Typed.GlobalState.Opcodes(hrtfmove, hrtfstat)  import Csound.Typed.Gui.Gui(Panel(..), Win(..), GuiNode, GuiHandle(..), restoreTree, guiMap, mapGuiOnPanel, defText) @@ -155,8 +161,12 @@  saveGen :: Gen -> GE E saveGen = onGenMap . newGen-    where onGenMap = onHistory genMap (\val h -> h{ genMap = val }) +onGenMap = onHistory genMap (\val h -> h{ genMap = val })++saveTabs :: [Gen] -> GE E+saveTabs = onGenMap . newTabOfGens+ onSfMap :: State SfMap a -> GE a onSfMap = onHistory sfMap (\val h -> h{ sfMap = val }) @@ -482,3 +492,25 @@             return $ Just (Instr keyEventInstrId body)  +-----------------------------------------------+-- head pan++simpleHrtfmove :: E -> E -> E -> E -> E ->  E -> GE (E, E)+simpleHrtfmove a1 a2 a3 a4 a5 a6 = do+    (left, right) <- getHrtfFiles+    return $ hrtfmove a1 a2 a3 left right a4 a5 a6++simpleHrtfstat :: E -> E -> E -> E -> E -> GE (E, E)+simpleHrtfstat a1 a2 a3 a4 a5 = do+    (left, right) <- getHrtfFiles+    return $ hrtfstat a1 a2 a3 left right a4 a5++getHrtfFiles :: GE (E, E)+getHrtfFiles = do+    sr <- fmap defSampleRate getOptions+    (left, right) <- liftIO $ hrtfFileNames sr+    return (str left, str right)++hrtfFileNames :: Int -> IO (String, String)+hrtfFileNames sr = liftA2 (,) (getDataFileName (name "left" sr)) (getDataFileName (name "right" sr))+    where name dir n = concat ["data/hrtf-", show n, "-", dir, ".dat"]

@@ -25,7 +25,11 @@     -- * Soundfonts     sfSetList,     -- * Midi-    midiVolumeFactor+    midiVolumeFactor,+    -- * Hrtf Pan+    hrtfmove, hrtfstat,+    -- * Read tables+    tableK, tableI ) where  import Prelude hiding ((<*))@@ -347,12 +351,41 @@ ----------------------------------------------------------- -- midi volume factor (normalize by number of notes) +-- if we use the scaling at I-rate we don't need to use portamento.+-- If we want to scale with signal the portamento is must midiVolumeFactor :: E -> E-midiVolumeFactor idx = flip port 0.0015 $ ifB (n ==* 0) 1 (recip n)-    where n = sqrt (active idx)+midiVolumeFactor idx = ifB (n <* 2) 1 (recip sqrtN)+    where sqrtN = sqrt n+          n     = activeIr idx  active :: E -> E    -active instrId = opcs "active" [(Kr, [Ir])] [instrId]+active instrId = opcs "active" [(Kr, [Ir]), (Ir, [Ir])] [instrId] +activeIr :: E -> E    +activeIr instrId = opcs "active" [(Ir, [Ir])] [instrId]+ port :: E -> E -> E-port a b = opcs "port" [(Kr, [Kr, Ir])] [a, b]+port a b = opcs "portk" [(Kr, [Kr, Ir])] [a, b]++-----------------------------------------------------------++getPair mout = (a, b)+    where [a, b] = mout 2++hrtfmove :: E -> E -> E -> E -> E -> E -> E -> E -> (E, E)+hrtfmove a1 a2 a3 a4 a5 a6 a7 a8 = getPair $ mopcs "hrtfmove2" ([Ar, Ar], [Ar, Kr, Kr, Ir, Ir, Ir, Ir, Ir]) [a1, a2, a3, a4, a5, a6, a7, a8]++hrtfstat :: E -> E -> E -> E -> E -> E -> E -> (E, E)+hrtfstat a1 a2 a3 a4 a5 a6 a7 = getPair $ mopcs "hrtfstat" ([Ar, Ar], [Ar, Ir, Ir, Ir, Ir, Ir, Ir]) [a1, a2, a3, a4, a5, a6, a7]+++-----------------------------------------------------------+-- read tables++tableK :: E -> E -> E+tableK a1 a2 = opcs "table" [(Kr, [Kr, Ir])] [a1, a2]++tableI :: E -> E -> E+tableI a1 a2 = opcs "table" [(Ir, [Ir, Ir])] [a1, a2]++

@@ -11,7 +11,6 @@ ) where  import Control.Applicative-import Data.Monoid import Data.Default import qualified Data.IntMap as IM 

@@ -78,7 +78,7 @@ -- | Renders the GUI elements on the window. We can specify the window title -- and rectangle of the window. Panesls are sensitive to keyboard events. keyPanelBy :: String -> Maybe Rect -> Gui -> SE ()-keyPanelBy = genPanelBy False+keyPanelBy = genPanelBy True  genPanelBy :: Bool -> String -> Maybe Rect -> Gui -> SE () genPanelBy isKeybd title mrect gui = geToSe $ saveGuiRoot $ Single (Win title mrect gui) isKeybd

@@ -0,0 +1,59 @@+module Csound.Typed.Misc(+    HeadPanSpec(..), headPan, headPan', staticHeadPan+) where++import Data.Default+import Csound.Typed.Types+import Csound.Typed.GlobalState++-- | Static head response based spacialization. It works when you listen in headphones.+-- It works only with sample rate of 44100, 48000 or 96000. It's more efficient than @headPan@.+--+-- > staticHeadPan (azimuth, elevation) asig+--+-- azimuth and elevation are measured in ratios (0, 1),+staticHeadPan :: (D, D) -> Sig -> Sig2+staticHeadPan (az, elev) asrc = toTuple $ do+        azExpr   <- toGE $ -90 + 180 * az+        elevExpr <- toGE $ -40 + 130 * elev+        asrcExpr <- toGE asrc                +        sr       <- toGE $ getSampleRate+        (a1, a2) <- simpleHrtfstat asrcExpr azExpr elevExpr iradius sr+        return [a1, a2]+        where iradius = 9.0++-- | Optional arguments for opcode hrtfmove.+--+-- phase is 0 or 1+--+-- fade is 1 to 24.+--+-- See csound docs for hrtfmove for details.+data HeadPanSpec = HeadPanSpec +    { headPanPhase :: D+    , hradPanFade  :: D+    }++instance Default HeadPanSpec where+    def = HeadPanSpec 0 8++-- | Head response based spacialization. It works when you listen in headphones.+-- It works only with sample rate of 44100, 48000 or 96000.+--+-- > headPan (azimuth, elevation) asig+--+-- azimuth and elevation are measured in ratios (0, 1),+headPan :: (Sig, Sig) -> Sig -> Sig2+headPan = headPan' def++-- | HeadPan with optional arguments.+headPan' :: HeadPanSpec -> (Sig, Sig) -> Sig -> Sig2+headPan' spec (az, elev) asrc = toTuple $ do+        azExpr   <- toGE $ -90 + 180 * az+        elevExpr <- toGE $ -40 + 130 * elev+        asrcExpr <- toGE asrc        +        phase    <- toGE $ headPanPhase spec+        fade     <- toGE $ hradPanFade  spec+        sr       <- toGE $ getSampleRate+        (a1, a2) <- simpleHrtfmove asrcExpr azExpr elevExpr phase fade sr+        return [a1, a2]

@@ -7,6 +7,7 @@     preTab, TabSize(..), TabArgs(..), updateTabSize,     fromPreTab, getPreTabUnsafe, skipNorm, forceNorm,     nsamp, ftlen, ftchnls, ftsr, ftcps,+    TabList, tabList, fromTabList, fromTabListD,      -- ** constructors     double, int, text, @@ -44,6 +45,7 @@ import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE import Csound.Typed.GlobalState.Options+import Csound.Typed.GlobalState.Opcodes(tableK, tableI)  -- | Signals data Sig  @@ -237,6 +239,33 @@     Tab _ -> error "you can change size only for primitive tables (made with gen-routines)"     TabPre a -> TabPre $ a{ preTabSize = phi $ preTabSize a } ++----------------------------------------------------------------------------+-- Tab of tabs++-- | Container list of tables +data TabList = TabList { unTabList :: GE E }++tabList :: [Tab] -> TabList+tabList xs = TabList $ saveTabs =<< mapM fromPreTab (getPreTabs xs)+    where +        getPreTabs xs = case xs of+            []            -> []+            Tab    _ : as -> getPreTabs as+            TabPre a : as -> a : getPreTabs as++fromTabList :: TabList -> Sig -> Tab+fromTabList ts knd = Tab $ do+    ets  <- toGE ts+    eknd <- toGE knd+    return $ tableK eknd ets++fromTabListD :: TabList -> D -> Tab+fromTabListD ts ind = Tab $ do+    ets  <- toGE ts+    eind <- toGE ind+    return $ tableI eind ets+ ------------------------------------------------------------------------------- -- constructors @@ -320,6 +349,8 @@ instance Val Str    where { fromGE = Str    ; toGE = unStr  } instance Val Spec   where { fromGE = Spec   ; toGE = unSpec } instance Val Wspec  where { fromGE = Wspec  ; toGE = unWspec}++instance Val TabList where { fromGE = TabList; toGE = unTabList }  instance Val Tab where      fromGE = Tab