Merge branch 'master' of https://github.com/Sintrastes/xen-toolbox

.gitignore

@@ -1,6 +1,7 @@
 dist
 dist-*
 cabal-dev
+*~
 *.o
 *.hi
 *.chi

Dockerfile

@@ -0,0 +1,15 @@
+FROM ubuntu:xenial
+MAINTAINER "Nathan Bedell" "nbedell@tulane.edu"
+CMD apt -y update
+CMD apt -y install ghc \
+                   cabal-install \
+                   git \
+                   software-properties-common
+CMD add-apt-repository -y ppa:hvr/ghc
+CMD apt update
+CMD apt -y install ghc-8.4.1
+CMD cabal update
+WORKDIR /root/data/
+CMD git clone https://github.com/Sintrastes/xen-toolbox
+WORKDIR /root/data/xen-toolbox/
+CMD cabal install --with-ghc=/opt/ghc/bin/ghc-8.4.1

README.md

@@ -7,15 +7,74 @@ Xen-toolbox is Haskell library meant to facilitate the composition and playback
 Features/Usage Notes
 --------------------
 
-TODO
+Xentoolbox works by providing a multiparameter `TuningSystem notes group` typeclass, with the `group` type constrained with another typeclass, `AbstractTemperament group`. The idea is that the `notes` in a `TuningSystem` correspond to particular frequencies. The `TuningSystem` typeclass then provide various functions for converting to and from various frequency representations (i.e. fractional midi note numbers, raw frequency in hz), which can then be used by the [fluidsynth](http://www.fluidsynth.org/) (for the playback of soundfonts) and [vivid](http://hackage.haskell.org/package/vivid) (i.e. supercollider) backends for sound generation.
+
+To implement a `Tuningsystem notes group` instance, `group` must implement `AbstractTemperament` and `Group` instances. The idea behind this typeclass being that whereas the `notes` of a `Tuningsystem` are concrete frequencies that can be playedback, the `group` elements of an `AbstractTemperament` represent intervals in that temperament. An `AbstractTemperament g` implements a function `intfreq :: g -> Double` which should be a *group homomorphism*, i.e. for all elements `a,b` of type `g`, it should satisfy `intfreq (a <> b) = intfreq a <> intfreq b`.
+
+Xentools includes several convienient template haskell quasiquoters to facilitate the notation of music in many different temperaments. For example, the following expression gives a value of type `Line NoteBP`, which is a type synonym for `[(NoteBP, Duration)]` -- i.e. a sequence of notes in the Bohlen Pierce tuning, each played for a given `Duration`, which is simply a newtype for a `Rational` from `Data.Ratio`:
+
+```haskell
+[lineBP| C3 1, D3 1, E3 1, F3 1, G3 1, H3 1, J3 1, A3 1, B3 1, C4 4 |]
+```
+
+Most of the template haskell quasiquoters in xentools use the standard western note names (C, D, E, F, G, A, B), but the above example also uses "H" and "J", which are commonly used to notate the Bohlen Pierce scale. The general format of the quasiquoters in xentools is to parse a comma-seperated list of notes, formatted as: `[natural note name][period number][(optional) list of accidentals] [space] [duration]` For example, for our 22edo parser, we use the standard western natural note names, the notation "Is" and "Es" for sharps and flats, respectively, and the additional microtonal accidentals:
+
+  * "Qis": Quarter sharp
+  * "Qes": Quarter flat
+  * "Sis": Sesqui (one-and-a-half) sharp
+  * "Ses": Sesqui (one-and-a-half) flat
+
+Here is an example to see this notation in action:
+
+```haskell
+[line22| E4 2, G4 2, E4 2, GEs4 2%3, GEsQes4 2%3, GEsQesQes4 2%3 |]
+```
+
+Also, notice that rationals inside the quasiquoter are notated the same way that they would be notated in Haskell.
+
+Currently there are several interfaces provided for playing back `Score`s of notes in different tuning systems. The most versatile of these is the function `sequenceNotes'`, and it's usage is documented in `tests/examples.hs`. However, given that xen-tools is currently in pre-release, this interface is liable to change.
+
+Transformations
+---------------
+
+Given some `Line note`s or `Score note`s, we can preform various transformations on them, which can be found in the `Scales.Generic` module provided by xentools. Notably, scores form a [`Semiring`](https://en.wikipedia.org/wiki/Semiring) (from `Data.Semiring` in the `semiring-simple` package). In other words, this means that we can combine two scores of the same type *in sequence* by using the `<.>` operator:
+
+```haskell
+-- two melodic fragments in 12 tone equal temperament
+a = [[line12| C4 2, D4 2, E4 2, C4 2 |]]
+b = [[line12| E4 2, F4 2, G4 4 |]]
+-- a line in 12 tone equal temperament where first "a" is played, immediately
+-- followed by "b"
+abSeq = a <.> b 
+```
+
+And we can play two scores of the same type *in parallel* by using `<+>`:
+
+```haskell
+-- some more melodic fragments
+c = [[line12| G4 1, A4 1, G4 1, F4 1, E4 2, C4 2 |]]
+d = [[line12| C4 2, G3 2, C4 4 |]]
+-- let's make them into a tune!
+frereJacque = a <.> a <.> b <.> b <.> c <.> c <.> d <.> d
+-- ... and make that tune a round!
+frereJacqueRound = (rest 8 <.> frereJacque) <+> frereJacque 
+```
+
 
 Installation Instructions
 -------------------------
 
-First, ensure that you have cabal, supercollider, and fluidsynth installed on your machine. On recent versions of Ubuntu, to accomplish this you should be able to run:
+Note: Xentools currently requires GHC version 8.4.1 or greater to install. On Ubuntu, the easiest way to make sure this is installed is to run: 
+
+    sudo add-apt-repository -y ppa:hvr/ghc
+    sudo apt update
+    sudo apt install ghc-8.4.1
+
+Next, ensure that you have cabal, supercollider, and fluidsynth installed on your machine. On recent versions of Ubuntu, to accomplish this you should be able to run:
 
     sudo apt install supercollider
     sudo apt install ghc
+    cabal update
     cabal install vivid
 
 Finally, clone into this repo and run cabal build.

src/Data/Scores.hs

@@ -0,0 +1,24 @@
+
+module Data.Scores where
+
+--
+-- Important type definitions for working with representations of scores
+--
+
+import Vivid
+import Scales.Generic
+
+-- Note: Some of the definitions here have to do with playback,
+-- so it would probably be good to have them in a seperate Data.Scores.Playback
+-- module
+
+type Vol = Double
+type Duration = Rational
+data Inst = VividSynth (Vol -> SynthDef '["note"]) | FluidInst String Int
+data Line' note = Line' Inst [(Maybe (note, Vol), Duration)]
+type Score' note = [Line' note]
+
+-- some useful type synonyms
+-- Note: I'll want to refactor types such as Line22 out of the codebase eventually
+type Line  note = [(note, Rational)]
+type Score note = [Line note]

src/Data/Scores/Util.hs

@@ -0,0 +1,7 @@
+
+module Data.Scores.Util where
+
+--
+-- A module for utility functions designed for manipulating
+-- different representations of scores.
+--

src/Data/Xentools/Examples.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE MultiParamTypeClasses, KindSignatures, TypeOperators, TypeFamilies, FlexibleInstances, DataKinds, ExtendedDefaultRules, UndecidableInstances, GADTs, AllowAmbiguousTypes, TypeInType, ScopedTypeVariables, FunctionalDependencies, QuasiQuotes, TemplateHaskell #-}
+
+module Data.Xentools.ExampleScores where
+
+import Scales.Generic
+import Scales.Transformations
+import Data.Semiring
+import Synths.MyVividSynths
+import Parsers.Eq22
+import Parsers.Eq24
+import Parsers.BP
+
+exBPScore = [Line' (VividSynth tone)
+                   (atVolume 1 ([lineBP| C3 1, D3 1, E3 1, F3 1, G3 1, H3 1, J3 1, A3 1, B3 1, C4 4 |] :: Line NoteBP)),
+             Line' (VividSynth tone)
+                   (atVolume 1 ([lineBP| E3 4, F3 4, C3 5 |])),
+             Line' (VividSynth tone)
+                   (atVolume 1 ([lineBP| G3 4, J3 4, E3 5 |]))]
+
+-- The same example, but written with the withInst function
+-- exscore1' :: Score Note22 
+{- 
+exscore1' = [  withInst 0.3 (VividSynth additiveSynth) ([line22| C4 2, D4 2, EQes4 1, BQes3 1, C4 4, C4 2, D4 2, EQes4 1, BQes3 1, C4 8 |] :: Line Note22)
+             , withInst 0.5 (VividSynth tone)          ([line22| C5 3, D5 1, EQes5 4, F5 2, DQes5 2, EQes5 4, EQes4 8 |] :: Line Note22)
+             , withInst 0.4 (FluidInst "test.sf3" 17)  ([line22| C4 2, C4 2, C4 2, C4 2, C4 16 |] :: Line Note22)
+             , withInst 0.4 (FluidInst "test.sf3" 17)  ([line22| EQes3 2, EQes3 2, EQes3 2, EQes3 2, EQes3 16 |] :: Line Note22)
+             , withInst 0.4 (FluidInst "test.sf3" 17)  ([line22| G4 2, G4 2, G4 2, G4 2, G4 16 |] :: Line Note22)
+             ] 
+-}
+
+ex22EdoScore1 = [Line' (VividSynth additiveSynth)
+                 (atVolume 0.3 ([line22| C4 2, D4 2, EQes4 1, BQes3 1, C4 4, C4 2, D4 2, EQes4 1, BQes3 1, C4 8 |] :: Line Note22) ),
+           Line' (VividSynth tone)
+                 (atVolume 0.5 ([line22| C5 3, D5 1, EQes5 4, F5 2, DQes5 2, EQes5 4, EQes4 8 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| C4 2, C4 2, C4 2, C4 2, C4 16 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| EQes3 2, EQes3 2, EQes3 2, EQes3 2, EQes3 16 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| G4 2, G4 2, G4 2, G4 2, G4 16 |]))
+           --Line' (FluidInst "test.sf3" 9)
+           --      (atVolume 1 ([line22| C6 4, EQes6 4, F6 4, DQes6 4, C6 8  |]))
+          ]
+
+ex22EdoScore2 = [Line' (VividSynth additiveSynth)
+                 (atVolume 0.3 ([line22| C4 2, D4 2, EQes4 1, BQes3 1, C4 4, C4 2, D4 2, EQes4 1, BQes3 1, C4 8 |] :: Line Note22) ),
+           Line' (VividSynth tone)
+                 (atVolume 0.5 ([line22| C5 3, D5 1, EQes5 4, F5 2, DQes5 2, EQes5 4, EQes4 8 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| C4 2, C4 2, C4 2, C4 2, C4 16 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| EQes3 2, EQes3 2, EQes3 2, EQes3 2, EQes3 16 |])),
+           Line' (FluidInst "test.sf3" 17)
+                 (atVolume 0.4 ([line22| G4 2, G4 2, G4 2, G4 2, G4 16 |]))
+           --Line' (FluidInst "test.sf3" 9)
+           --      (atVolume 1 ([line22| C6 4, EQes6 4, F6 4, DQes6 4, C6 8  |]))
+          ]

src/IO/Fluidsynth/Sequencer.hs

@@ -0,0 +1,47 @@
+
+module IO.Fluidsynth.Sequencer where
+
+import IO.Fluidsynth.Util
+
+sequenceNotesFluid :: (TuningSystem note g, Show note)
+   => Socket
+   -> Int        -- Program number
+   -> String     -- Soundfont name
+   -> Score note -- [[note]]
+   -> Int        -- Midi note velocity as volume
+   -> Tempo
+   -> Int -- Offset (for debug)
+   -> Preformance
+sequenceNotesFluid socket prog sft
+  score vol bpm o = Preformance (do mapConcurrently go (zip score [0..n-1])
+                                    return ())
+  where n   = length score -- number of midi channels we need to use
+        bps = bpm/60
+        -- There's some strange scoping issue with this line
+        -- I can't uncomment this for some reason
+        -- run :: Line note -> Preformance
+        go (line, i) = (forM_ line (\(n, duration) ->
+                                           do setProgram  socket (i + o) prog   
+                                              microNoteOn socket (i + o) (nfreq n) vol
+                                              Vivid.wait $ (fromRational duration) * (1/bps)
+                                              microNoteOff socket (i + o) (nfreq n)))
+
+sequenceLineFluid :: TuningSystem note g
+  => Socket
+  -> (String, Int) -- Fluid instrument data (Note, this might need to change, I'm not sure if
+                   -- we can easily use more than one SF file at once
+  -> [(Maybe (note, Vol), Rational)] -- Preformance data
+  -> Int -- Channel number
+  -> Tempo
+  -> Preformance
+sequenceLineFluid socket (sfpath, prog) line n bpm =
+  Preformance (forM_ line (\(noteType, duration) ->
+      case noteType of
+           Just (note, vol) -> do putStrLn "Sequencing a fluid note"
+                                  setProgram  socket n prog 
+                                  microNoteOn socket n (nfreq note) (volToVel vol)
+                                  Vivid.wait $ (fromRational duration) * (1/bps)
+                                  putStrLn "Sequencing a fluid note (done waiting)"
+                                  microNoteOff socket n (nfreq note)
+           Nothing   -> do Vivid.wait $ (fromRational duration) * (1/bps)))
+  where bps = (bpm/60) :: Double

src/IO/Fluidsynth/Util.hs

@@ -0,0 +1,33 @@
+
+module IO.Fluidsynth.Util where
+
+setProgram :: Socket -> Int -> Int -> IO ()
+setProgram socket channel prog = send socket (C.pack $ "prog "++show channel++" "++show prog++"\n")
+
+openServer :: Int -> Int -> IO ()
+openServer channels port = do
+   system $ "fluidsynth -K "++ show channels ++" -j  -i -s -o \"shell.port="++show port++"\""
+   return ()
+
+loadSoundFont :: Socket -> String -> IO ()
+loadSoundFont socket filepath = send socket (C.pack $ "load "++show filepath++"\n")
+
+noteOn :: Socket -> Int -> Int -> Int -> IO ()
+noteOn socket channel note vel = send socket (C.pack $ "noteon "++show channel++" "++show note++" "++show vel++"\n")
+
+noteOff :: Socket -> Int -> Int -> IO ()
+noteOff socket channel note = send socket (C.pack $ "noteoff "++show channel++" "++show note++"\n")
+
+pitchBendSet :: Socket -> Int -> Int -> IO ()
+pitchBendSet socket channel value = send socket (C.pack $ "pitch_bend "++show channel++" "++show value++"\n")
+
+microNoteOn :: Socket -> Int -> Double -> Int -> IO ()
+microNoteOn socket channel note vel =
+  do pitchBendSet socket channel (round $ (note - (fromIntegral $ floor note))/pbu')
+     noteOn       socket channel (floor note) vel
+
+microNoteOff :: Socket -> Int -> Double -> IO ()
+microNoteOff socket channel note =
+  do send socket (C.pack $ "noteoff "++show channel++" "++show (floor note)++"\n")
+     return ()
+

src/IO/Vivid/Sequencer.hs

@@ -0,0 +1,36 @@
+
+module IO.Vivid.Sequencer
+
+sequenceLineVivid :: TuningSystem note g
+   => (Double -> SynthDef '["note"])
+   -> [(Maybe (note, Double), Rational)] -- Preformance data1
+   -> Tempo
+   -> Preformance
+sequenceLineVivid syn line bpm = run line
+  where bps = bpm/60
+        run line = Preformance
+            (forM_ line (\(noteType, duration) ->
+                   case noteType of
+                      Just (note, vol) -> do putStrLn "Sequencing a Vivid note"
+                                             s <- synth (syn vol) (50::I "note")
+                                             set s (toI (nfreq note) :: I "note")
+                                             Vivid.wait $ (fromRational duration) * (1/bps)
+                                             putStrLn "Sequencing a Vivid note (done waiting)"
+                                             free s
+                      Nothing -> do Vivid.wait $ (fromRational duration) * (1/bps)))
+
+
+-- Note: This isn't really even needed anymore.
+sequenceNotes :: TuningSystem note g
+   => SynthDef '["note"]
+   -> Score note
+   -> Volume
+   -> Tempo
+   -> Preformance
+sequenceNotes syn score vol bpm = foldr1 (<>) (map run score)
+  where bps = bpm/60
+        run line = Preformance (forM_ line (\(n, duration) ->
+                                    do s <- synth syn (50::I "note")
+                                       set s (toI (nfreq n) :: I "note")
+                                       Vivid.wait $ (fromRational duration) * (1/bps)
+                                       free s))