{-# 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(..))
import Data.Text (Text)

-- | The Csound colours.
type Color = Colour Double

-- | The orientation of the widget (slider, roller). This property is
-- never needs to be set in practice. If this property is not set then
-- default orientation is calculated from the bounding box of the widget.
-- If the width is greater than the height then we need to use a horizontal
-- widget otherwise it should be a vertical one.
data Orient = Hor | Ver

-- | A value span is a diapason of the value and a type
-- of the scale (can be linear or exponential).
data ValSpan = ValSpan
    { ValSpan -> ValDiap
valSpanDiap  :: !ValDiap
    , ValSpan -> ValScaleType
valSpanScale :: !ValScaleType }

-- | Makes a linear @ValSpan@ with specified boundaries.
--
-- > linSpan minVal maxVal
linSpan :: Double -> Double -> ValSpan
linSpan :: Double -> Double -> ValSpan
linSpan Double
a Double
b = ValDiap -> ValScaleType -> ValSpan
ValSpan (Double -> Double -> ValDiap
ValDiap Double
a Double
b) ValScaleType
Linear

-- | Makes an exponential @ValSpan@ with specified boundaries.
--
-- > expSpan minVal maxVal
expSpan :: Double -> Double -> ValSpan
expSpan :: Double -> Double -> ValSpan
expSpan Double
a Double
b = ValDiap -> ValScaleType -> ValSpan
ValSpan (Double -> Double -> ValDiap
ValDiap (Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
checkBound Double
a) Double
b) ValScaleType
Exponential
    where
        checkBound :: a -> a
checkBound a
x
            | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = a
0.00001
            | Bool
otherwise = a
x

-- | Unit span. A special case:
--
-- > uspan = linSpan 0 1
uspan :: ValSpan
uspan :: ValSpan
uspan = Double -> Double -> ValSpan
linSpan Double
0 Double
1

-- | Bipolar unit span. A special case:
--
-- > uspan = linSpan (-1) 1
bspan :: ValSpan
bspan :: ValSpan
bspan = Double -> Double -> ValSpan
linSpan (-Double
1) Double
1

-- | An exponential unit span. A special case:
--
-- > uspan = expSpan 0 1
uspanExp :: ValSpan
uspanExp :: ValSpan
uspanExp = Double -> Double -> ValSpan
linSpan Double
0 Double
1

-- | The diapason of the continuous value.
data ValDiap = ValDiap
    { ValDiap -> Double
valDiapMin   :: Double
    , ValDiap -> 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

-- | The type of the material of the element. It affects sliders and buttons.
data Material       = NoPlastic | Plastic

-- | Some values are not implemented on the Csound level.
data LabelType      = NormalLabel | NoLabel | SymbolLabel
                    | ShadowLabel | EngravedLabel | EmbossedLabel

-- | The type of the box. Some values are not implemented on the Csound level.
data BoxType
    = FlatBox
    | UpBox
    | DownBox
    | ThinUpBox
    | ThinDownBox
    | EngravedBox
    | EmbossedBox
    | BorderBox
    | ShadowBox
    | Roundedbox
    | RoundedShadowBox
    | RoundedFlatBox
    | RoundedUpBox
    | RoundedDownBox
    | DiamondUpBox
    | DiamondDownBox
    | OvalBox
    | OvalShadowBox
    | OvalFlatBox
    deriving (Int -> BoxType
BoxType -> Int
BoxType -> [BoxType]
BoxType -> BoxType
BoxType -> BoxType -> [BoxType]
BoxType -> BoxType -> BoxType -> [BoxType]
(BoxType -> BoxType)
-> (BoxType -> BoxType)
-> (Int -> BoxType)
-> (BoxType -> Int)
-> (BoxType -> [BoxType])
-> (BoxType -> BoxType -> [BoxType])
-> (BoxType -> BoxType -> [BoxType])
-> (BoxType -> BoxType -> BoxType -> [BoxType])
-> Enum BoxType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BoxType -> BoxType
succ :: BoxType -> BoxType
$cpred :: BoxType -> BoxType
pred :: BoxType -> BoxType
$ctoEnum :: Int -> BoxType
toEnum :: Int -> BoxType
$cfromEnum :: BoxType -> Int
fromEnum :: BoxType -> Int
$cenumFrom :: BoxType -> [BoxType]
enumFrom :: BoxType -> [BoxType]
$cenumFromThen :: BoxType -> BoxType -> [BoxType]
enumFromThen :: BoxType -> BoxType -> [BoxType]
$cenumFromTo :: BoxType -> BoxType -> [BoxType]
enumFromTo :: BoxType -> BoxType -> [BoxType]
$cenumFromThenTo :: BoxType -> BoxType -> BoxType -> [BoxType]
enumFromThenTo :: BoxType -> BoxType -> BoxType -> [BoxType]
Enum)

data BorderType
    = NoBorder
    | DownBoxBorder
    | UpBoxBorder
    | EngravedBorder
    | EmbossedBorder
    | BlackLine
    | ThinDown
    | ThinUp
    deriving (Int -> BorderType
BorderType -> Int
BorderType -> [BorderType]
BorderType -> BorderType
BorderType -> BorderType -> [BorderType]
BorderType -> BorderType -> BorderType -> [BorderType]
(BorderType -> BorderType)
-> (BorderType -> BorderType)
-> (Int -> BorderType)
-> (BorderType -> Int)
-> (BorderType -> [BorderType])
-> (BorderType -> BorderType -> [BorderType])
-> (BorderType -> BorderType -> [BorderType])
-> (BorderType -> BorderType -> BorderType -> [BorderType])
-> Enum BorderType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BorderType -> BorderType
succ :: BorderType -> BorderType
$cpred :: BorderType -> BorderType
pred :: BorderType -> BorderType
$ctoEnum :: Int -> BorderType
toEnum :: Int -> BorderType
$cfromEnum :: BorderType -> Int
fromEnum :: BorderType -> Int
$cenumFrom :: BorderType -> [BorderType]
enumFrom :: BorderType -> [BorderType]
$cenumFromThen :: BorderType -> BorderType -> [BorderType]
enumFromThen :: BorderType -> BorderType -> [BorderType]
$cenumFromTo :: BorderType -> BorderType -> [BorderType]
enumFromTo :: BorderType -> BorderType -> [BorderType]
$cenumFromThenTo :: BorderType -> BorderType -> BorderType -> [BorderType]
enumFromThenTo :: BorderType -> BorderType -> BorderType -> [BorderType]
Enum)

-- | The type of the button. It affects toggle buttons and button banks.
--
-- In Csound buttons and toggle buttons
-- are constructed with the same function (but with different button types).
-- But in this library they are contructed by different functions (@button@ and @toggle@).
-- Normal button is a plain old button, but other values specify toggle buttons.
-- So this property doesn't affect the buttons (since they could be only normal buttons).
data ButtonType = NormalButton | LightButton | CheckButton | RoundButton

defFontSize :: Int
defFontSize :: Int
defFontSize = Int
15

instance Default FontType       where def :: FontType
def = FontType
Courier
instance Default Emphasis       where def :: Emphasis
def = Emphasis
NoEmphasis
instance Default SliderType     where def :: SliderType
def = SliderType
Fill
instance Default KnobType       where def :: KnobType
def = KnobType
Flat
instance Default TextType       where def :: TextType
def = TextType
NormalText
instance Default ButtonType     where def :: ButtonType
def = ButtonType
NormalButton
instance Default BoxType        where def :: BoxType
def = BoxType
FlatBox
instance Default Material       where def :: Material
def = Material
Plastic
instance Default LabelType      where def :: LabelType
def = LabelType
NormalLabel

data Props = Props
    { Props -> Maybe BorderType
propsBorder   :: Maybe BorderType
    , Props -> Maybe ScaleFactor
propsScaleFactor :: Maybe ScaleFactor
    , Props -> [Prop]
otherProps    :: [Prop] }

type ScaleFactor = (Double, Double)

#if MIN_VERSION_base(4,11,0)
instance Semigroup Props where
    <> :: Props -> Props -> Props
(<>) = Props -> Props -> Props
mappendProps

instance Monoid Props where
    mempty :: Props
mempty  = Props
forall a. Default a => a
def

#else

instance Monoid Props where
    mempty  = def
    mappend = mappendProps

#endif


mappendProps :: Props -> Props -> Props
mappendProps :: Props -> Props -> Props
mappendProps Props
a Props
b = Props { propsBorder :: Maybe BorderType
propsBorder = Props -> Maybe BorderType
propsBorder Props
a Maybe BorderType -> Maybe BorderType -> Maybe BorderType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Props -> Maybe BorderType
propsBorder Props
b
                    , propsScaleFactor :: Maybe ScaleFactor
propsScaleFactor = Props -> Maybe ScaleFactor
propsScaleFactor Props
a Maybe ScaleFactor -> Maybe ScaleFactor -> Maybe ScaleFactor
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Props -> Maybe ScaleFactor
propsScaleFactor Props
b
                    , otherProps :: [Prop]
otherProps  = [Prop] -> [Prop] -> [Prop]
forall a. Monoid a => a -> a -> a
mappend (Props -> [Prop]
otherProps Props
a) (Props -> [Prop]
otherProps Props
b) }

instance Default Props where
    def :: Props
def = Maybe BorderType -> Maybe ScaleFactor -> [Prop] -> Props
Props Maybe BorderType
forall a. Maybe a
Nothing Maybe ScaleFactor
forall a. Maybe a
Nothing []

-- | Properties of the widgets.
data Prop
    = SetLabel Text
    | 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

-----------------------------------------------------------
-- cascading context, here we group properties by type

data PropCtx = PropCtx
    { PropCtx -> Maybe Text
ctxLabel        :: Maybe Text
    , PropCtx -> Maybe Material
ctxMaterial     :: Maybe Material
    , PropCtx -> Maybe LabelType
ctxLabelType    :: Maybe LabelType
    , PropCtx -> Maybe BoxType
ctxBoxType      :: Maybe BoxType
    , PropCtx -> Maybe Color
ctxColor1       :: Maybe Color
    , PropCtx -> Maybe Color
ctxColor2       :: Maybe Color
    , PropCtx -> Maybe Color
ctxTextColor    :: Maybe Color
    , PropCtx -> Maybe Int
ctxFontSize     :: Maybe Int
    , PropCtx -> Maybe FontType
ctxFontType     :: Maybe FontType
    , PropCtx -> Maybe Emphasis
ctxEmphasis     :: Maybe Emphasis
    , PropCtx -> Maybe Orient
ctxOrient       :: Maybe Orient
    , PropCtx -> Maybe SliderType
ctxSliderType   :: Maybe SliderType
    , PropCtx -> Maybe ButtonType
ctxButtonType   :: Maybe ButtonType
    , PropCtx -> Maybe TextType
ctxTextType     :: Maybe TextType
    , PropCtx -> Maybe KnobType
ctxKnobType     :: Maybe KnobType }

instance Default PropCtx where
    def :: PropCtx
def = Maybe Text
-> Maybe Material
-> Maybe LabelType
-> Maybe BoxType
-> Maybe Color
-> Maybe Color
-> Maybe Color
-> Maybe Int
-> Maybe FontType
-> Maybe Emphasis
-> Maybe Orient
-> Maybe SliderType
-> Maybe ButtonType
-> Maybe TextType
-> Maybe KnobType
-> PropCtx
PropCtx Maybe Text
forall a. Maybe a
Nothing Maybe Material
forall a. Maybe a
Nothing Maybe LabelType
forall a. Maybe a
Nothing Maybe BoxType
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing
                  Maybe Color
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe FontType
forall a. Maybe a
Nothing Maybe Emphasis
forall a. Maybe a
Nothing Maybe Orient
forall a. Maybe a
Nothing Maybe SliderType
forall a. Maybe a
Nothing
                  Maybe ButtonType
forall a. Maybe a
Nothing Maybe TextType
forall a. Maybe a
Nothing Maybe KnobType
forall a. Maybe a
Nothing

setPropCtx :: Prop -> PropCtx -> PropCtx
setPropCtx :: Prop -> PropCtx -> PropCtx
setPropCtx Prop
p PropCtx
x = case Prop
p of
            SetLabel        Text
a -> PropCtx
x { ctxLabel  = Just a }
            SetMaterial     Material
a -> PropCtx
x { ctxMaterial = Just a }
            SetLabelType    LabelType
a -> PropCtx
x { ctxLabelType = Just a }
            SetBoxType      BoxType
a -> PropCtx
x { ctxBoxType = Just a }
            SetColor1       Color
a -> PropCtx
x { ctxColor1 = Just a }
            SetColor2       Color
a -> PropCtx
x { ctxColor2 = Just a }
            SetTextColor    Color
a -> PropCtx
x { ctxTextColor = Just a }
            SetFontSize     Int
a -> PropCtx
x { ctxFontSize = Just a }
            SetFontType     FontType
a -> PropCtx
x { ctxFontType = Just a }
            SetEmphasis     Emphasis
a -> PropCtx
x { ctxEmphasis = Just a }
            SetOrient       Orient
a -> PropCtx
x { ctxOrient = Just a }
            SetSliderType   SliderType
a -> PropCtx
x { ctxSliderType = Just a }
            SetButtonType   ButtonType
a -> PropCtx
x { ctxButtonType = Just a }
            SetTextType     TextType
a -> PropCtx
x { ctxTextType = Just a }
            SetKnobType     KnobType
a -> PropCtx
x { ctxKnobType = Just a }

getLabel :: PropCtx -> Text
getLabel :: PropCtx -> Text
getLabel = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
forall a. a -> a
id (Maybe Text -> Text) -> (PropCtx -> Maybe Text) -> PropCtx -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropCtx -> Maybe Text
ctxLabel