Add playPhrase and playMelody to Melody

And tidy the source

CHANGELOG.md

@@ -1,5 +1,10 @@
 # Changelog
 
+### Version 4.1.0 (2022-05-06)
+
+* Added playPhrase and playMelody 
+* There is now a dependency on datetime
+
 ### Version 4.0.0 (2022-04-07)
 
 * PureScript 0.15.0

example.dhall

@@ -2,8 +2,8 @@ let conf = ./spago.dhall
 
 in conf // {
  sources = conf.sources # [ "example/src/**/*.purs" ],
- dependencies = conf.dependencies # [ "datetime"
- , "newtype"
+ dependencies = conf.dependencies # [ "newtype"
+ , "unfoldable"
  , "unsafe-coerce"
  , "web-dom"
  , "web-events"

example/dist/index.html

@@ -14,7 +14,7 @@
  }
  </style>
  <div id="app">
- <h3>Play the SoundFonts example</h3>
+ <h3>Play the SoundFonts examples</h3>
  <button id="play" class="button play-button">PLAY</button>
  </div>
  <script src="purescript-soundfonts.js"></script>

example/src/Main.purs

@@ -3,15 +3,18 @@ module Example.Main where
 import Prelude (Unit, bind, discard, map, pure, unit, ($), (*), (>>=))
 import Effect (Effect)
 import Effect.Class (liftEffect)
-import Effect.Aff (Fiber, launchAff, delay)
+import Effect.Aff (Aff, Fiber, launchAff, delay)
 import Effect.Exception (throw)
 import Data.Time.Duration (Milliseconds(..))
 import Data.Maybe (Maybe(..))
 import Data.Newtype (wrap)
-import Audio.SoundFont (MidiNote
+import Data.Unfoldable (replicate)
+import Audio.SoundFont (Instrument
+ , MidiNote
  , loadRemoteSoundFonts
  , playNote
  , playNotes)
+import Audio.SoundFont.Melody (playMelody)
 import Data.Midi.Instrument (InstrumentName(..))
 import Web.DOM.ParentNode (querySelector)
 import Web.Event.EventTarget (EventTarget, addEventListener, eventListener)
@@ -43,59 +46,41 @@ notesSample channel =
  , note channel 71 3.0 1.5 1.0
  ]
 
--- | load remote fonts example
-
 main :: Effect Unit
 main = do
  -- a user gesture is required before the browser is allowed to use web-audio
  doc <- map toParentNode (window >>= document)
  play <- querySelector (wrap "#play") doc
  case play of
  Just e -> do
- el <- eventListener \_ -> playExample
+ el <- eventListener \_ -> playAll
  addEventListener (wrap "click") el false (unsafeCoerce e :: EventTarget)
  Nothing -> throw "No 'play' button"
  pure unit
 
-playExample :: Effect (Fiber Number)
-playExample = launchAff $ do
+playAll :: Effect (Fiber Unit)
+playAll = launchAff $ do
  instruments <- loadRemoteSoundFonts [Marimba, AcousticGrandPiano, TangoAccordion]
+ _ <- playNotesExample instruments 
+ playMelodyExample instruments 
+
 
+-- | play example using playNotes
+playNotesExample :: Array Instrument -> Aff Unit
+playNotesExample instruments = do
  da <- liftEffect $ playNote instruments noteSampleA
  _ <- delay (Milliseconds $ 1000.0 * da)
  db <- liftEffect $ playNote instruments noteSampleC
  _ <- delay (Milliseconds $ 1000.0 * db)
  de <- liftEffect $ playNote instruments noteSampleE
  _ <- delay (Milliseconds $ 1000.0 * de)
- liftEffect $ playNotes instruments (notesSample 2)
-
-
+ df <- liftEffect $ playNotes instruments (notesSample 2)
+ delay (Milliseconds $ 1000.0 * df)
 
-{-
--- | load local piano font example
-pianoExample :: ∀ eff.
- Eff
- ( ajax :: AJAX
- , au :: AUDIO
- | eff
- )
- (Fiber
- ( ajax :: AJAX
- , au :: AUDIO
- | eff
- )
- Number
- )
-pianoExample = launchAff $ do
- -- instrument <- loadInstrument (Just "soundfonts") "acoustic_grand_piano"
- instrument <- loadPianoSoundFont "soundfonts"
+-- playMelody example (on the piano)
+playMelodyExample :: Array Instrument -> Aff Unit
+playMelodyExample instruments = do
  let
- instruments = singleton instrument
- da <- liftEff $ playNote instruments noteSampleA
- _ <- delay (Milliseconds $ 1000.0 * da)
- db <- liftEff $ playNote instruments noteSampleC
- _ <- delay (Milliseconds $ 1000.0 * db)
- de <- liftEff $ playNote instruments noteSampleE
- _ <- delay (Milliseconds $ 1000.0 * de)
- liftEff $ playNotes instruments (notesSample 0)
--}
+ melody = replicate 3 (notesSample 1)
+ playMelody instruments melody
+

spago.dhall

@@ -13,6 +13,7 @@ You can edit this file as you like.
  , "b64"
  , "bifunctors"
  , "console"
+ , "datetime"
  , "effect"
  , "either"
  , "exceptions"

src/Audio/SoundFont.purs

@@ -1,5 +1,5 @@
-module Audio.SoundFont (
-   AudioBuffer
+module Audio.SoundFont
+ ( AudioBuffer
  , Instrument
  , InstrumentChannels
  , MidiNote
@@ -41,7 +41,6 @@ import Prelude
 
 -- | The SoundFont API which we will expose
 
-
 -- | the Audio Buffer for a single note
 foreign import data AudioBuffer :: Type
 
@@ -57,19 +56,19 @@ type InstrumentChannels = Map InstrumentName Int
 
 -- | A Midi Note
 type MidiNote =
- { channel :: Int  -- the MIDI channel
- , id  :: Int  -- the MIDI pitch number
- , timeOffset :: Number  -- the time delay in seconds before the note is played
- , duration :: Number  -- the duration of the note
- , gain :: Number  -- the volume (between 0 and 1)
+ { channel :: Int -- the MIDI channel
+ , id :: Int -- the MIDI pitch number
+ , timeOffset :: Number -- the time delay in seconds before the note is played
+ , duration :: Number -- the duration of the note
+ , gain :: Number -- the volume (between 0 and 1)
  }
 
 -- | A Midi Note with the appropriate font
 type FontNote =
- { buffer  ::  AudioBuffer  -- the Audio buffer for a particular note on a particular instrument
- , timeOffset :: Number  -- the time delay in seconds before the note is played
- , duration :: Number  -- the duration of the note (sec)
- , gain :: Number  -- the volume (between 0 and 1)
+ { buffer :: AudioBuffer -- the Audio buffer for a particular note on a particular instrument
+ , timeOffset :: Number -- the time delay in seconds before the note is played
+ , duration :: Number -- the duration of the note (sec)
+ , gain :: Number -- the volume (between 0 and 1)
  }
 
 -- | can the browser play ogg format ?
@@ -88,15 +87,15 @@ foreign import setNoteRing
  :: Number -> Effect Unit
 
 -- | load a bunch of soundfonts from the Gleitzmann server
-loadRemoteSoundFonts ::
- Array InstrumentName
+loadRemoteSoundFonts
+ :: Array InstrumentName
  -> Aff (Array Instrument)
 loadRemoteSoundFonts =
  loadInstruments Nothing
 
 -- | load the piano soundfont from a relative directory on the local server
-loadPianoSoundFont ::
- String
+loadPianoSoundFont
+ :: String
  -> Aff Instrument
 loadPianoSoundFont localDir =
  loadInstrument (Just localDir) AcousticGrandPiano
@@ -106,8 +105,8 @@ loadPianoSoundFont localDir =
 -- | Benjamin Gleitzman's server (default)
 -- | A directory from the local server if this is supplied
 
-loadInstrument ::
- Maybe String
+loadInstrument
+ :: Maybe String
  -> InstrumentName
  -> Aff Instrument
 loadInstrument maybeLocalDir instrumentName = do
@@ -136,15 +135,15 @@ loadInstrument maybeLocalDir instrumentName = do
 -- | load a bunch of instrument SoundFonts (in parallel)
 -- | again with options to load either locally or remotely
 -- | from Benjamin Gleitzman's server
-loadInstruments ::
- Maybe String
+loadInstruments
+ :: Maybe String
  -> Array InstrumentName
  -> Aff (Array Instrument)
 loadInstruments maybeLocalDir instrumentNames =
  sequential $ traverse (\name -> parallel (loadInstrument maybeLocalDir name)) instrumentNames
 
 foreign import decodeAudioBufferImpl
- :: Uint8Array  -> EffectFnAff AudioBuffer
+ :: Uint8Array -> EffectFnAff AudioBuffer
 
 -- | decode the AudioBuffer for a given note
 decodeAudioBuffer :: Uint8Array -> Aff AudioBuffer
@@ -200,16 +199,16 @@ lastDuration ns =
  fromMaybe 0.0 $ last ns
 
 -- | just for debug
-logLoadResource ::
- InstrumentName ->
- Effect (Fiber Unit)
+logLoadResource
+ :: InstrumentName
+ -> Effect (Fiber Unit)
 logLoadResource instrument =
  let
  url = gleitzUrl instrument MusyngKite OGG
  in
  launchAff $ do
  res <- request $ defaultRequest
-  { url = url, method = Left GET, responseFormat = ResponseFormat.string }
+ { url = url, method = Left GET, responseFormat = ResponseFormat.string }
  case res <#> _.body of
  Left _ ->
  liftEffect $ log $ "instrument failed to load: " <> url
@@ -219,18 +218,17 @@ logLoadResource instrument =
  liftEffect $ log $ "extract JSON: " <> (either show (debugNoteIds) ejson)
 
 -- | use OGG if we can, otherwise default to MP3
-prefferedRecordingFormat :: Effect  RecordingFormat
+prefferedRecordingFormat :: Effect RecordingFormat
 prefferedRecordingFormat =
  liftM1 (\b -> if b then OGG else MP3) canPlayOgg
 
 -- | turn a MIDI note (and audio buffer) into a font note (suitable for JS)
 fontNote :: AudioBuffer -> MidiNote -> FontNote
 fontNote buffer n =
- {
- buffer : buffer
- , timeOffset : n.timeOffset
- , duration : n.duration
- , gain : n.gain
+ { buffer: buffer
+ , timeOffset: n.timeOffset
+ , duration: n.duration
+ , gain: n.gain
  }
 
 -- | build a local URL where the instrument font is contained

src/Audio/SoundFont/Decoder.purs

@@ -1,19 +1,19 @@
-module Audio.SoundFont.Decoder (
-   NoteMap
+module Audio.SoundFont.Decoder
+ ( NoteMap
  , midiJsToNoteMap
  , debugNoteNames
- , debugNoteIds) where
+ , debugNoteIds
+ ) where
 
 import Prelude ((<>), ($), (+), map, show)
 import Data.Either (Either(..))
-import Data.Maybe(Maybe(..))
+import Data.Maybe (Maybe(..))
 import Data.String (Pattern(..), drop, take, indexOf, lastIndexOf, length)
 import Data.Midi.Instrument (InstrumentName, gleitzmanName)
 import Audio.SoundFont.Gleitz (debugNoteName, midiPitch)
 import Data.Argonaut.Core (Json, caseJsonObject, caseJsonString)
 import Data.Argonaut.Parser (jsonParser)
 import Data.Tuple (Tuple(..))
--- import Data.StrMap (StrMap, keys, toUnfoldable) as SM
 import Foreign.Object (Object)
 import Foreign.Object (keys, toUnfoldable) as SM
 import Data.Map (Map, fromFoldable, keys)
@@ -27,7 +27,6 @@ import Data.ArrayBuffer.Types (Uint8Array)
 import Data.Bifunctor (lmap)
 import Effect.Exception (Error, error)
 
-
 -- | This module transforms the MIDI.js from https://github.com/gleitz/midi-js-soundfonts
 -- | for a diven instrument, extracts the Json and parses it and also decodes the
 -- | Base64 representation of each note to an unsigned Int8 array.

src/Audio/SoundFont/Gleitz.purs

@@ -1,13 +1,12 @@
-module Audio.SoundFont.Gleitz (
-   RecordingFormat(..)
+module Audio.SoundFont.Gleitz
+ ( RecordingFormat(..)
  , SoundFontType(..)
  , gleitzUrl
  , gleitzNoteName
  , midiPitch
  , debugNoteName
  ) where
 
-
 import Prelude (class Show, (<>), ($), (+), (*), map, negate, show)
 import Data.String.Regex as Regex
 import Data.String.Regex.Flags (noFlags)
@@ -35,21 +34,21 @@ data SoundFontType = Fluid3 | MusyngKite | FatBoy
 instance showSoundFontType :: Show SoundFontType where
  show Fluid3 = "FluidR3_GM"
  show MusyngKite = "MusyngKite"
- show FatBoy= "FatBoy"
+ show FatBoy = "FatBoy"
 
 type Pitch = String
 
 -- | note sequences start at C with the normal intervals between the white notes
 semitones :: Map String Int
 semitones = fromFoldable
-  [ Tuple "C" 0
-  , Tuple "D" 2
-  , Tuple "E" 4
-  , Tuple "F" 5
-  , Tuple "G" 7
-  , Tuple "A" 9
-  , Tuple "B" 11
-  ]
+ [ Tuple "C" 0
+ , Tuple "D" 2
+ , Tuple "E" 4
+ , Tuple "F" 5
+ , Tuple "G" 7
+ , Tuple "A" 9
+ , Tuple "B" 11
+ ]
 
 gleitzBaseUrl :: String
 gleitzBaseUrl = "https://gleitz.github.io/midi-js-soundfonts/"
@@ -71,17 +70,20 @@ midiPitch1 s =
  Just matches ->
  let
  mpitch :: Maybe Int
- mpitch = case index matches 1 of  -- first match group
- Just (Just p) -> lookup p semitones  -- A-G
+ mpitch = case index matches 1 of -- first match group
+ Just (Just p) -> lookup p semitones -- A-G
  _ -> Nothing
+
  acc :: Int
- acc = case index matches 2 of  -- second match group
- Just (Just "b") -> (-1)  -- # or b
- Just (Just "#") -> 1  -- # or b
+ acc = case index matches 2 of -- second match group
+ Just (Just "b") -> (-1) -- # or b
+ Just (Just "#") -> 1 -- # or b
  _ -> 0
+
  moctave :: Maybe Int
- moctave = -- third match group
- case index matches 3 of -- octave number
+ moctave = -- third match group
+
+ case index matches 3 of -- octave number
  Just (Just octave) -> fromString octave
  _ -> Nothing
  in