module CsoundExpr.Translator.Types (
Time, Dur,
Id,
ExprLayer, LaExpr,
mkLayer, layerOut, layerOp, layerIn,
GlobalInits,
FtableId, FtableInfo,
Instr, MidiInstr, InstrOrder, InstrOrderInfo,
Note, ValueId,
SignalOut(..), outList, fromSignalOut,
Header, SignalInit(..),
Arate(..), Krate(..), Irate(..), X(..), K(..), MO(..),
BoolRate(..),
toValue, toCsRate, gRate, isArgOut
)
where
import qualified Data.Set as Set
import qualified Data.Map as Map
import CsoundExpr.Translator.ExprTree.ExprTree
import CsoundExpr.Translator.Cs.IM
import qualified CsoundExpr.Translator.Cs.CsTree as La
import qualified CsoundExpr.Translator.Cs.CsoundFile as Cs
import CsoundExpr.Translator.Cs.CsBoolean
type Time = Double
type Dur = Time
type LaExpr = Expr La.Label La.Rate La.CsExpr
type ExprLayer a b c = (a, (b, [c]))
layerOut (a, (b, c)) = a
layerOp (a, (b, c)) = b
layerIn (a, (b, c)) = c
mkLayer a b c = (a, (b, c))
type GlobalInits = Set.Set (La.Name, La.Rate)
type FtableId = (Purity Id, La.Ftable)
type FtableInfo = Map.Map FtableId Id
type Instr = [La.CsTree]
type MidiInstr = Instr
type InstrOrder = [Instr]
type InstrOrderInfo = Map.Map Instr Id
type Note = (Time, Time, [ValueId])
type ValueId = (Purity Id, La.Value)
data Arate = Arate La.CsTree
data Krate = Krate La.CsTree
data Irate = Irate La.CsTree
data BoolRate = BoolRate CsBool
instance IM La.CsTree Arate where
from = Arate . mapType (const [La.A])
to (Arate t) = t
instance IM La.CsTree Krate where
from = Krate . mapType (const [La.K])
to (Krate t) = t
instance IM La.CsTree Irate where
from = Irate . mapType (const [La.I])
to (Irate t) = t
instance IM La.CsTree String where
from x = error "from string is undefined"
to = La.string
class MO a where
rateMO :: [La.Rate] -> a -> a
instance MO Arate where
rateMO rs (Arate x) = Arate $ mapType (const rs) x
instance MO Krate where
rateMO rs (Krate x) = Krate $ mapType (const rs) x
instance MO Irate where
rateMO rs (Irate x) = Irate $ mapType (const rs) x
class (IM La.CsTree a, MO a) => X a where
arate :: a -> Arate
krate :: a -> Krate
irate :: a -> Irate
class X a => K a
instance X Arate where
arate = id
krate = from . pure (La.opc "downsamp") . return . toCsTree
irate = from . pure (La.opr ["i(", ")"]) . return . toCsTree . krate
instance X Krate where
arate = from . pure (La.opc "upsamp") . return . toCsTree
krate = id
irate = from . pure (La.opr ["i(", ")"]) . return . toCsTree
instance X Irate where
arate = from . pure (La.opc "upsamp") . return . toCsTree
krate = from . pure (La.opr ["k(", ")"]) . return . toCsTree
irate = id
toCsTree :: X a => a -> La.CsTree
toCsTree = to
instance K Krate
instance K Irate
data SignalOut = SignalOut Instr
deriving (Eq, Ord)
outList :: [SignalOut] -> SignalOut
outList = SignalOut . (fromSignalOut =<< )
fromSignalOut :: SignalOut -> Instr
fromSignalOut (SignalOut x) = x
type Header = [SignalInit]
data SignalInit = Instr0 SignalOut
| Massign [Int] Int SignalOut
| Pgmassign [Int] Int SignalOut
| InstrOrder [SignalOut]
deriving (Eq, Ord)
isArgOut :: ExprLayer Int LaExpr Int -> Bool
isArgOut x = (not $ null $ layerIn x) && (La.isArg $ exprOp $ exprTag $ layerOp x)
toValue :: La.Value -> Cs.Value
toValue x = case x of
(La.ValueDouble v) -> Cs.ValueDouble v
(La.ValueString v) -> Cs.ValueString v
(La.ValueInt v) -> Cs.ValueInt v
toCsRate :: La.Rate -> Cs.Rate
toCsRate x =
case x of
La.A -> Cs.A
La.K -> Cs.K
La.I -> Cs.I
La.S -> Cs.S
La.GA -> Cs.GA
La.GK -> Cs.GK
La.GI -> Cs.GI
La.GS -> Cs.GS
La.SetupRate -> Cs.SetupRate
gRate :: Cs.Rate -> Cs.Rate
gRate x = case x of
Cs.A -> Cs.GA
Cs.K -> Cs.GK
Cs.I -> Cs.GI