{-# Language CPP #-}
module Csound.Typed.Gui.Types (
Props(..),
Prop(..), BorderType(..), Color,
Rect(..), FontType(..), Emphasis(..),
Material(..), Orient(..), LabelType(..),
ScaleFactor,
ValDiap(..), ValStep, ValScaleType(..), ValSpan(..),
linSpan, expSpan, uspan, bspan, uspanExp,
KnobType(..),
SliderType(..),
TextType(..),
BoxType(..),
ButtonType(..),
defFontSize,
PropCtx(..), setPropCtx, getLabel
) where
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Control.Applicative(Alternative(..))
import Data.Default
import Data.Colour
import Csound.Typed.Gui.BoxModel(Rect(..))
type Color = Colour Double
data Orient = Hor | Ver
data ValSpan = ValSpan
{ valSpanDiap :: ValDiap
, valSpanScale :: ValScaleType }
linSpan :: Double -> Double -> ValSpan
linSpan a b = ValSpan (ValDiap a b) Linear
expSpan :: Double -> Double -> ValSpan
expSpan a b = ValSpan (ValDiap (checkBound a) b) Exponential
where
checkBound x
| x <= 0 = 0.00001
| otherwise = x
uspan :: ValSpan
uspan = linSpan 0 1
bspan :: ValSpan
bspan = linSpan (-1) 1
uspanExp :: ValSpan
uspanExp = linSpan 0 1
data ValDiap = ValDiap
{ valDiapMin :: Double
, valDiapMax :: Double }
data ValScaleType = Linear | Exponential
type ValStep = Double
data FontType = Helvetica | Courier | Times | Symbol | Screen | Dingbats
data Emphasis = NoEmphasis | Italic | Bold | BoldItalic
data KnobType = ThreeD (Maybe Int) | Pie | Clock | Flat
data SliderType = Fill | Engraved | Nice
data TextType = NormalText | NoDrag | NoEdit
data Material = NoPlastic | Plastic
data LabelType = NormalLabel | NoLabel | SymbolLabel
| ShadowLabel | EngravedLabel | EmbossedLabel
data BoxType
= FlatBox
| UpBox
| DownBox
| ThinUpBox
| ThinDownBox
| EngravedBox
| EmbossedBox
| BorderBox
| ShadowBox
| Roundedbox
| RoundedShadowBox
| RoundedFlatBox
| RoundedUpBox
| RoundedDownBox
| DiamondUpBox
| DiamondDownBox
| OvalBox
| OvalShadowBox
| OvalFlatBox
deriving (Enum)
data BorderType
= NoBorder
| DownBoxBorder
| UpBoxBorder
| EngravedBorder
| EmbossedBorder
| BlackLine
| ThinDown
| ThinUp
deriving (Enum)
data ButtonType = NormalButton | LightButton | CheckButton | RoundButton
defFontSize :: Int
defFontSize = 15
instance Default FontType where def = Courier
instance Default Emphasis where def = NoEmphasis
instance Default SliderType where def = Fill
instance Default KnobType where def = Flat
instance Default TextType where def = NormalText
instance Default ButtonType where def = NormalButton
instance Default BoxType where def = FlatBox
instance Default Material where def = Plastic
instance Default LabelType where def = NormalLabel
data Props = Props
{ propsBorder :: Maybe BorderType
, propsScaleFactor :: Maybe ScaleFactor
, otherProps :: [Prop] }
type ScaleFactor = (Double, Double)
#if MIN_VERSION_base(4,11,0)
instance Semigroup Props where
(<>) = mappendProps
instance Monoid Props where
mempty = def
#else
instance Monoid Props where
mempty = def
mappend = mappendProps
#endif
mappendProps :: Props -> Props -> Props
mappendProps a b = Props { propsBorder = propsBorder a <|> propsBorder b
, propsScaleFactor = propsScaleFactor a <|> propsScaleFactor b
, otherProps = mappend (otherProps a) (otherProps b) }
instance Default Props where
def = Props Nothing Nothing []
data Prop
= SetLabel String
| SetMaterial Material
| SetBoxType BoxType
| SetColor1 Color | SetColor2 Color | SetTextColor Color
| SetFontSize Int | SetFontType FontType | SetEmphasis Emphasis
| SetSliderType SliderType
| SetTextType TextType
| SetButtonType ButtonType
| SetOrient Orient
| SetKnobType KnobType
| SetLabelType LabelType
data PropCtx = PropCtx
{ ctxLabel :: Maybe String
, ctxMaterial :: Maybe Material
, ctxLabelType :: Maybe LabelType
, ctxBoxType :: Maybe BoxType
, ctxColor1 :: Maybe Color
, ctxColor2 :: Maybe Color
, ctxTextColor :: Maybe Color
, ctxFontSize :: Maybe Int
, ctxFontType :: Maybe FontType
, ctxEmphasis :: Maybe Emphasis
, ctxOrient :: Maybe Orient
, ctxSliderType :: Maybe SliderType
, ctxButtonType :: Maybe ButtonType
, ctxTextType :: Maybe TextType
, ctxKnobType :: Maybe KnobType }
instance Default PropCtx where
def = PropCtx Nothing Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing
setPropCtx :: Prop -> PropCtx -> PropCtx
setPropCtx p x = case p of
SetLabel a -> x { ctxLabel = Just a }
SetMaterial a -> x { ctxMaterial = Just a }
SetLabelType a -> x { ctxLabelType = Just a }
SetBoxType a -> x { ctxBoxType = Just a }
SetColor1 a -> x { ctxColor1 = Just a }
SetColor2 a -> x { ctxColor2 = Just a }
SetTextColor a -> x { ctxTextColor = Just a }
SetFontSize a -> x { ctxFontSize = Just a }
SetFontType a -> x { ctxFontType = Just a }
SetEmphasis a -> x { ctxEmphasis = Just a }
SetOrient a -> x { ctxOrient = Just a }
SetSliderType a -> x { ctxSliderType = Just a }
SetButtonType a -> x { ctxButtonType = Just a }
SetTextType a -> x { ctxTextType = Just a }
SetKnobType a -> x { ctxKnobType = Just a }
getLabel :: PropCtx -> String
getLabel = maybe "" id . ctxLabel