ilo,imid,ihi verified as working (next: texture copying to finish FFT…

…/IFFT) in purescript port

src/AudioAnalyser.js

@@ -2,18 +2,19 @@
 
 export const defaultWebAudioContext = () => new AudioContext();
 
-export const _monoGainNode = ac => gain => () => new GainNode(ac,{ gain:gain, channelCount:1, channelCountMode:"explicit" });
+export const resumeWebAudioContext = ac => () => ac.resume();
 
 export const gainNode = ac => gain => () => new GainNode(ac,{ gain:gain });
 
 export const _analyserNode = ac => fftSize => smoothingTimeConstant => () => new AnalyserNode(ac,{ fftSize:fftSize, smoothingTimeConstant:smoothingTimeConstant });
 
 export const _defaultAudioInputNode = ac => () => {
-  var r = ac.createGain();
+  var r = new GainNode(ac);
   navigator.mediaDevices.getUserMedia({ audio: true, video: false}).then(function(stream) {
-    var x = new MediaStreamAudioSourceNode($1,{mediaStream: stream});
-    x.connect($r);
+    var x = new MediaStreamAudioSourceNode(ac,{mediaStream: stream});
+    x.connect(r);
   });
+  return r;
   }
 
 export const _connect = src => dest => () => src.connect(dest);
@@ -25,6 +26,6 @@ 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; }
+export const _getMid = array => () => { var acc=0; for(var x=0;x<80;x++) { acc=acc+array[x] }; acc=acc/(72*256); return acc; }
+export const _getHi = array => () => { var acc=0; for(var x=0;x<512;x++) { acc=acc+array[x] }; acc=acc/(432*256); return acc; }
 

src/AudioAnalyser.purs

@@ -1,6 +1,6 @@
 module AudioAnalyser where
 
-import Prelude (Unit, bind, discard, pure, unit, when, ($), (<>))
+import Prelude (Unit, bind, discard, pure, unit, when, ($), (<>), show)
 import Effect (Effect)
 import Effect.Ref (Ref,new,read,write)
 import Effect.Console (log)
@@ -92,6 +92,7 @@ updateAnalyser a needs = do
   case (unwrap $ needs.fft <> needs.lo <> needs.mid <> needs.hi) of
     false -> _disactivateAnalysis a
     true -> do
+      resumeWebAudioContext a.webAudioContext
       analyserNode <- _activateAnalysis a
       _getByteFrequencyData analyserNode a.analyserArray
       when (unwrap needs.lo) $ do
@@ -109,9 +110,11 @@ foreign import data WebAudioContext :: Type
 
 foreign import defaultWebAudioContext :: Effect WebAudioContext
 
+foreign import resumeWebAudioContext :: WebAudioContext -> Effect Unit
+
 foreign import data WebAudioNode :: Type
 
-foreign import _monoGainNode :: WebAudioContext -> Number -> Effect WebAudioNode
+-- foreign import _monoGainNode :: WebAudioContext -> Number -> Effect WebAudioNode
 
 foreign import gainNode :: WebAudioContext -> Number -> Effect WebAudioNode
 

src/Main.purs

@@ -12,9 +12,10 @@ import Data.Map (Map, empty, lookup, insert, delete)
 import Effect.Ref (Ref, new, read, write)
 import Data.Maybe (Maybe(..))
 import Data.Tempo (ForeignTempo, fromForeignTempo)
-import Data.Foldable (foldMap)
+import Data.Foldable (fold)
 import Data.Newtype (unwrap)
 
+import Signal (SignalInfo,emptySignalInfo)
 import Program (Program,emptyProgram,programHasVisualOutput,programInfo)
 import Parser (parsePunctual)
 import WebGL (WebGL, newWebGL, updateWebGL, deleteWebGL, drawWebGL)
@@ -26,6 +27,9 @@ type Punctual = {
   sharedResources :: SharedResources,
   programs :: Ref (Map Int Program),
   previousPrograms :: Ref (Map Int Program),
+  programInfos :: Ref (Map Int SignalInfo),
+  previousProgramInfos :: Ref (Map Int SignalInfo),
+  combinedProgramInfo :: Ref SignalInfo,
   webGLs :: Ref (Map Int WebGL)
   }
 
@@ -35,9 +39,12 @@ launch = do
   sharedResources <- SharedResources.newSharedResources Nothing
   programs <- new empty
   previousPrograms <- new empty
+  programInfos <- new empty
+  previousProgramInfos <- new empty
+  combinedProgramInfo <- new emptySignalInfo
   webGLs <- new empty
   log "punctual 0.5 initialization complete"
-  pure { sharedResources, programs, previousPrograms, webGLs }
+  pure { sharedResources, programs, previousPrograms, programInfos, previousProgramInfos, combinedProgramInfo, webGLs }
 
 
 define :: Punctual -> { zone :: Int, time :: Number, text :: String } -> Effect { success :: Boolean, info :: String, error :: String }
@@ -51,49 +58,76 @@ define punctual args = do
     Left err -> do
       log $ "error: " <> show err
       pure { success: false, info: "", error: show err }
-    Right newProgram -> do
-      -- update record of current and previous programs for this zone
-      programs <- read punctual.programs
-      previousProgram <-
-        case lookup args.zone programs of
-          Just x -> pure x
-          Nothing -> emptyProgram
-      previousPrograms <- read punctual.previousPrograms
-      write (insert args.zone previousProgram previousPrograms) punctual.previousPrograms
-      write (insert args.zone newProgram programs) punctual.programs
-      -- update visual rendering system
-      info <- case programHasVisualOutput newProgram of 
-        true -> updateWebGLForZone punctual args.zone newProgram previousProgram
-        false -> do
-          deleteWebGLForZone punctual args.zone
-          pure ""
-      -- TODO: audio rendering system
-      pure { success: true, info, error: "" }
-
+    Right newProgram -> _newProgramInZone punctual args.zone newProgram
+
+_newProgramInZone :: Punctual -> Int -> Program -> Effect { success :: Boolean, info :: String, error :: String }
+_newProgramInZone punctual zone newProgram = do
+  programs <- read punctual.programs
+  previousPrograms <- read punctual.previousPrograms
+  programInfos <- read punctual.programInfos
+  previousProgramInfos <- read punctual.previousProgramInfos
+  previousProgram <-
+    case lookup zone programs of
+      Just x -> pure x
+      Nothing -> emptyProgram
+  previousProgramInfo <-
+    case lookup zone programInfos of
+      Just x -> pure x
+      Nothing -> pure emptySignalInfo
+  let newPrograms = insert zone newProgram programs
+  let newPreviousPrograms = insert zone previousProgram previousPrograms
+  let newProgramInfos = insert zone (programInfo newProgram) programInfos
+  let newPreviousProgramInfos = insert zone previousProgramInfo previousProgramInfos
+  write newPrograms punctual.programs
+  write newPreviousPrograms punctual.previousPrograms
+  write newProgramInfos punctual.programInfos
+  write newPreviousProgramInfos punctual.previousProgramInfos
+  _updateCombinedProgramInfo punctual
+  -- update visual rendering system
+  info <- case programHasVisualOutput newProgram of 
+    true -> updateWebGLForZone punctual zone newProgram previousProgram
+    false -> do
+      deleteWebGLForZone punctual zone
+      pure ""
+  -- TODO: update audio rendering system
+  pure { success: true, info, error: "" }
+
+_updateCombinedProgramInfo :: Punctual -> Effect Unit
+_updateCombinedProgramInfo punctual = do
+  programsInfo <- fold <$> read punctual.programInfos
+  previousProgramsInfo <- fold <$> read punctual.previousProgramInfos
+  let combinedInfo = programsInfo <> previousProgramsInfo
+  log $ "_updateCombinedProgramInfo: " <> show combinedInfo
+  write combinedInfo punctual.combinedProgramInfo
 
 clear :: Punctual -> { zone :: Int } -> Effect Unit
 clear punctual args = do
-  log $ "clear: " <> show args
   programs <- read punctual.programs
-  write (delete args.zone programs) punctual.programs
   previousPrograms <- read punctual.previousPrograms
-  write (delete args.zone previousPrograms) punctual.previousPrograms
+  programInfos <- read punctual.programInfos
+  previousProgramInfos <- read punctual.previousProgramInfos
+  let newPrograms = delete args.zone programs
+  let newPreviousPrograms = delete args.zone previousPrograms
+  let newProgramInfos = delete args.zone programInfos
+  let newPreviousProgramInfos = delete args.zone previousProgramInfos
+  write newPrograms punctual.programs
+  write newPreviousPrograms punctual.previousPrograms
+  write newProgramInfos punctual.programInfos
+  write newPreviousProgramInfos punctual.previousProgramInfos
+  _updateCombinedProgramInfo punctual
   deleteWebGLForZone punctual args.zone
 
 
 setTempo :: Punctual -> ForeignTempo -> Effect Unit
-setTempo punctual ft = do
-  -- log $ "setTempo: " <> show ft
-  SharedResources.setTempo punctual.sharedResources (fromForeignTempo ft)
+setTempo punctual ft = SharedResources.setTempo punctual.sharedResources (fromForeignTempo ft)
 
 
 preRender :: Punctual -> { canDraw :: Boolean, nowTime :: Number } -> Effect Unit
-preRender punctual args = when args.canDraw do  
-  -- log $ "preRender: " <> show args
-  -- TODO: really this calculation should be done during define, with results cached
-  programsInfo <- foldMap programInfo <$> read punctual.programs
-  previousProgramsInfo <- foldMap programInfo <$> read punctual.programs
-  let combinedInfo = programsInfo <> previousProgramsInfo
+preRender punctual args = when args.canDraw $ _updateSharedResources punctual
+
+_updateSharedResources :: Punctual -> Effect Unit
+_updateSharedResources punctual = do
+  combinedInfo <- read punctual.combinedProgramInfo
   SharedResources.setWebcamActive punctual.sharedResources $ unwrap combinedInfo.webcam
   SharedResources.updateAudioAnalysers punctual.sharedResources combinedInfo
 
@@ -111,7 +145,7 @@ render punctual args = do
 
 
 postRender :: Punctual -> { canDraw :: Boolean, nowTime :: Number } -> Effect Unit
-postRender _ args = pure unit -- log $ "postRender: " <> show args
+postRender _ _ = pure unit -- log $ "postRender: " <> show args
 
 
 

src/SharedResources.purs

@@ -50,7 +50,7 @@ newSharedResources mWebAudioContext = do
     inputAnalyser,
     outputAnalyser
     }
-
+    
 updateAudioAnalysers :: SharedResources -> forall r. { ifft::Disj Boolean, ilo::Disj Boolean, imid::Disj Boolean, ihi::Disj Boolean, fft::Disj Boolean, lo::Disj Boolean, mid::Disj Boolean, hi::Disj Boolean | r } -> Effect Unit
 updateAudioAnalysers sr needs = do
   updateAnalyser sr.inputAnalyser { fft: needs.ifft, lo: needs.ilo, mid: needs.imid, hi: needs.ihi }

src/Signal.purs

@@ -1,6 +1,6 @@
 module Signal where
 
-import Prelude (class Eq, class Show, mempty, negate, ($), (<>))
+import Prelude (class Eq, class Show, mempty, negate, ($), (<>), pure)
 import Data.Generic.Rep (class Generic)
 import Data.Show.Generic (genericShow)
 import Data.List (List(..),(:))
@@ -159,49 +159,33 @@ type SignalInfo = {
   vidURLs :: Set String
   }
 
-{- derive instance Eq SignalInfo
-derive instance Generic SignalInfo _
-derive instance Newtype SignalInfo _
-instance Show SignalInfo where
-  show = genericShow
-
-instance Semigroup SignalInfo where
-  append (SignalInfo x) (SignalInfo y) = SignalInfo {
-    webcam: x.webcam || y.webcam,
-    needsAudioInputAnalysis: x.needsAudioInputAnalysis || y.needsAudioInputAnalysis,
-    needsAudioOutputAnalysis: x.needsAudioOutputAnalysis || y.needsAudioOutputAnalysis,
-    imgURLs: x.imgURLs <> y.imgURLs,
-    vidURLs: x.vidURLs <> y.vidURLs
-    }
-
-instance Monoid SignalInfo where
-  mempty = SignalInfo {
-    webcam: false,
-    fft: false,
-    lo: false,
-    mid: false,
-    hi: false,
-    ifft: false,
-    ilo: false,
-    imid: false,
-    ihi: false,
-    imgURLs: mempty,
-    vidURLs: mempty
-    }
--}
+emptySignalInfo :: SignalInfo
+emptySignalInfo = {
+  webcam: pure false,
+  fft: pure false,
+  lo: pure false,
+  mid: pure false,
+  hi: pure false,
+  ifft: pure false,
+  ilo: pure false,
+  imid: pure false,
+  ihi: pure false,
+  imgURLs: mempty,
+  vidURLs: mempty
+  }
 
 signalInfo :: Signal -> SignalInfo
-signalInfo Cam = mempty { webcam: true }
-signalInfo ILo = mempty { ilo: true }
-signalInfo IMid = mempty { imid: true }
-signalInfo IHi = mempty { ihi: true }
-signalInfo (IFFT x) = mempty { ifft: true } <> signalInfo x
-signalInfo Lo = mempty { lo: true }
-signalInfo Mid = mempty { mid: true }
-signalInfo Hi = mempty { hi: true }
-signalInfo (FFT x) = mempty { fft: true } <> signalInfo x
-signalInfo (Img x) = mempty { imgURLs: singleton x }
-signalInfo (Vid x) = mempty { vidURLs: singleton x }
+signalInfo Cam = emptySignalInfo { webcam = pure true }
+signalInfo ILo = emptySignalInfo { ilo = pure true }
+signalInfo IMid = emptySignalInfo { imid = pure true }
+signalInfo IHi = emptySignalInfo { ihi = pure true }
+signalInfo (IFFT x) = emptySignalInfo { ifft = pure true } <> signalInfo x
+signalInfo Lo = emptySignalInfo { lo = pure true }
+signalInfo Mid = emptySignalInfo { mid = pure true }
+signalInfo Hi = emptySignalInfo { hi = pure true }
+signalInfo (FFT x) = emptySignalInfo { fft = pure true } <> signalInfo x
+signalInfo (Img x) = emptySignalInfo { imgURLs = singleton x }
+signalInfo (Vid x) = emptySignalInfo { vidURLs = singleton x }
 signalInfo x = foldMap signalInfo $ subSignals x
 
 -- given a Signal return the list of the component Signals it is dependent on

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)
@@ -135,12 +135,12 @@ drawWebGL webGL now = do
   setUniform1f glc shader "_ebeat" $ toNumber $ timeToCount tempo now - timeToCount tempo eTime
 
   -- 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"  -}
+  read webGL.sharedResources.inputAnalyser.lo >>= setUniform1f glc shader "ilo" 
+  read webGL.sharedResources.inputAnalyser.mid >>= setUniform1f glc shader "imid" 
+  read webGL.sharedResources.inputAnalyser.hi >>= setUniform1f glc shader "ihi" 
+  read webGL.sharedResources.outputAnalyser.lo >>= setUniform1f glc shader "lo" 
+  read webGL.sharedResources.outputAnalyser.mid >>= setUniform1f glc shader "mid" 
+  read webGL.sharedResources.outputAnalyser.hi >>= setUniform1f glc shader "hi"
 
   -- update special textures (webcam, fft TODO, ifft TODO, feedback)
   ft <- getFeedbackTexture glc