work in progress on audio analysis in purescript port

src/AudioAnalyser.js

@@ -0,0 +1,20 @@
+"use strict";
+
+export const defaultWebAudioContext = () => new AudioContext();
+
+export const _monoGainNode = ac => gain => () => new GainNode(ac,{ gain:gain, channelCount:1, channelCountMode:"explicit" });
+
+export const _analyserNode = ac => fftSize => smoothingTimeConstant => () => new AnalyserNode(ac,{ fftSize:fftSize, smoothingTimeConstant:smoothingTimeConstant });
+
+export const _connect = src => dest => () => src.connect(dest);
+
+export const _disconnect = src => dest => () => src.disconnect(dest);
+
+export const _analyserArray = binCount => () => new Uint8Array(binCount);
+
+export const _getByteFrequencyData = node => array => () => node.getByteFrequencyData(array);
+
+export const _getLo = array => () => { var acc=0; for(var x=0;x<8;x++) { acc=acc+array[x] }; acc=acc/(8*256); return acc; }
+export const _getMid = array => () => { var acc=8; for(var x=0;x<80;x++) { acc=acc+array[x] }; acc=acc/(72*256); return acc; }
+export const _getHi = array => () => { var acc=80; for(var x=0;x<512;x++) { acc=acc+array[x] }; acc=acc/(432*256); return acc; }
+

src/AudioAnalyser.purs

@@ -0,0 +1,151 @@
+module AudioAnalyser where
+
+import Prelude (bind,discard,pure,Unit,unit,(>>=),($),when,(||))
+import Data.Rational ((%))
+import Effect (Effect)
+import Effect.Console (log)
+import Effect.Ref (Ref,new,read,write)
+import Data.Maybe (Maybe(..))
+import Data.Tempo (Tempo, newTempo)
+import Data.Map (Map, empty, lookup, insert)
+import Data.Tuple (Tuple(..))
+
+type AudioAnalyser = {
+  webAudioContext :: WebAudioContext,
+  defaultSource :: Effect WebAudioNode,
+  intendedSource :: Ref (Effect WebAudioNode),
+  analyserArray :: AnalyserArray,
+  sourceAndAnalyser :: Ref (Maybe (Tuple WebAudioNode WebAudioNode)),
+  lo :: Ref Number,
+  mid :: Ref Number,
+  hi :: Ref Number
+  }
+
+newAnalyser :: WebAudioContext -> Effect WebAudioNode -> Effect AudioAnalyser
+newAnalyser webAudioContext defaultSource = do
+  intendedSource <- new defaultSource
+  analyserArray <- _analyserArray 512
+  sourceAndAnalyser <- new Nothing
+  lo <- new 0.0
+  mid <- new 0.0
+  hi <- new 0.0
+  pure {
+    webAudioContext,
+    defaultSource,
+    intendedSource,
+    analyserArray,
+    sourceAndAnalyser,
+    lo,
+    mid,
+    hi
+  }
+
+setAnalysisSource :: AudioAnalyser -> Maybe (Effect WebAudioNode) -> Effect Unit
+setAnalysisSource a mEffectNode = do
+  let effectNode = case mEffectNode of
+                     Nothing -> a.defaultSource
+                     Just x -> x
+  write effectNode a.intendedSource
+  mSourceAndAnalyser <- read a.sourceAndAnalyser
+  case mSourceAndAnalyser of
+    Nothing -> pure unit  -- analysis is not currently active, so nothing more to do
+    Just (Tuple source analyser) -> do -- analysis currently active, so disconnect and reconnect
+      _disconnect source analyser
+      newSource <- effectNode
+      _connect newSource analyser
+
+setAnalysisActive :: AudioAnalyser -> Boolean -> Effect Unit
+setAnalysisActive a false = do
+  mSourceAndAnalyser <- read a.sourceAndAnalyser
+  case mSourceAndAnalyser of
+    Nothing -> pure unit  -- analysis is not currently active, so nothing more to do
+    Just (Tuple source analyser)-> do -- disactivate
+      _disconnect source analyser
+      write Nothing a.sourceAndAnalyser
+setAnalysisActive a true = do
+  mSourceAndAnalyser <- read a.sourceAndAnalyser
+  case mSourceAndAnalyser of
+    Just _ -> pure unit -- analysis is already active, so nothing more to do
+    Nothing -> do -- analysis is not active, so need to make new source and analyser nodes
+      intendedSource' <- read a.intendedSource
+      sourceNode <- intendedSource'
+      analyserNode <- _analyserNode a.webAudioContext 1024 0.5
+      _connect sourceNode analyserNode
+      write (Just $ Tuple sourceNode analyserNode) a.sourceAndAnalyser
+
+
+    {-
+updateAudioAnalysis :: SharedResources -> forall r. { ifft :: Boolean, ilo :: Boolean, imid :: Boolean, ihi :: Boolean, fft :: Boolean, lo :: Boolean, mid :: Boolean, hi :: Boolean | r } -> Effect Unit
+updateAudioAnalysis sr needs = do
+  case (needs.ifft || needs.ilo || needs.imid || needs.ihi) of
+    false -> do
+      mConnected <- read sr.audioAnalysisNodeInputConnected
+      case mConnected of
+        Nothing -> pure unit
+        Just n -> do
+          _disconnectNodes n sr.audioInputAnalyser
+          write Nothing sr.audioAnalysisNodeInputConnected    
+    true -> do
+      mAudioAnalysisNodeInput <- read sr.audioAnalysisNodeInput
+      case mAudioAnalysisNodeInput of
+        Nothing -> ...connect to microphone...
+        Just audioAnalysisNodeInput -> _connectNodes audioAnalysisNodeInput sr.audioInputAnalyser
+      _getByteFrequencyData sr.audioInputAnalyser sr.audioInputAnalysisArray    
+  case (needs.fft || needs.lo || needs.mid || needs.hi) of
+    false -> do
+      mConnected <- read sr.audioAnalysisNodeOutputConnected
+      case mConnected of
+        Nothing -> pure unit
+        Just n -> do
+          _disconnectNodes n sr.audioOutputAnalyser
+          write Nothing sr.audioAnalysisNodeOutputConnected    
+    true -> do
+      mAudioAnalysisNodeOutput <- read sr.audioAnalysisNodeOutput
+      case mAudioAnalysisNodeOutput of
+        Nothing -> ...connect to ?
+        Just audioAnalysisNodeOutput -> _connectNodes audioAnalysisNodeInput sr.audioInputAnalyser
+     _getByteFrequencyData sr.audioOutputAnalyser sr.audioOutputAnalysisArray
+     
+  when needs.ilo $ do
+    x <- _getLo sr.audioInputAnalysisArray
+    write x sr.ilo 
+  when needs.imid $ do
+    x <- _getMid sr.audioInputAnalysisArray
+    write x sr.imid
+  when needs.ihi $ do
+    x <- _getHi sr.audioInputAnalysisArray
+    write x sr.ihi
+  when needs.lo $ do
+    x <- _getLo sr.audioOutputAnalysisArray
+    write x sr.lo 
+  when needs.mid $ do
+    x <- _getMid sr.audioOutputAnalysisArray
+    write x sr.mid
+  when needs.hi $ do
+    x <- _getHi sr.audioOutputAnalysisArray
+    write x sr.hi
+-}
+
+foreign import data WebAudioContext :: Type
+
+foreign import defaultWebAudioContext :: Effect WebAudioContext
+
+foreign import data WebAudioNode :: Type
+
+foreign import _monoGainNode :: WebAudioContext -> Number -> Effect WebAudioNode
+
+foreign import _analyserNode :: WebAudioContext -> Int -> Number -> Effect WebAudioNode
+
+foreign import _connect :: WebAudioNode -> WebAudioNode -> Effect Unit
+
+foreign import _disconnect :: WebAudioNode -> WebAudioNode -> Effect Unit
+
+foreign import data AnalyserArray :: Type
+
+foreign import _analyserArray :: Int -> Effect AnalyserArray
+
+foreign import _getByteFrequencyData :: WebAudioNode -> AnalyserArray -> Effect Unit
+
+foreign import _getLo :: AnalyserArray -> Effect Number
+foreign import _getMid :: AnalyserArray -> Effect Number
+foreign import _getHi:: AnalyserArray -> Effect Number

src/Main.purs

@@ -31,7 +31,7 @@ type Punctual = {
 
 launch :: Effect Punctual
 launch = do
-  sharedResources <- SharedResources.newSharedResources
+  sharedResources <- SharedResources.newSharedResources Nothing
   programs <- new empty
   previousPrograms <- new empty
   webGLs <- new empty

src/SharedResources.purs

@@ -13,27 +13,34 @@ import Data.Tempo (Tempo, newTempo)
 import Data.Map (Map, empty, lookup, insert)
 
 import WebGLCanvas (WebGLCanvas, WebGLContext, WebGLTexture)
+import AudioAnalyser (WebAudioContext,defaultWebAudioContext)
 
 type SharedResources = {
   tempo :: Ref Tempo,
   mWebcamElementRef :: Ref (Maybe WebcamElement),
   images :: Ref (Map String Image),
-  videos :: Ref (Map String Video)
+  videos :: Ref (Map String Video),
+  webAudioContext :: WebAudioContext
   }
 
 
-newSharedResources :: Effect SharedResources
-newSharedResources = do
+newSharedResources :: Maybe WebAudioContext -> Effect SharedResources
+newSharedResources mWebAudioContext = do
   tempo <- newTempo (1 % 1) >>= new
   mWebcamElementRef <- new Nothing
   images <- new empty
   videos <- new empty
+  webAudioContext <- case mWebAudioContext of
+                       Nothing -> defaultWebAudioContext
+                       Just x -> pure x
   pure {
     tempo,
     mWebcamElementRef,
     images,
-    videos
-  }
+    videos,
+    webAudioContext
+    }
+
 
 -- Tempo
 
@@ -124,3 +131,5 @@ foreign import _newVideo :: String -> Effect Video
 
 foreign import _videoIsPlaying :: Video -> Effect Boolean
 
+
+

src/WebGL.purs

@@ -1,6 +1,6 @@
 module WebGL where
 
-import Prelude ((<$>),bind,discard,pure,Unit,($),(<>),show,(-),unit,(+))
+import Prelude ((<$>),bind,discard,pure,Unit,($),(<>),show,(-),unit,(+),(>>=))
 import Effect (Effect)
 import Effect.Console (log)
 import Effect.Ref (Ref, new, write, read)
@@ -122,6 +122,7 @@ drawWebGL webGL now = do
   let glc = webGL.glc
   shader <- read webGL.shader
   useProgram glc shader
+
   -- update time/tempo/resolution uniforms
   w <- getCanvasWidth webGL.glc
   h <- getCanvasHeight webGL.glc
@@ -132,18 +133,29 @@ drawWebGL webGL now = do
   setUniform1f glc shader "_etime" $ unwrap (diff now eTime :: Seconds)
   setUniform1f glc shader "_beat" $ toNumber $ timeToCount tempo now
   setUniform1f glc shader "_ebeat" $ toNumber $ timeToCount tempo now - timeToCount tempo eTime
-  -- update audio analysis uniforms (TODO)
+
+  -- update audio analysis uniforms
+  {- read webGL.sharedResources.ilo >>= setUniform1f glc shader "ilo" 
+  read webGL.sharedResources.imid >>= setUniform1f glc shader "imid" 
+  read webGL.sharedResources.ihi >>= setUniform1f glc shader "ihi" 
+  read webGL.sharedResources.lo >>= setUniform1f glc shader "lo" 
+  read webGL.sharedResources.mid >>= setUniform1f glc shader "mid" 
+  read webGL.sharedResources.hi >>= setUniform1f glc shader "hi"  -}
+
   -- update special textures (webcam, fft TODO, ifft TODO, feedback)
   ft <- getFeedbackTexture glc
   bindTexture glc shader ft 0 "f"
   updateWebcamTexture webGL.sharedResources glc
   bindTexture glc shader glc.webcamTexture 3 "w"
+
   -- update image textures
   imgMap <- read webGL.imageTextureSlots
   _ <- traverseWithIndex (bindImageTexture webGL shader) imgMap  
+
   -- update video textures
   vidMap <- read webGL.videoTextureSlots
   _ <- traverseWithIndex (bindVideoTexture webGL shader) vidMap
+
   -- draw
   pLoc <- getAttribLocation glc shader "p"
   bindBufferArray glc webGL.triangleStripBuffer