-- | Constant
module Sound.Sc3.Ugen.Constant where

import Sound.Sc3.Ugen.Brackets {- hsc3 -}

{- | Constants.
Constants may have brackets.
This allows for buffer allocation and deallocation to be associated with a buffer identifier.

> Constant 3 == Constant 3
> (Constant 3 > Constant 1) == True
-}
data Constant =
  Constant
  {Constant -> Double
constantValue :: Double
  ,Constant -> Brackets
constantBrackets :: Brackets}
  deriving (Eq Constant
Constant -> Constant -> Bool
Constant -> Constant -> Ordering
Constant -> Constant -> Constant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constant -> Constant -> Constant
$cmin :: Constant -> Constant -> Constant
max :: Constant -> Constant -> Constant
$cmax :: Constant -> Constant -> Constant
>= :: Constant -> Constant -> Bool
$c>= :: Constant -> Constant -> Bool
> :: Constant -> Constant -> Bool
$c> :: Constant -> Constant -> Bool
<= :: Constant -> Constant -> Bool
$c<= :: Constant -> Constant -> Bool
< :: Constant -> Constant -> Bool
$c< :: Constant -> Constant -> Bool
compare :: Constant -> Constant -> Ordering
$ccompare :: Constant -> Constant -> Ordering
Ord, Constant -> Constant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constant -> Constant -> Bool
$c/= :: Constant -> Constant -> Bool
== :: Constant -> Constant -> Bool
$c== :: Constant -> Constant -> Bool
Eq, ReadPrec [Constant]
ReadPrec Constant
Int -> ReadS Constant
ReadS [Constant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constant]
$creadListPrec :: ReadPrec [Constant]
readPrec :: ReadPrec Constant
$creadPrec :: ReadPrec Constant
readList :: ReadS [Constant]
$creadList :: ReadS [Constant]
readsPrec :: Int -> ReadS Constant
$creadsPrec :: Int -> ReadS Constant
Read, Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constant] -> ShowS
$cshowList :: [Constant] -> ShowS
show :: Constant -> String
$cshow :: Constant -> String
showsPrec :: Int -> Constant -> ShowS
$cshowsPrec :: Int -> Constant -> ShowS
Show)