From 6c6777d03d6d56a6649e1cc7fb91c5e84fd97f86 Mon Sep 17 00:00:00 2001 From: Eric Conlon <37287+ejconlon@users.noreply.github.com> Date: Mon, 5 Feb 2024 17:50:31 -0800 Subject: [PATCH] etc --- minipat-dirt/minipat-dirt.cabal | 1 + minipat-dirt/src/Minipat/Dirt/Attrs.hs | 53 ++++++++++++++++++++++++ minipat-dirt/src/Minipat/Dirt/Boot.hs | 2 +- minipat-dirt/src/Minipat/Dirt/Core.hs | 3 +- minipat-dirt/src/Minipat/Dirt/Osc.hs | 50 ++-------------------- minipat-dirt/src/Minipat/Dirt/Parser.hs | 2 +- minipat-dirt/src/Minipat/Dirt/Prelude.hs | 2 +- minipat-dirt/src/Minipat/Dirt/Test.hs | 3 +- 8 files changed, 65 insertions(+), 51 deletions(-) create mode 100644 minipat-dirt/src/Minipat/Dirt/Attrs.hs diff --git a/minipat-dirt/minipat-dirt.cabal b/minipat-dirt/minipat-dirt.cabal index 6ff555a..155b707 100644 --- a/minipat-dirt/minipat-dirt.cabal +++ b/minipat-dirt/minipat-dirt.cabal @@ -24,6 +24,7 @@ source-repository head library exposed-modules: + Minipat.Dirt.Attrs Minipat.Dirt.Boot Minipat.Dirt.Core Minipat.Dirt.EStream diff --git a/minipat-dirt/src/Minipat/Dirt/Attrs.hs b/minipat-dirt/src/Minipat/Dirt/Attrs.hs new file mode 100644 index 0000000..6fee116 --- /dev/null +++ b/minipat-dirt/src/Minipat/Dirt/Attrs.hs @@ -0,0 +1,53 @@ +module Minipat.Dirt.Attrs + ( DatumProxy (..) + , datumProxyType + , Attr (..) + , Attrs + , attrs + , IsAttrs (..) + ) +where + +import Dahdit.Midi.Osc (Datum, DatumType (..), IsDatum (..)) +import Data.Int (Int32, Int64) +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map +import Data.Text (Text) + +data DatumProxy a where + DatumProxyInt32 :: DatumProxy Int32 + DatumProxyInt64 :: DatumProxy Int64 + DatumProxyFloat :: DatumProxy Float + DatumProxyDouble :: DatumProxy Double + DatumProxyString :: DatumProxy Text + +datumProxyType :: DatumProxy a -> DatumType +datumProxyType = \case + DatumProxyInt32 -> DatumTypeInt32 + DatumProxyInt64 -> DatumTypeInt64 + DatumProxyFloat -> DatumTypeFloat + DatumProxyDouble -> DatumTypeDouble + DatumProxyString -> DatumTypeString + +data Attr a = Attr + { attrKey :: !Text + , attrVal :: !a + } + deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +type Attrs = Map Text Datum + +attrs :: [(Text, Datum)] -> Attrs +attrs = Map.fromList + +class IsAttrs a where + toAttrs :: a -> Attrs + +instance IsAttrs Attrs where + toAttrs = id + +instance (IsDatum a) => IsAttrs (Attr a) where + toAttrs (Attr k v) = Map.singleton k (toDatum v) + +-- instance IsAttrs Note where +-- toAttrs (Note n) = Map.singleton "note" (DatumInt32 (fromInteger n)) diff --git a/minipat-dirt/src/Minipat/Dirt/Boot.hs b/minipat-dirt/src/Minipat/Dirt/Boot.hs index e66f366..05ab888 100644 --- a/minipat-dirt/src/Minipat/Dirt/Boot.hs +++ b/minipat-dirt/src/Minipat/Dirt/Boot.hs @@ -2,9 +2,9 @@ module Minipat.Dirt.Boot where +import Minipat.Dirt.Attrs (Attrs) import Minipat.Dirt.Core qualified as C import Minipat.Dirt.Logger qualified as L -import Minipat.Dirt.Osc (Attrs) import Minipat.Stream (Stream) import Nanotime (TimeDelta) diff --git a/minipat-dirt/src/Minipat/Dirt/Core.hs b/minipat-dirt/src/Minipat/Dirt/Core.hs index e11dc82..3209a6a 100644 --- a/minipat-dirt/src/Minipat/Dirt/Core.hs +++ b/minipat-dirt/src/Minipat/Dirt/Core.hs @@ -30,8 +30,9 @@ import Data.Map.Strict qualified as Map import Data.Ratio ((%)) import Data.Sequence (Seq) import Data.Text qualified as T +import Minipat.Dirt.Attrs (Attrs) import Minipat.Dirt.Logger (LogAction, logError, logInfo, newLogger) -import Minipat.Dirt.Osc (Attrs, PlayEnv (..), PlayErr, Timed (..), convertTape, handshakePacket, playPacket) +import Minipat.Dirt.Osc (PlayEnv (..), PlayErr, Timed (..), convertTape, handshakePacket, playPacket) import Minipat.Dirt.Resources (RelVar, acquireAsync, relVarAcquire, relVarDispose, relVarInit) import Minipat.Print (prettyPrint) import Minipat.Stream (Stream (..), streamRun) diff --git a/minipat-dirt/src/Minipat/Dirt/Osc.hs b/minipat-dirt/src/Minipat/Dirt/Osc.hs index 08cb932..40ec5f7 100644 --- a/minipat-dirt/src/Minipat/Dirt/Osc.hs +++ b/minipat-dirt/src/Minipat/Dirt/Osc.hs @@ -1,13 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Minipat.Dirt.Osc - ( DatumProxy (..) - , datumProxyType - , Timed (..) - , Attrs - , attrs - , IsAttrs (..) - , Attr (..) + ( Timed (..) , PlayErr (..) , PlayEnv (..) , convertEvent @@ -20,60 +14,24 @@ where import Control.Exception (Exception) import Control.Monad (foldM) import Control.Monad.Except (throwError) -import Dahdit.Midi.Osc (Datum (..), DatumType (..), IsDatum (..), Msg (..), Packet (..)) +import Dahdit.Midi.Osc (Datum (..), Msg (..), Packet (..)) import Dahdit.Midi.OscAddr (RawAddrPat) import Data.Foldable (foldl') -import Data.Int (Int32, Int64) -import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Sequence (Seq (..)) import Data.Sequence qualified as Seq import Data.Text (Text) +import Minipat.Dirt.Attrs (Attrs, IsAttrs (..)) import Minipat.Stream (Ev (..), Tape, tapeToList) import Minipat.Time (CycleDelta (..), CycleTime (..), Span, spanCycle, spanDelta) import Nanotime (PosixTime, TimeDelta (..), addTime, timeDeltaFromFracSecs, timeDeltaToNanos) -data DatumProxy a where - DatumProxyInt32 :: DatumProxy Int32 - DatumProxyInt64 :: DatumProxy Int64 - DatumProxyFloat :: DatumProxy Float - DatumProxyDouble :: DatumProxy Double - DatumProxyString :: DatumProxy Text - -datumProxyType :: DatumProxy a -> DatumType -datumProxyType = \case - DatumProxyInt32 -> DatumTypeInt32 - DatumProxyInt64 -> DatumTypeInt64 - DatumProxyFloat -> DatumTypeFloat - DatumProxyDouble -> DatumTypeDouble - DatumProxyString -> DatumTypeString - data Timed a = Timed { timedKey :: !PosixTime , timedVal :: !a } deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) -type Attrs = Map Text Datum - -attrs :: [(Text, Datum)] -> Attrs -attrs = Map.fromList - -class IsAttrs a where - toAttrs :: a -> Attrs - -instance IsAttrs Attrs where - toAttrs = id - -data Attr a = Attr - { attrKey :: !Text - , attrVal :: !a - } - deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) - -instance (IsDatum a) => IsAttrs (Attr a) where - toAttrs (Attr k v) = Map.singleton k (toDatum v) - namedPayload :: Attrs -> Seq Datum namedPayload = foldl' go Empty . Map.toList where @@ -119,7 +77,7 @@ playAliases = , ("bpq", "bandq") , ("res", "resonance") , ("midi", "midinote") - , ("n", "midinote") + , ("n", "note") , ("oct", "octave") , ("accel", "accelerate") , ("leg", "legato") diff --git a/minipat-dirt/src/Minipat/Dirt/Parser.hs b/minipat-dirt/src/Minipat/Dirt/Parser.hs index 58e1d63..34fdaa3 100644 --- a/minipat-dirt/src/Minipat/Dirt/Parser.hs +++ b/minipat-dirt/src/Minipat/Dirt/Parser.hs @@ -15,8 +15,8 @@ import Data.Text (Text) import Data.Text qualified as T import Looksee qualified as L import Minipat.Ast (Ident (..), Pattern (..), Select (..)) +import Minipat.Dirt.Attrs (Attr (..), Attrs, DatumProxy (..), attrs) import Minipat.Dirt.Notes -import Minipat.Dirt.Osc (Attr (..), Attrs, DatumProxy (..), attrs) import Minipat.Eval (evalPat) import Minipat.Parser (P, identP, selectP) diff --git a/minipat-dirt/src/Minipat/Dirt/Prelude.hs b/minipat-dirt/src/Minipat/Dirt/Prelude.hs index 286af04..fb4e27b 100644 --- a/minipat-dirt/src/Minipat/Dirt/Prelude.hs +++ b/minipat-dirt/src/Minipat/Dirt/Prelude.hs @@ -4,7 +4,7 @@ module Minipat.Dirt.Prelude where import Data.Int (Int32) import Data.Text (Text) -import Minipat.Dirt.Osc (Attr (..), Attrs, DatumProxy, IsAttrs (..)) +import Minipat.Dirt.Attrs (Attr (..), Attrs, DatumProxy, IsAttrs (..)) import Minipat.Dirt.Parser (datumPat, notePat, soundPat) import Minipat.Stream (Stream (..), streamInnerBind) diff --git a/minipat-dirt/src/Minipat/Dirt/Test.hs b/minipat-dirt/src/Minipat/Dirt/Test.hs index 84ab642..209f2ab 100644 --- a/minipat-dirt/src/Minipat/Dirt/Test.hs +++ b/minipat-dirt/src/Minipat/Dirt/Test.hs @@ -8,6 +8,7 @@ import Dahdit.Midi.Osc (Datum (..)) import Data.Foldable (for_) import Data.Ratio ((%)) import Data.Sequence (Seq) +import Minipat.Dirt.Attrs (Attrs, attrs) import Minipat.Dirt.Core ( OscConn , Resources (..) @@ -19,7 +20,7 @@ import Minipat.Dirt.Core , setTempo , withSt ) -import Minipat.Dirt.Osc (Attrs, PlayEnv (..), PlayErr, Timed (..), attrs, convertTape, handshakePacket, playPacket) +import Minipat.Dirt.Osc (PlayEnv (..), PlayErr, Timed (..), convertTape, handshakePacket, playPacket) import Minipat.Stream (Ev (..), streamFastBy, tapeSingleton) import Minipat.Time (Arc (..), Span (..)) import Nanotime (TimeLike (..), threadDelayDelta, timeDeltaFromFracSecs)