-- Copyright 2017 Evan Laforge -- This program is distributed under the terms of the GNU General Public -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt -- | Hand edit notes for testing. module Synth.Sampler.TestNotes where import qualified Data.Map as Map import qualified Util.Lists as Lists import qualified Derive.Attrs as Attrs import qualified Derive.Stack as Stack import qualified Perform.NN as NN import qualified Perform.Pitch as Pitch import qualified Synth.Shared.Control as Control import qualified Synth.Shared.Note as Note import qualified Synth.Shared.Signal as Signal import Global import Types write :: [Note.Note] -> IO Bool write :: [Note] -> IO Bool write = FilePath -> [Note] -> IO Bool Note.serialize FilePath "sampler.notes" dynamicTest :: [Note.Note] dynamicTest :: [Note] dynamicTest = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith RealTime -> Y -> Note make1 [RealTime] starts (forall a. (Num a, Ord a) => a -> a -> a -> [a] Lists.range Y 0 Y 1 Y 0.05) where starts :: [RealTime] starts = forall a. Num a => a -> a -> [a] Lists.range_ RealTime 0 RealTime 0.5 make1 :: RealTime -> Y -> Note make1 RealTime start Y dyn = (RealTime, Maybe Signal, Signal, [PatchName]) -> Note make (RealTime start, NoteNumber -> Maybe Signal nn NoteNumber NN.c4, forall {k} (kind :: k). Y -> Signal kind Signal.constant Y dyn, [PatchName "open"]) notes :: [Note.Note] notes :: [Note] notes = forall a b. (a -> b) -> [a] -> [b] map (RealTime, Maybe Signal, Signal, [PatchName]) -> Note make [ (RealTime 0, NoteNumber -> Maybe Signal nn NoteNumber NN.c4, forall {k} {kind :: k}. [(RealTime, Y)] -> Signal kind env [(RealTime 0, Y 0.15), (RealTime 0.25, Y 0.15), (RealTime 0.3, Y 0)], [PatchName "open"]) , (RealTime 0.5, NoteNumber -> Maybe Signal nn NoteNumber NN.d4, forall {k} (kind :: k). Y -> Signal kind vel Y 0.35, [PatchName "open"]) , (RealTime 1, forall {k} {kind :: k}. [(RealTime, NoteNumber)] -> Maybe (Signal kind) pcurve [(RealTime 1, NoteNumber NN.a3), (RealTime 1.25, NoteNumber NN.ds4)], forall {k} (kind :: k). Y -> Signal kind vel Y 1, [PatchName "open"]) -- , (2, Nothing, vel 0.5, ["cek"]) -- , (2.2, Nothing, vel 0.75, ["cek"]) -- , (2.4, Nothing, vel 1, ["cek"]) ] where env :: [(RealTime, Y)] -> Signal kind env = forall {k} {kind :: k}. [(RealTime, Y)] -> Signal kind Signal.from_pairs vel :: Y -> Signal kind vel = forall {k} (kind :: k). Y -> Signal kind Signal.constant pcurve :: [(RealTime, NoteNumber)] -> Maybe (Signal kind) pcurve = forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} {kind :: k}. [(RealTime, Y)] -> Signal kind Signal.from_pairs forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map (forall (p :: * -> * -> *) b c a. Bifunctor p => (b -> c) -> p a b -> p a c second NoteNumber -> Y Pitch.nn_to_double) nn :: Pitch.NoteNumber -> Maybe Signal.Signal nn :: NoteNumber -> Maybe Signal nn = forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} (kind :: k). Y -> Signal kind Signal.constant forall b c a. (b -> c) -> (a -> b) -> a -> c . NoteNumber -> Y Pitch.nn_to_double make :: (RealTime, Maybe Signal.Signal, Signal.Signal, [Text]) -> Note.Note make :: (RealTime, Maybe Signal, Signal, [PatchName]) -> Note make (RealTime start, Maybe Signal pitch, Signal dyn, [PatchName] attrs) = Note.Note { patch :: PatchName patch = PatchName "test" , instrument :: Instrument instrument = Instrument "test-inst" , element :: PatchName element = PatchName "" , trackId :: Maybe TrackId trackId = forall a. Maybe a Nothing , start :: RealTime start = RealTime start , duration :: RealTime duration = RealTime 0 -- the sampler uses envelope, not duration , controls :: Map Control Signal controls = forall k a. Ord k => [(k, a)] -> Map k a Map.fromList forall a b. (a -> b) -> a -> b $ (Control Control.dynamic, Signal dyn) forall a. a -> [a] -> [a] : forall b a. b -> (a -> b) -> Maybe a -> b maybe [] ((forall a. a -> [a] -> [a] :[]) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Control Control.pitch,)) Maybe Signal pitch , attributes :: Attributes attributes = [PatchName] -> Attributes Attrs.attrs [PatchName] attrs , stack :: Stack stack = Stack Stack.empty }