module Csound.Exp(
E, RatedExp(..), RatedVar(..), onExp, Exp, toPrimOr, PrimOr(..), MainExp(..), Name,
VarType(..), Var(..), Info(..), OpcType(..), Rate(..),
Signature(..), isProcedure, isInfix, isPrefix,
Prim(..), LowTab(..), Tab(..), TabSize(..), TabArgs(..), TabMap,
Inline(..), InlineExp(..), PreInline(..),
BoolExp, CondInfo, CondOp(..), isTrue, isFalse,
NumExp, NumOp(..), Msg(..), Note, Event(..), eventEnd,
) where
import Control.Applicative
import Data.Monoid
import Data.Traversable
import Data.Foldable hiding (concat)
import Data.Default
import Data.Map(Map)
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Data.Fix
type E = Fix RatedExp
type Name = String
data RatedExp a = RatedExp
{ ratedExpRate :: Maybe Rate
, ratedExpDepends :: Maybe a
, ratedExpExp :: Exp a
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data RatedVar = RatedVar
{ ratedVarRate :: Rate
, ratedVarId :: Int
} deriving (Show)
onExp :: (Exp a -> Exp a) -> RatedExp a -> RatedExp a
onExp f a = a{ ratedExpExp = f (ratedExpExp a) }
data VarType = LocalVar | GlobalVar
deriving (Show, Eq, Ord)
type Exp a = MainExp (PrimOr a)
toPrimOr :: E -> PrimOr E
toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of
ExpPrim (PString _) -> Right a
ExpPrim p -> Left p
_ -> Right a
newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }
deriving (Show, Eq, Ord, Functor)
data MainExp a
= ExpPrim Prim
| Tfm Info [a]
| ConvertRate Rate Rate a
| Select Rate Int a
| If (CondInfo a) a a
| ExpBool (BoolExp a)
| ExpNum (NumExp a)
| ReadVar Var
| WriteVar Var a
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data Var
= Var
{ varType :: VarType
, varRate :: Rate
, varName :: Name }
| VarVerbatim
{ varRate :: Rate
, varName :: Name
} deriving (Show, Eq, Ord)
data Info = Info
{ infoName :: Name
, infoSignature :: Signature
, infoOpcType :: OpcType
, infoNextSE :: Maybe Int
} deriving (Show, Eq, Ord)
isPrefix, isInfix, isProcedure :: Info -> Bool
isPrefix = (Prefix ==) . infoOpcType
isInfix = (Infix ==) . infoOpcType
isProcedure = (Procedure ==) . infoOpcType
data OpcType = Prefix | Infix | Procedure
deriving (Show, Eq, Ord)
data Rate = Xr | Ar | Kr | Ir | Sr | Fr
deriving (Show, Eq, Ord, Enum, Bounded)
data Signature
= SingleRate (Map Rate [Rate])
| MultiRate
{ outMultiRate :: [Rate]
, inMultiRate :: [Rate] }
deriving (Show, Eq, Ord)
data Prim
= P Int
| PString Int
| PrimInt Int
| PrimDouble Double
| PrimTab (Either Tab LowTab)
| PrimString String
deriving (Show, Eq, Ord)
type TabMap = M.Map LowTab Int
data LowTab = LowTab
{ lowTabSize :: Int
, lowTabGen :: Int
, lowTabArgs :: [Double]
} deriving (Show, Eq, Ord)
data Tab
= TabExp E
| Tab
{ tabSize :: TabSize
, tabGen :: Int
, tabArgs :: TabArgs
} deriving (Show, Eq, Ord)
instance Default TabSize where
def = SizeDegree
{ hasGuardPoint = False
, sizeDegree = 0 }
data TabSize
= SizePlain Int
| SizeDegree
{ hasGuardPoint :: Bool
, sizeDegree :: Int
} deriving (Show, Eq, Ord)
data TabArgs
= ArgsPlain [Double]
| ArgsRelative [Double]
deriving (Show, Eq, Ord)
data Msg = Msg
type Note = [Prim]
data Event a = Event
{ eventStart :: Double
, eventDur :: Double
, eventContent :: a }
eventEnd e = eventStart e + eventDur e
instance Functor Event where
fmap f a = a{ eventContent = f $ eventContent a }
data Inline a b = Inline
{ inlineExp :: InlineExp a
, inlineEnv :: IM.IntMap b
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data InlineExp a
= InlinePrim Int
| InlineExp a [InlineExp a]
deriving (Show, Eq, Ord)
data PreInline a b = PreInline a [b]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a
data CondOp
= TrueOp | FalseOp | Not | And | Or
| Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
deriving (Show, Eq, Ord)
isTrue, isFalse :: CondInfo a -> Bool
isTrue = isCondOp TrueOp
isFalse = isCondOp FalseOp
isCondOp op = maybe False (op == ) . getCondInfoOp
getCondInfoOp :: CondInfo a -> Maybe CondOp
getCondInfoOp x = case inlineExp x of
InlineExp op _ -> Just op
_ -> Nothing
type NumExp a = PreInline NumOp a
data NumOp
= Add | Sub | Neg | Mul | Div
| Pow | Mod
| Sin | Cos | Sinh | Cosh | Tan | Tanh | Sininv | Cosinv | Taninv
| Ceil | Floor | Frac | Round | IntOp
| Abs | ExpOp | Log | Log10 | Logbtwo | Sqrt
| Ampdb | Ampdbfs | Dbamp | Dbfsamp
| Cent | Cpsmidinn | Cpsoct | Cpspch | Octave | Octcps | Octmidinn | Octpch | Pchmidinn | Pchoct | Semitone
deriving (Show, Eq, Ord)
instance Foldable PrimOr where foldMap = foldMapDefault
instance Traversable PrimOr where
traverse f x = case unPrimOr x of
Left p -> pure $ PrimOr $ Left p
Right a -> PrimOr . Right <$> f a