From 80aa96b59dd03cca1ca3c2176f518388b0ccd68f Mon Sep 17 00:00:00 2001 From: David Ogborn Date: Fri, 3 Nov 2023 16:21:57 -0400 Subject: [PATCH] bump to punctual 0.4.4.5 --- client/estuary.cabal | 3 - client/src/Estuary/Languages/CineCer0.hs | 2 - client/src/Estuary/Languages/MiniTidal.hs | 2 - client/src/Estuary/Languages/Punctual.hs | 122 --------- client/src/Estuary/Languages/TimeNot.hs | 2 - client/src/Estuary/Render/R.hs | 242 +++++++++++++++++- client/src/Estuary/Render/Renderer.hs | 21 +- .../Estuary/Render/TextNotationRenderer.hs | 170 ------------ client/src/Estuary/Types/RenderState.hs | 126 --------- default.nix | 4 +- 10 files changed, 255 insertions(+), 439 deletions(-) delete mode 100644 client/src/Estuary/Languages/Punctual.hs delete mode 100644 client/src/Estuary/Render/TextNotationRenderer.hs delete mode 100644 client/src/Estuary/Types/RenderState.hs diff --git a/client/estuary.cabal b/client/estuary.cabal index 6a5356f3..98361edd 100644 --- a/client/estuary.cabal +++ b/client/estuary.cabal @@ -65,7 +65,6 @@ library Estuary.Types.NoteEvent Estuary.Types.ParamPatternable Estuary.Types.RenderInfo - Estuary.Types.RenderState Estuary.Types.Term Estuary.Types.Terminal Estuary.Types.Tutorial @@ -112,11 +111,9 @@ library Estuary.Widgets.TapTempo Estuary.Languages.CineCer0 Estuary.Languages.MiniTidal - Estuary.Languages.Punctual Estuary.Languages.TimeNot Estuary.Render.ForeignTempo Estuary.Render.RenderOp - Estuary.Render.TextNotationRenderer Estuary.Types.ServerInfo Estuary.Widgets.Chat Estuary.Widgets.DataVisualisers diff --git a/client/src/Estuary/Languages/CineCer0.hs b/client/src/Estuary/Languages/CineCer0.hs index 23eeeb20..435f2941 100644 --- a/client/src/Estuary/Languages/CineCer0.hs +++ b/client/src/Estuary/Languages/CineCer0.hs @@ -16,8 +16,6 @@ import qualified Estuary.Languages.CineCer0.Spec as CineCer0 import qualified Estuary.Languages.CineCer0.Parser as CineCer0 import Estuary.Render.R -import Estuary.Render.TextNotationRenderer -import Estuary.Types.RenderState import Estuary.Types.RenderInfo import Estuary.Types.TextNotation import Estuary.Render.MainBus diff --git a/client/src/Estuary/Languages/MiniTidal.hs b/client/src/Estuary/Languages/MiniTidal.hs index 735c6a26..730b4d70 100644 --- a/client/src/Estuary/Languages/MiniTidal.hs +++ b/client/src/Estuary/Languages/MiniTidal.hs @@ -13,8 +13,6 @@ import Control.DeepSeq import Data.Maybe import Estuary.Render.R -import Estuary.Render.TextNotationRenderer -import Estuary.Types.RenderState import Estuary.Types.RenderInfo import Estuary.Types.TextNotation import Estuary.Render.MainBus diff --git a/client/src/Estuary/Languages/Punctual.hs b/client/src/Estuary/Languages/Punctual.hs deleted file mode 100644 index 2e18155f..00000000 --- a/client/src/Estuary/Languages/Punctual.hs +++ /dev/null @@ -1,122 +0,0 @@ -module Estuary.Languages.Punctual (punctual) where - -import Data.Time -import Control.Monad.Except -import Data.IntMap as IntMap -import Data.Text as T -import Control.Exception -import Control.Monad.State.Strict -import Sound.MusicW.AudioContext -import Control.Monad.Reader - -import qualified Sound.Punctual.Program as Punctual -import qualified Sound.Punctual.PunctualW as Punctual -import qualified Sound.Punctual.GL as Punctual -import qualified Sound.Punctual.WebGL as Punctual -import qualified Sound.Punctual.AsyncProgram as Punctual -import qualified Sound.Punctual.Parser as Punctual -import qualified Sound.Punctual.Resolution as Punctual - -import Estuary.Render.R -import Estuary.Render.RenderEnvironment -import Estuary.Render.TextNotationRenderer -import Estuary.Types.RenderState -import Estuary.Types.RenderInfo -import Estuary.Types.TextNotation -import Estuary.Render.MainBus -import Estuary.Types.Tempo -import Estuary.Types.Ensemble -import Estuary.Types.EnsembleC - -punctual :: TextNotationRenderer -punctual = emptyTextNotationRenderer { - parseZone = _parseZone, - clearZone' = _clearZone, - preAnimationFrame = _preAnimationFrame, - zoneAnimationFrame = _zoneAnimationFrame, - postAnimationFrame = _postAnimationFrame - } - - -_parseZone :: Int -> Text -> UTCTime -> R () -_parseZone z t eTime = do - s <- get - parseResult <- liftIO $ try $ return $! Punctual.parse eTime t - parseResult' <- case parseResult of - Right (Right punctualProgram) -> do - setBaseNotation z Punctual - setEvaluationTime z eTime - punctualProgramChanged z punctualProgram - return (Right punctualProgram) - Right (Left parseErr) -> return (Left $ T.pack $ show parseErr) - Left exception -> return (Left $ T.pack $ show (exception :: SomeException)) - let newErrors = either (\e -> insert z e (errors (info s))) (const $ delete z (errors (info s))) parseResult' - modify' $ \x -> x { info = (info s) { errors = newErrors }} - - -_clearZone :: Int -> R () -_clearZone z = do - s <- get - case (IntMap.lookup z $ punctuals s) of - Just x -> liftAudioIO $ Punctual.deletePunctualW x - Nothing -> return () - newPunctualWebGL <- liftIO $ Punctual.deletePunctualWebGL (glContext s) z $ punctualWebGL s - modify' $ \x -> x { - punctuals = IntMap.delete z $ punctuals x, - punctualWebGL = newPunctualWebGL - } - -punctualProgramChanged :: Int -> Punctual.Program -> R () -punctualProgramChanged z p = do - rEnv <- ask - s <- get - -- A. update PunctualW (audio state) in response to new, syntactically correct program - pIn <- liftIO $ getPunctualInput $ mainBus rEnv - pOut <- liftIO $ getMainBusInput $ mainBus rEnv - ac <- liftAudioIO $ audioContext - t <- liftAudioIO $ audioTime - nchnls <- liftIO $ getAudioOutputs $ mainBus rEnv - let prevPunctualW = Punctual.setPunctualWChannels nchnls $ findWithDefault (Punctual.emptyPunctualW ac pIn pOut nchnls (Punctual.evalTime p)) z (punctuals s) - let tempo' = tempoCache s - let beat0 = utcTimeToAudioSeconds (wakeTimeSystem s, wakeTimeAudio s) $ origin tempo' - let cps' = freq tempo' - newPunctualW <- liftIO $ do - runAudioContextIO ac $ Punctual.updatePunctualW prevPunctualW (tempoCache s) p - `catch` (\e -> putStrLn (show (e :: SomeException)) >> return prevPunctualW) - modify' $ \x -> x { punctuals = insert z newPunctualW (punctuals s)} - -- B. update Punctual WebGL state in response to new, syntactically correct program - pWebGL <- gets punctualWebGL - newWebGL <- liftIO $ - fmap fst (Punctual.evaluatePunctualWebGL (glContext s) (tempoCache s) z p pWebGL) - `catch` (\e -> putStrLn (show (e :: SomeException)) >> return pWebGL) - modify' $ \x -> x { punctualWebGL = newWebGL } - - -_preAnimationFrame :: R () -_preAnimationFrame = do - s <- get - res <- resolution - b <- brightness - newWebGL <- liftIO $ do - x <- Punctual.setResolution (glContext s) res (punctualWebGL s) - Punctual.setBrightness b x - `catch` (\e -> putStrLn (show (e :: SomeException)) >> return (punctualWebGL s)) - modify' $ \x -> x { punctualWebGL = newWebGL } - - -_zoneAnimationFrame :: UTCTime -> Int -> R () -_zoneAnimationFrame tNow z = do - s <- get - newWebGL <- liftIO $ - Punctual.drawPunctualWebGL (glContext s) (tempoCache s) tNow z (punctualWebGL s) - `catch` (\e -> putStrLn (show (e :: SomeException)) >> return (punctualWebGL s)) - modify' $ \x -> x { punctualWebGL = newWebGL } - - -_postAnimationFrame :: R () -_postAnimationFrame = do - s <- get - newWebGL <- liftIO $ - Punctual.displayPunctualWebGL (glContext s) (punctualWebGL s) - `catch` (\e -> putStrLn (show (e :: SomeException)) >> return (punctualWebGL s)) - modify' $ \x -> x { punctualWebGL = newWebGL } diff --git a/client/src/Estuary/Languages/TimeNot.hs b/client/src/Estuary/Languages/TimeNot.hs index a51b00c2..1a1d4ecf 100644 --- a/client/src/Estuary/Languages/TimeNot.hs +++ b/client/src/Estuary/Languages/TimeNot.hs @@ -9,9 +9,7 @@ import GHCJS.Types import GHCJS.Marshal -- .Internal import Estuary.Types.NoteEvent -import Estuary.Types.RenderState import Estuary.Render.R hiding (setTempo) -import Estuary.Render.TextNotationRenderer import Estuary.Types.TextNotation import Estuary.Types.EnsembleC import Estuary.Types.Ensemble diff --git a/client/src/Estuary/Render/R.hs b/client/src/Estuary/Render/R.hs index 9f88dac7..96eb6ce3 100644 --- a/client/src/Estuary/Render/R.hs +++ b/client/src/Estuary/Render/R.hs @@ -15,16 +15,33 @@ import Data.IORef import Sound.MusicW import TextShow import GHCJS.Types (JSVal) +import GHCJS.DOM.Types hiding (Text) +import Sound.MusicW.AudioContext +import Sound.MusicW.Node as MusicW import qualified Sound.Tidal.Context as Tidal import qualified Sound.Punctual.Resolution as Punctual +import qualified Sound.Punctual as Punctual +import Sound.Punctual.GL import Estuary.Types.Definition import Estuary.Types.TextNotation import Estuary.Types.NoteEvent import Estuary.Types.RenderInfo -import Estuary.Types.RenderState +import Estuary.Types.MovingAverage +import Estuary.Types.Definition +import Estuary.Types.RenderInfo +import Estuary.Types.NoteEvent +import Estuary.Types.MovingAverage +import Estuary.Types.TextNotation hiding (LocoMotion) +import qualified Estuary.Languages.CineCer0.CineCer0State as CineCer0 +import qualified Estuary.Languages.CineCer0.Spec as CineCer0 +import qualified Estuary.Languages.CineCer0.Parser as CineCer0 +import qualified Sound.Seis8s.Program as Seis8s +import qualified Estuary.Languages.Hydra.Render as Hydra +import Estuary.Languages.JSoLang +import Estuary.Languages.ExoLang import Estuary.Render.MainBus import Estuary.Render.WebDirt import Estuary.Render.SuperDirt @@ -38,6 +55,8 @@ import Estuary.Render.WebSerial as WebSerial import Estuary.Render.WebDirt as WebDirt import Estuary.Types.RenderInfo import Estuary.Render.RenderEnvironment +import Estuary.Languages.ExoLang +import Estuary.Languages.JSoLang putRenderOps :: MonadIO m => RenderEnvironment -> [RenderOp] -> m () putRenderOps re x = liftIO $ do @@ -180,3 +199,224 @@ updateWebDirtVoices = do wd <- asks webDirt n <- liftIO $ WebDirt.voices wd modify' $ \s -> s { info = (info s) { webDirtVoices = n } } + + + +data TextNotationRenderer = TextNotationRenderer { + parseZone :: Int -> Text -> UTCTime -> R (), + scheduleNoteEvents :: Int -> R [NoteEvent], + scheduleWebDirtEvents :: Int -> R [JSVal], -- deprecated/temporary + clearZone' :: Int -> R (), + zoneAnimationFrame :: UTCTime -> Int -> R (), + preAnimationFrame :: R (), + postAnimationFrame :: R () +} + +emptyTextNotationRenderer :: TextNotationRenderer +emptyTextNotationRenderer = TextNotationRenderer { + parseZone = \_ _ _ -> return (), + scheduleNoteEvents = \_ -> return [], + scheduleWebDirtEvents = \_ -> return [], + clearZone' = \_ -> return (), + zoneAnimationFrame = \_ _ -> return (), + preAnimationFrame = return (), + postAnimationFrame = return () + } + +exoLangToRenderer :: TextNotation -> ExoLang -> TextNotationRenderer +exoLangToRenderer tn exolang = emptyTextNotationRenderer { + parseZone = parseZone' tn exolang, + scheduleWebDirtEvents = scheduleWebDirtEvents' exolang, + clearZone' = clearZone'' exolang, + preAnimationFrame = preAnimationFrame' exolang, + zoneAnimationFrame = zoneAnimationFrame' exolang, + postAnimationFrame = postAnimationFrame' exolang + } + +parseZone' :: TextNotation -> ExoLang -> Int -> Text -> UTCTime -> R () +parseZone' tn exoLang z txt eTime = do + r <- liftIO $ Estuary.Languages.ExoLang.evaluate exoLang z txt + case r of + Just err -> do + setBaseNotation z tn + setZoneError z err + Nothing -> do + setBaseNotation z tn + setEvaluationTime z eTime + clearZoneError z + +scheduleWebDirtEvents' :: ExoLang -> Int -> R [JSVal] +scheduleWebDirtEvents' exoLang z = do + s <- get + let wStart = renderStart s + let wEnd = renderEnd s + liftIO $ render exoLang z wStart wEnd + +clearZone'' :: ExoLang -> Int -> R () +clearZone'' exoLang z = do + x <- liftIO $ try $ clearZone exoLang z + case x of + Right () -> pure () + Left exception -> do + let msg = "Estuary: exception in clearZone'': " ++ show (exception :: SomeException) + liftIO $ putStrLn msg + pure () + + +preAnimationFrame' :: ExoLang -> R () +preAnimationFrame' exoLang = liftIO $ preAnimate exoLang + +zoneAnimationFrame' :: ExoLang -> UTCTime -> Int -> R () +zoneAnimationFrame' exoLang _ z = do + s <- get + liftIO $ setTempo exoLang (tempoCache s) + liftIO $ animateZone exoLang z + +postAnimationFrame' :: ExoLang -> R () +postAnimationFrame' exoLang = liftIO $ postAnimate exoLang + + +newPunctual :: HTMLCanvasElement -> IO TextNotationRenderer +newPunctual cvs = do + p <- Punctual.new cvs + pure $ emptyTextNotationRenderer { + parseZone = _parseZonePunctual p, + clearZone' = _clearZonePunctual p, + preAnimationFrame = _preAnimationFramePunctual p, + zoneAnimationFrame = _zoneAnimationFramePunctual p, + postAnimationFrame = _postAnimationFramePunctual p + } + + +_parseZonePunctual :: Punctual.Punctual -> Int -> Text -> UTCTime -> R () +_parseZonePunctual p z t eTime = do + s <- get + liftIO $ Punctual.setTempo p (tempoCache s) + r <- liftIO $ try $ Punctual.evaluate p z t eTime + case r of + Right (Right _) -> do + setBaseNotation z Punctual + setEvaluationTime z eTime + clearZoneError z + pure () + Right (Left parseErr) -> do + setZoneError z $ T.pack $ show parseErr + Left exception -> do + setZoneError z $ T.pack $ show (exception :: SomeException) + + +_clearZonePunctual :: Punctual.Punctual -> Int -> R () +_clearZonePunctual p z = do + liftIO $ Punctual.clear p z + clearZoneError z + clearBaseNotation z + + +_preAnimationFramePunctual :: Punctual.Punctual -> R () +_preAnimationFramePunctual p = do + s <- get + res <- Estuary.Render.R.resolution + b <- Estuary.Render.R.brightness + liftIO $ Punctual.setResolution p res + liftIO $ Punctual.setBrightness p b + liftIO $ Punctual.setTempo p (tempoCache s) + + +_zoneAnimationFramePunctual :: Punctual.Punctual -> UTCTime -> Int -> R () +_zoneAnimationFramePunctual p tNow z = liftIO $ Punctual.render p True z tNow + + +_postAnimationFramePunctual :: Punctual.Punctual -> R () +_postAnimationFramePunctual p = liftIO $ Punctual.postRender p True + + +newtype LocoMotion = LocoMotion JSVal + +instance PToJSVal LocoMotion where pToJSVal (Estuary.Render.R.LocoMotion x) = x + +instance PFromJSVal LocoMotion where pFromJSVal = Estuary.Render.R.LocoMotion + +data RenderState = RenderState { + wakeTimeAudio :: !Double, + wakeTimeSystem :: !UTCTime, + renderStart :: !UTCTime, + renderPeriod :: !NominalDiffTime, + renderEnd :: !UTCTime, + cachedDefs :: !DefinitionMap, + paramPatterns :: !(IntMap Tidal.ControlPattern), + noteEvents :: ![NoteEvent], + webDirtEvents :: ![JSVal], -- deprecated/temporary + baseNotations :: !(IntMap TextNotation), + baseDefinitions :: !(IntMap Definition), + cineCer0Specs :: !(IntMap CineCer0.Spec), + cineCer0States :: !(IntMap CineCer0.CineCer0State), + timeNots :: IntMap JSVal, + seis8ses :: IntMap Seis8s.Program, + hydras :: IntMap Hydra.Hydra, + evaluationTimes :: IntMap UTCTime, -- this is probably temporary + renderTime :: !MovingAverage, + wakeTimeAnimation :: !UTCTime, + animationDelta :: !MovingAverage, -- time between frame starts, ie. 1/FPS + animationTime :: !MovingAverage, -- time between frame start and end of drawing operations + zoneRenderTimes :: !(IntMap MovingAverage), + zoneAnimationTimes :: !(IntMap MovingAverage), + info :: !RenderInfo, + glContext :: GLContext, + canvasElement :: HTMLCanvasElement, + hydraCanvas :: HTMLCanvasElement, + locoMotionCanvas :: HTMLCanvasElement, + videoDivCache :: Maybe HTMLDivElement, + tempoCache :: Tempo, + jsoLangs :: Map.Map Text JSoLang, + valueMap :: Tidal.ValueMap, + locoMotion :: ExoLang, + exoLangTest :: ExoLang, + transMit :: ExoLang, + punctual :: TextNotationRenderer + } + + +initialRenderState :: MusicW.Node -> MusicW.Node -> HTMLCanvasElement -> GLContext -> HTMLCanvasElement -> HTMLCanvasElement -> UTCTime -> AudioTime -> IO RenderState +initialRenderState pIn pOut cvsElement glCtx hCanvas lCanvas t0System t0Audio = do + punctual' <- newPunctual cvsElement + lm <- exoLang lCanvas "https://dktr0.github.io/LocoMotion/locoMotion.js" + elt <- exoLang lCanvas "./exolang.js" + tm <- exoLang lCanvas "https://jac307.github.io/TransMit/exolang.js" + return $ RenderState { + wakeTimeSystem = t0System, + wakeTimeAudio = t0Audio, + renderStart = t0System, + renderPeriod = 0, + renderEnd = t0System, + cachedDefs = IntMap.empty, + paramPatterns = IntMap.empty, + noteEvents = [], + webDirtEvents = [], + baseNotations = IntMap.empty, + baseDefinitions = IntMap.empty, + cineCer0Specs = IntMap.empty, + cineCer0States = IntMap.empty, + timeNots = IntMap.empty, + seis8ses = IntMap.empty, + hydras = IntMap.empty, + evaluationTimes = IntMap.empty, + renderTime = newAverage 20, + wakeTimeAnimation = t0System, + animationDelta = newAverage 20, + animationTime = newAverage 20, + zoneRenderTimes = IntMap.empty, + zoneAnimationTimes = IntMap.empty, + info = emptyRenderInfo, + glContext = glCtx, + canvasElement = cvsElement, + hydraCanvas = hCanvas, + locoMotionCanvas = lCanvas, + videoDivCache = Nothing, + tempoCache = Tempo { freq = 0.5, time = t0System, count = 0 }, + jsoLangs = Map.empty, + valueMap = Map.empty, + locoMotion = lm, + exoLangTest = elt, + transMit = tm, + punctual = punctual' + } diff --git a/client/src/Estuary/Render/Renderer.hs b/client/src/Estuary/Render/Renderer.hs index 1b4fe8a4..10d39866 100644 --- a/client/src/Estuary/Render/Renderer.hs +++ b/client/src/Estuary/Render/Renderer.hs @@ -35,7 +35,6 @@ import Data.IORef import Sound.MusicW.AudioContext import qualified Sound.Seis8s.Parser as Seis8s -import Estuary.Languages.Punctual import Estuary.Languages.CineCer0 import Estuary.Languages.MiniTidal import Estuary.Languages.TimeNot @@ -58,14 +57,12 @@ import qualified Estuary.Render.WebDirt as WebDirt import qualified Estuary.Render.SuperDirt as SuperDirt import Estuary.Types.NoteEvent import Estuary.Types.RenderInfo -import Estuary.Types.RenderState hiding (LocoMotion) import Estuary.Types.Tempo import Estuary.Types.MovingAverage import Estuary.Render.DynamicsMode import Estuary.Render.MainBus -import Estuary.Render.R +import Estuary.Render.R hiding (LocoMotion) import Estuary.Render.RenderEnvironment -import Estuary.Render.TextNotationRenderer import Estuary.Render.RenderOp import qualified Estuary.Client.Settings as Settings import Estuary.Render.WebSerial as WebSerial @@ -325,7 +322,9 @@ clearZone _ _ = return () clearTextProgram :: Int -> TextNotation -> R () clearTextProgram z (TidalTextNotation MiniTidal) = (clearZone' miniTidal) z -clearTextProgram z Punctual = (clearZone' punctual) z +clearTextProgram z Punctual = do + s <- get + (clearZone' (punctual s)) z clearTextProgram z CineCer0 = (clearZone' cineCer0) z clearTextProgram z Hydra = modify' $ \x -> x { hydras = IntMap.delete z $ hydras x } clearTextProgram z LocoMotion = do @@ -351,11 +350,11 @@ renderAnimation = do let anyPunctualZones = elem Punctual ns let anyLocoMotionZones = elem LocoMotion ns let anyTransMitZones = elem TransMit ns - when anyPunctualZones $ preAnimationFrame punctual + when anyPunctualZones $ preAnimationFrame (punctual s) when anyLocoMotionZones $ liftIO $ ExoLang.preAnimate (locoMotion s) when anyTransMitZones $ liftIO $ ExoLang.preAnimate (transMit s) traverseWithKey (renderZoneAnimation t1) ns - when anyPunctualZones $ postAnimationFrame punctual + when anyPunctualZones $ postAnimationFrame (punctual s) when anyLocoMotionZones $ liftIO $ ExoLang.postAnimate (locoMotion s) when anyTransMitZones $ liftIO $ ExoLang.postAnimate (transMit s) t2 <- liftIO $ getCurrentTime @@ -379,7 +378,9 @@ renderZoneAnimation :: UTCTime -> Int -> TextNotation -> R () renderZoneAnimation tNow z n = renderZoneAnimationTextProgram tNow z n renderZoneAnimationTextProgram :: UTCTime -> Int -> TextNotation -> R () -renderZoneAnimationTextProgram tNow z Punctual = (zoneAnimationFrame punctual) tNow z +renderZoneAnimationTextProgram tNow z Punctual = do + s <- get + (zoneAnimationFrame (punctual s)) tNow z renderZoneAnimationTextProgram tNow z CineCer0 = (zoneAnimationFrame cineCer0) tNow z renderZoneAnimationTextProgram tNow z Hydra = renderHydra tNow z renderZoneAnimationTextProgram tNow z LocoMotion = do @@ -443,7 +444,9 @@ renderTextProgramChanged z (UnspecifiedNotation,x,eTime) = do _-> renderTextProgramChanged z (n,x',eTime) renderTextProgramChanged z (TidalTextNotation _,x,eTime) = (parseZone miniTidal) z x eTime -renderTextProgramChanged z (Punctual,x,eTime) = (parseZone punctual) z x eTime +renderTextProgramChanged z (Punctual,x,eTime) = do + s <- get + (parseZone (punctual s)) z x eTime renderTextProgramChanged z (CineCer0,x,eTime) = (parseZone cineCer0) z x eTime renderTextProgramChanged z (Hydra,x,_) = parseHydra z x renderTextProgramChanged z (LocoMotion,x,eTime) = do diff --git a/client/src/Estuary/Render/TextNotationRenderer.hs b/client/src/Estuary/Render/TextNotationRenderer.hs deleted file mode 100644 index 03b1f814..00000000 --- a/client/src/Estuary/Render/TextNotationRenderer.hs +++ /dev/null @@ -1,170 +0,0 @@ -{-# LANGUAGE JavaScriptFFI #-} - -module Estuary.Render.TextNotationRenderer - ( - TextNotationRenderer(..), - emptyTextNotationRenderer, - exoLangToRenderer - ) where - -import Data.Text -import Data.Time -import Data.Time.Clock.POSIX -import Control.Monad.State.Strict -import Control.Exception hiding (evaluate) - -import Estuary.Types.NoteEvent -import Estuary.Render.R -import qualified Sound.Tidal.Context as Tidal -import GHCJS.Types -import GHCJS.DOM.Types hiding (Text) -import Estuary.Languages.ExoLang -import Estuary.Types.TextNotation as TextNotation -import Estuary.Types.Tempo -import Estuary.Render.R hiding (setTempo) -import Estuary.Render.ForeignTempo -import Estuary.Types.RenderState -import Estuary.Languages.ExoLang - - -data TextNotationRenderer = TextNotationRenderer { - parseZone :: Int -> Text -> UTCTime -> R (), - scheduleNoteEvents :: Int -> R [NoteEvent], - scheduleWebDirtEvents :: Int -> R [JSVal], -- deprecated/temporary - clearZone' :: Int -> R (), - zoneAnimationFrame :: UTCTime -> Int -> R (), - preAnimationFrame :: R (), - postAnimationFrame :: R () -} - -emptyTextNotationRenderer :: TextNotationRenderer -emptyTextNotationRenderer = TextNotationRenderer { - parseZone = \_ _ _ -> return (), - scheduleNoteEvents = \_ -> return [], - scheduleWebDirtEvents = \_ -> return [], - clearZone' = \_ -> return (), - zoneAnimationFrame = \_ _ -> return (), - preAnimationFrame = return (), - postAnimationFrame = return () - } - -exoLangToRenderer :: TextNotation -> ExoLang -> TextNotationRenderer -exoLangToRenderer tn exolang = emptyTextNotationRenderer { - parseZone = parseZone' tn exolang, - scheduleWebDirtEvents = scheduleWebDirtEvents' exolang, - clearZone' = clearZone'' exolang, - preAnimationFrame = preAnimationFrame' exolang, - zoneAnimationFrame = zoneAnimationFrame' exolang, - postAnimationFrame = postAnimationFrame' exolang - } - -parseZone' :: TextNotation -> ExoLang -> Int -> Text -> UTCTime -> R () -parseZone' tn exoLang z txt eTime = do - r <- liftIO $ evaluate exoLang z txt - case r of - Just err -> do - setBaseNotation z tn - setZoneError z err - Nothing -> do - setBaseNotation z tn - setEvaluationTime z eTime - clearZoneError z - -scheduleWebDirtEvents' :: ExoLang -> Int -> R [JSVal] -scheduleWebDirtEvents' exoLang z = do - s <- get - let wStart = renderStart s - let wEnd = renderEnd s - liftIO $ render exoLang z wStart wEnd - -clearZone'' :: ExoLang -> Int -> R () -clearZone'' exoLang z = do - x <- liftIO $ try $ clearZone exoLang z - case x of - Right () -> pure () - Left exception -> do - let msg = "Estuary: exception in clearZone'': " ++ show (exception :: SomeException) - liftIO $ putStrLn msg - pure () - - -preAnimationFrame' :: ExoLang -> R () -preAnimationFrame' exoLang = liftIO $ preAnimate exoLang - -zoneAnimationFrame' :: ExoLang -> UTCTime -> Int -> R () -zoneAnimationFrame' exoLang _ z = do - s <- get - liftIO $ setTempo exoLang (tempoCache s) - liftIO $ animateZone exoLang z - -postAnimationFrame' :: ExoLang -> R () -postAnimationFrame' exoLang = liftIO $ postAnimate exoLang - -{- - -Thought experiment: how might a complete TextNotationRenderer be provided as an ExoLang (a JS module)? - -What is really great about the approach below is that it moves a given language almost entirely out of the -RenderState - all we need to hold on to is a single cached object for the language as a whole, in all cases. - -// a constructor that takes no arguments and which will only be called once by Estuary -// ie. to produce and hold on to an object for that language the first time an evaluation in that -// language happens. - -export default const SomeExoLang = function () { -} - -// a function that is called whenever code is evaluated in a numbered zone -// it receives the numbered zone, the evaluated text, and a standardized 'context' object -// that contains other additional, potentially relevant info/objects -// (for example, context might contain a ForeignTempo, the audio context, a canvas or canvases, etc) -// typically it will either update some properties of the ExoLang object or -// just pass appropriate info to some other embedded object (depending on how the language -// is implemented) AND return an ExoResult (a record containing a success field and an error field) - -SomeExoLang.prototype.parseZone = function( text :: String, zone :: Int, evaluationTime :: Object, context :: Object ) { - // evaluationTime is an object so that it can be provided in multiple formats with some future-proofing - // not completely sure Int for zone is future-proof though, given plans for sub-rendering of JSoLangs that target multiple languages, etc. - // a string that can have any level of "sub-versioning" might work, eg. "3.2" means the third sub-zone of top-level zone 3, etc -} - -// called once per slow render block if parseZone has ever succeeded with this language in this zone -// returns an array of NoteEvents, ie. JavaScript objects nominally ready for consumption by WebDirt -// Estuary will convert such events to its internal format NoteEvent (and, for example, resolve s + n fields -// to appropriate buffers) and then direct them where they need to go depending on current configuration. -// the 'window' argument contains the rendering window in multiple formats/epochs. -// context contains the same stuff as above in parseZone. -// (if a language does not need to schedule note events, it simply doesn't define this prototype - Estuary -// will not call it if it does not exist) -SomeExoLang.prototype.scheduleNoteEvents = function (zone :: Int, window :: Object, context :: Object ) { - // would scheduleNoteEvents ever need to signal an error, and if so, how would it do so? (throw an exception, perhaps) -} - - -// called to signal that a given zone is no longer occupied by code for this language -// for example, graphical languages might use this to clear out/make transparent a canvas -// an in general, many languages will take this moment to delete/release resources connected to a zone -// (see caveats above though about whether Int is really the right type for indicating a zone) -// no return value. not really sure if the context would ever be necessary, but can't hurt to provide it -// anyway as a simple form of future-proofing. -SomeExoLang.prototype.clearZone = function (zone :: Int, context :: Object) { -} - -// called at the beginning of the requestAnimationFrame response if there are -// ANY zones for this language to be rendered -SomeExoLang.prototype.preAnimationFrame = function (context :: Object) { -} - -// called for each zone to be rendered during the requestAnimationFrame response -// could return an ExoResult? as a way of passing on, for example, WebGL errors? -// (but we would want to somehow distinguish ephemeral WebGL resource errors that will -// likely resolve by themselves inconsequentially from syntax errors, which could be about -// using the ExoResult type but not doing the same thing with it that we would do with parseZone) -SomeExoLang.prototype.zoneAnimationFrame = function (zone :: Int, context :: Object) { -} - -// called after zoneAnimationFrame above has been called for each active zone -SomeExoLang.prototype.postAnimationFrame = function (context :: Object) { -} - --} diff --git a/client/src/Estuary/Types/RenderState.hs b/client/src/Estuary/Types/RenderState.hs deleted file mode 100644 index 0d896849..00000000 --- a/client/src/Estuary/Types/RenderState.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Estuary.Types.RenderState where - -import Data.Time.Clock -import qualified Data.Map as Map -import Data.IntMap.Strict -import qualified Sound.Tidal.Context as Tidal -import qualified Sound.Punctual.PunctualW as Punctual -import qualified Sound.Punctual.WebGL as Punctual -import qualified Sound.Punctual.Resolution as Punctual -import Sound.MusicW.AudioContext -import Sound.MusicW.Node as MusicW -import GHCJS.DOM.Types hiding (Text) -import Data.Text (Text) -import Sound.Punctual.GL -import Data.Tempo -import Data.IORef - -import Estuary.Types.Definition -import Estuary.Types.RenderInfo -import Estuary.Types.NoteEvent -import Estuary.Types.MovingAverage -import Estuary.Types.TextNotation hiding (LocoMotion) -import qualified Estuary.Languages.CineCer0.CineCer0State as CineCer0 -import qualified Estuary.Languages.CineCer0.Spec as CineCer0 -import qualified Estuary.Languages.CineCer0.Parser as CineCer0 -import qualified Sound.Seis8s.Program as Seis8s -import qualified Estuary.Languages.Hydra.Render as Hydra -import Estuary.Languages.JSoLang -import Estuary.Languages.ExoLang - -newtype LocoMotion = LocoMotion JSVal - -instance PToJSVal LocoMotion where pToJSVal (LocoMotion x) = x - -instance PFromJSVal LocoMotion where pFromJSVal = LocoMotion - -data RenderState = RenderState { - wakeTimeAudio :: !Double, - wakeTimeSystem :: !UTCTime, - renderStart :: !UTCTime, - renderPeriod :: !NominalDiffTime, - renderEnd :: !UTCTime, - cachedDefs :: !DefinitionMap, - paramPatterns :: !(IntMap Tidal.ControlPattern), - noteEvents :: ![NoteEvent], --- tidalEvents :: ![(UTCTime,Tidal.ValueMap)], - webDirtEvents :: ![JSVal], -- deprecated/temporary - baseNotations :: !(IntMap TextNotation), - baseDefinitions :: !(IntMap Definition), - punctuals :: !(IntMap Punctual.PunctualW), - punctualWebGL :: Punctual.PunctualWebGL, - cineCer0Specs :: !(IntMap CineCer0.Spec), - cineCer0States :: !(IntMap CineCer0.CineCer0State), - timeNots :: IntMap JSVal, - seis8ses :: IntMap Seis8s.Program, - hydras :: IntMap Hydra.Hydra, - evaluationTimes :: IntMap UTCTime, -- this is probably temporary - renderTime :: !MovingAverage, - wakeTimeAnimation :: !UTCTime, - animationDelta :: !MovingAverage, -- time between frame starts, ie. 1/FPS - animationTime :: !MovingAverage, -- time between frame start and end of drawing operations - zoneRenderTimes :: !(IntMap MovingAverage), - zoneAnimationTimes :: !(IntMap MovingAverage), - info :: !RenderInfo, - glContext :: GLContext, - canvasElement :: HTMLCanvasElement, - hydraCanvas :: HTMLCanvasElement, - locoMotionCanvas :: HTMLCanvasElement, - videoDivCache :: Maybe HTMLDivElement, - tempoCache :: Tempo, - jsoLangs :: Map.Map Text JSoLang, - valueMap :: Tidal.ValueMap, - locoMotion :: ExoLang, - exoLangTest :: ExoLang, - transMit :: ExoLang - } - - -initialRenderState :: MusicW.Node -> MusicW.Node -> HTMLCanvasElement -> GLContext -> HTMLCanvasElement -> HTMLCanvasElement -> UTCTime -> AudioTime -> IO RenderState -initialRenderState pIn pOut cvsElement glCtx hCanvas lCanvas t0System t0Audio = do - pWebGL <- Punctual.newPunctualWebGL (Just pIn) (Just pOut) Punctual.HD 1.0 hCanvas glCtx - lm <- exoLang lCanvas "https://dktr0.github.io/LocoMotion/locoMotion.js" - elt <- exoLang lCanvas "./exolang.js" - tm <- exoLang lCanvas "https://jac307.github.io/TransMit/exolang.js" - return $ RenderState { - wakeTimeSystem = t0System, - wakeTimeAudio = t0Audio, - renderStart = t0System, - renderPeriod = 0, - renderEnd = t0System, - cachedDefs = empty, - paramPatterns = empty, - noteEvents = [], --- tidalEvents = [], - webDirtEvents = [], - baseNotations = empty, - baseDefinitions = empty, - punctuals = empty, - punctualWebGL = pWebGL, - cineCer0Specs = empty, - cineCer0States = empty, - timeNots = empty, - seis8ses = empty, - hydras = empty, - evaluationTimes = empty, - renderTime = newAverage 20, - wakeTimeAnimation = t0System, - animationDelta = newAverage 20, - animationTime = newAverage 20, - zoneRenderTimes = empty, - zoneAnimationTimes = empty, - info = emptyRenderInfo, - glContext = glCtx, - canvasElement = cvsElement, - hydraCanvas = hCanvas, - locoMotionCanvas = lCanvas, - videoDivCache = Nothing, - tempoCache = Tempo { freq = 0.5, time = t0System, count = 0 }, - jsoLangs = Map.empty, - valueMap = Map.empty, - locoMotion = lm, - exoLangTest = elt, - transMit = tm - } diff --git a/default.nix b/default.nix index c192e0d6..54021a7c 100644 --- a/default.nix +++ b/default.nix @@ -144,8 +144,8 @@ in dontCheck (dontHaddock (self.callCabal2nix "punctual" (pkgs.fetchFromGitHub { owner = "dktr0"; repo = "punctual"; - sha256 = "07z23vf9hyydj2kbywzp0mjlxvhzmjh0z5irwrahzsrnij8gix9w"; - rev = "d8a9f5df78f7c7c70a4dccdd311ca5a0a7a708f3"; + sha256 = "03nscv9n00qiywwkr6d14amksd90pfiz3zw41nz9h5j072ixm44f"; + rev = "bc3a2d52c5ffe5a8202e6d7afe485ece11172b5f"; }) {})); musicw = self.callCabal2nix "musicw" (pkgs.fetchFromGitHub {