module Csound.Typed.Gui.Gui (
    Panel(..), Win(..), GuiNode(..), GuiHandle(..), Gui(..),
    Elem(..), InitMe(..),
    restoreTree, guiMap, mapGuiOnPanel, fromElem, fromGuiHandle,
    panelIsKeybdSensitive, defText,
    guiStmt,

    -- * Layout
    hor, ver, space, sca, horSca, verSca,
    padding, margin, ScaleFactor, resizeGui,
    -- * Props
    props, forceProps,
    Prop(..), BorderType(..), Color,
    Rect(..), FontType(..), Emphasis(..),
    Material(..), Orient(..), LabelType(..),
    -- ** Setters
    -- | Handy short-cuts for the function @props@.
    setBorder, setLabel, setMaterial, setLabelType,
    setColor1, setColor2, setColors, setTextColor,
    setFontSize, setFontType, setEmphasis, setOrient,

    -- * Widgets
    ValDiap(..), ValStep, ValScaleType(..), ValSpan(..),
    linSpan, expSpan, uspan, bspan, uspanExp,
    KnobType(..), setKnobType,
    SliderType(..), setSliderType,
    TextType(..), setTextType,
    BoxType(..), setBoxType,
    ButtonType(..), setButtonType
) where

import Prelude hiding(elem, span)
import Data.Text (Text)
import Data.Text qualified as Text

import Data.Default
import Data.Maybe(isNothing)
import Data.Monoid

import qualified Data.IntMap as IM
import Text.PrettyPrint.Leijen.Text (Doc)

import Csound.Dynamic(DepT, depT_, Var(..), VarType(..), Rate(..), noRate, MainExp(..), InstrId(..))

import qualified Text.PrettyPrint.Leijen.Text as P(int, double, vcat, empty, textStrict)
import qualified Csound.Typed.Gui.BoxModel as Box
import Csound.Typed.Constants(infiniteDur)

import Csound.Typed.Gui.Types
import Csound.Typed.Gui.Pretty

newtype GuiHandle = GuiHandle { GuiHandle -> Int
unGuiHandle :: Int }

-- | A visual representation of the GUI-element.
newtype Gui = Gui { Gui -> LowGui
unGui :: LowGui }

type LowGui = Box.Scene Props ElemWithOuts

data Panel
    = Single
        { Panel -> Win
singleContent :: Win
        , Panel -> Bool
singleIsKeybdSensitive :: Bool }
    | Tabs
        { Panel -> Text
tabsTitle     :: Text
        , Panel -> Maybe Rect
tabsRect      :: Maybe Rect
        , Panel -> [Win]
tabsContent   :: [Win]
        , Panel -> Bool
tabsIsKeybdSensitive :: Bool }

panelIsKeybdSensitive :: Panel -> Bool
panelIsKeybdSensitive :: Panel -> Bool
panelIsKeybdSensitive Panel
x = case Panel
x of
    Single Win
_ Bool
res -> Bool
res
    Tabs Text
_ Maybe Rect
_ [Win]
_ Bool
res -> Bool
res

data Win = Win
    { Win -> Text
winTitle :: Text
    , Win -> Maybe Rect
winRect  :: Maybe Rect
    , Win -> Gui
winGui   :: Gui }

data GuiNode = GuiNode
    { GuiNode -> Gui
guiNodeElem   :: Gui
    , GuiNode -> GuiHandle
guiNodeHandle :: GuiHandle }

data ElemWithOuts = ElemWithOuts
    { ElemWithOuts -> [Var]
elemOuts      :: [Var]
    , ElemWithOuts -> [InitMe]
elemInits     :: [InitMe]
    , ElemWithOuts -> Elem
elemContent   :: Elem }

data InitMe = InitMe
    { InitMe -> Var
initHandle :: Var
    , InitMe -> Double
initValue  :: Double }

data Elem
    = GuiVar GuiHandle

    -- valuators
    | Count  ValDiap ValStep (Maybe ValStep)
    | Joy    ValSpan ValSpan
    | Knob   ValSpan
    | Roller ValSpan ValStep
    | Slider ValSpan
    | Text   ValDiap ValStep

    -- other widgets
    | Box Text
    | ButBank Int Int
    | Button InstrId
    | Toggle
    | Value
    | Vkeybd

type ElemOuts = [Var]

defText :: Text -> Gui
defText :: Text -> Gui
defText Text
str = LowGui -> Gui
Gui (LowGui -> Gui) -> LowGui -> Gui
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> LowGui
forall ctx a. a -> Scene ctx a
Box.Prim ([Var] -> [InitMe] -> Elem -> ElemWithOuts
ElemWithOuts [VarType -> Rate -> Text -> Var
Var VarType
LocalVar Rate
Ir Text
"keybd"] [] (Elem -> ElemWithOuts) -> Elem -> ElemWithOuts
forall a b. (a -> b) -> a -> b
$ Text -> Elem
Box Text
str)

fromElem :: ElemOuts -> [InitMe] -> Elem -> Gui
fromElem :: [Var] -> [InitMe] -> Elem -> Gui
fromElem [Var]
outs [InitMe]
inits Elem
el = LowGui -> Gui
Gui (LowGui -> Gui) -> LowGui -> Gui
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> LowGui
forall a ctx. a -> Scene ctx a
Box.prim ([Var] -> [InitMe] -> Elem -> ElemWithOuts
ElemWithOuts [Var]
outs [InitMe]
inits Elem
el)

fromGuiHandle :: GuiHandle -> Gui
fromGuiHandle :: GuiHandle -> Gui
fromGuiHandle = LowGui -> Gui
Gui (LowGui -> Gui) -> (GuiHandle -> LowGui) -> GuiHandle -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemWithOuts -> LowGui
forall a ctx. a -> Scene ctx a
Box.prim (ElemWithOuts -> LowGui)
-> (GuiHandle -> ElemWithOuts) -> GuiHandle -> LowGui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Var] -> [InitMe] -> Elem -> ElemWithOuts
ElemWithOuts [] [] (Elem -> ElemWithOuts)
-> (GuiHandle -> Elem) -> GuiHandle -> ElemWithOuts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GuiHandle -> Elem
GuiVar

mapGuiOnPanel :: (Gui -> Gui) -> Panel -> Panel
mapGuiOnPanel :: (Gui -> Gui) -> Panel -> Panel
mapGuiOnPanel Gui -> Gui
f Panel
x = case Panel
x of
    Single Win
w Bool
isKey            -> Win -> Bool -> Panel
Single (Win -> Win
mapWin Win
w) Bool
isKey
    Tabs Text
title Maybe Rect
rect [Win]
ws  Bool
isKey -> Text -> Maybe Rect -> [Win] -> Bool -> Panel
Tabs Text
title Maybe Rect
rect ((Win -> Win) -> [Win] -> [Win]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Win -> Win
mapWin [Win]
ws) Bool
isKey
    where mapWin :: Win -> Win
mapWin Win
a = Win
a{ winGui = f $ winGui a  }

onLowGuis :: ([LowGui] -> LowGui) -> ([Gui] -> Gui)
onLowGuis :: ([LowGui] -> LowGui) -> [Gui] -> Gui
onLowGuis [LowGui] -> LowGui
f = LowGui -> Gui
Gui (LowGui -> Gui) -> ([Gui] -> LowGui) -> [Gui] -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LowGui] -> LowGui
f ([LowGui] -> LowGui) -> ([Gui] -> [LowGui]) -> [Gui] -> LowGui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gui -> LowGui) -> [Gui] -> [LowGui]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gui -> LowGui
unGui

onLowGui1 :: (LowGui -> LowGui) -> (Gui -> Gui)
onLowGui1 :: (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 LowGui -> LowGui
f = LowGui -> Gui
Gui (LowGui -> Gui) -> (Gui -> LowGui) -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LowGui -> LowGui
f (LowGui -> LowGui) -> (Gui -> LowGui) -> Gui -> LowGui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gui -> LowGui
unGui

-- | Horizontal groupping of the elements. All elements are
-- placed in the stright horizontal line and aligned by Y-coordinate
-- and height.
hor :: [Gui] -> Gui
hor :: [Gui] -> Gui
hor = ([LowGui] -> LowGui) -> [Gui] -> Gui
onLowGuis [LowGui] -> LowGui
forall a b. [Scene a b] -> Scene a b
Box.hor

-- | Vertical groupping of the elements. All elements are
-- placed in the stright vertical line and aligned by X-coordinate
-- and width.
ver :: [Gui] -> Gui
ver :: [Gui] -> Gui
ver = ([LowGui] -> LowGui) -> [Gui] -> Gui
onLowGuis [LowGui] -> LowGui
forall a b. [Scene a b] -> Scene a b
Box.ver

-- | An empty space.
space :: Gui
space :: Gui
space = LowGui -> Gui
Gui LowGui
forall a b. Scene a b
Box.space

-- | Scales an element within the group. It depends on the type
-- of the alignment (horizontal or vertical) which side of the bounding
-- box is scaled. If it's a horizontal group then the width is scaled
-- and height is scaled otherwise.
--
-- Every element in the group has a scaling factor. By
-- default it equals to one. During rendering all scaling factors are summed
-- and divided on the sum of all factors. So that factors become weights
-- or proportions. This process is called normalization.
-- Scaling one element affects not only this element but
-- all other elements in the group!
--
-- An example:
--
-- One element is twice as large as the other two:
--
-- > hor [a, b, sca 2 c]
--
-- Why is it so? Let's look at the hidden scaling factors:
--
-- > hor [sca 1 a, sca 1 b, sca 2 c]
--
-- During rendering we scale all the scaling fators so that
-- total sum equals to one:
--
-- > hor [sca 0.25 a, sca 0.25 b, sca 0.5 c]
sca :: Double -> Gui -> Gui
sca :: Double -> Gui -> Gui
sca Double
d = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Double -> LowGui -> LowGui
forall a b. Double -> Scene a b -> Scene a b
Box.sca Double
d)

-- | Weighted horizontal grouping.
-- It takes a list of scaling factors and elements.
horSca :: [(Double, Gui)] -> Gui
horSca :: [(Double, Gui)] -> Gui
horSca [(Double, Gui)]
ps = [Gui] -> Gui
hor ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ ((Double, Gui) -> Gui) -> [(Double, Gui)] -> [Gui]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Gui -> Gui) -> (Double, Gui) -> Gui
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Gui -> Gui
sca) [(Double, Gui)]
ps

-- | Weighted vertical grouping.
-- It takes a list of scaling factors and elements.
verSca :: [(Double, Gui)] -> Gui
verSca :: [(Double, Gui)] -> Gui
verSca [(Double, Gui)]
ps = [Gui] -> Gui
ver ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ ((Double, Gui) -> Gui) -> [(Double, Gui)] -> [Gui]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Gui -> Gui) -> (Double, Gui) -> Gui
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Gui -> Gui
sca) [(Double, Gui)]
ps

-- | Sets the padding of the element. How much empty space
-- to reserve outside the element.
padding :: Int -> Gui -> Gui
padding :: Int -> Gui -> Gui
padding Int
n = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Int -> LowGui -> LowGui
forall a b. Int -> Scene a b -> Scene a b
Box.padding Int
n)

-- | Sets the margin of the element. How much empty space
-- to reserve between the elements within the group. It affects
-- only compound elements.
margin :: Int -> Gui -> Gui
margin :: Int -> Gui -> Gui
margin Int
n = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Int -> LowGui -> LowGui
forall a b. Int -> Scene a b -> Scene a b
Box.margin Int
n)

-- | Sets the properties for a GUI element.
props :: [Prop] -> Gui -> Gui
props :: [Prop] -> Gui -> Gui
props [Prop]
ps = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Props -> LowGui -> LowGui
forall ctx a. Monoid ctx => ctx -> Scene ctx a -> Scene ctx a
Box.appendContext (Props -> LowGui -> LowGui) -> Props -> LowGui -> LowGui
forall a b. (a -> b) -> a -> b
$ Props
forall a. Default a => a
def { otherProps = ps })

-- | Rescales the default sizes for the UI elements.
resizeGui :: ScaleFactor -> Gui -> Gui
resizeGui :: ScaleFactor -> Gui -> Gui
resizeGui ScaleFactor
factorXY = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Props -> LowGui -> LowGui
forall ctx a. Monoid ctx => ctx -> Scene ctx a -> Scene ctx a
Box.appendContext (Props -> LowGui -> LowGui) -> Props -> LowGui -> LowGui
forall a b. (a -> b) -> a -> b
$ Props
forall a. Default a => a
def { propsScaleFactor = Just factorXY })

-- | Sets the properties for a GUI element on all levels.
forceProps :: [Prop] -> Gui -> Gui
forceProps :: [Prop] -> Gui -> Gui
forceProps = [Char] -> [Prop] -> Gui -> Gui
forall a. HasCallStack => [Char] -> a
error [Char]
"forceProps: TODO"

setBorder :: BorderType -> Gui -> Gui
setBorder :: BorderType -> Gui -> Gui
setBorder BorderType
a = (LowGui -> LowGui) -> Gui -> Gui
onLowGui1 (Props -> LowGui -> LowGui
forall ctx a. Monoid ctx => ctx -> Scene ctx a -> Scene ctx a
Box.appendContext (Props -> LowGui -> LowGui) -> Props -> LowGui -> LowGui
forall a b. (a -> b) -> a -> b
$ Props
forall a. Default a => a
def { propsBorder = Just a })

type GuiMap = IM.IntMap Gui

guiMap :: [GuiNode] -> GuiMap
guiMap :: [GuiNode] -> GuiMap
guiMap = [(Int, Gui)] -> GuiMap
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Gui)] -> GuiMap)
-> ([GuiNode] -> [(Int, Gui)]) -> [GuiNode] -> GuiMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GuiNode -> (Int, Gui)) -> [GuiNode] -> [(Int, Gui)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(GuiNode Gui
elem (GuiHandle Int
n)) -> (Int
n, Gui
elem))

restoreTree :: GuiMap -> Gui -> Gui
restoreTree :: GuiMap -> Gui -> Gui
restoreTree GuiMap
m Gui
x = LowGui -> Gui
Gui (LowGui -> Gui) -> LowGui -> Gui
forall a b. (a -> b) -> a -> b
$ (Gui -> LowGui
unGui Gui
x) LowGui -> (ElemWithOuts -> LowGui) -> LowGui
forall a b. Scene Props a -> (a -> Scene Props b) -> Scene Props b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ElemWithOuts -> LowGui
rec
    where rec :: ElemWithOuts -> LowGui
rec ElemWithOuts
elem = case ElemWithOuts -> Elem
elemContent ElemWithOuts
elem of
            GuiVar GuiHandle
h -> Gui -> LowGui
unGui (Gui -> LowGui) -> Gui -> LowGui
forall a b. (a -> b) -> a -> b
$ GuiMap -> Gui -> Gui
restoreTree GuiMap
m (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ GuiMap
m GuiMap -> Int -> Gui
forall a. IntMap a -> Int -> a
IM.! GuiHandle -> Int
unGuiHandle GuiHandle
h
            Elem
_        -> ElemWithOuts -> LowGui
forall a. a -> Scene Props a
forall (m :: * -> *) a. Monad m => a -> m a
return ElemWithOuts
elem


guiStmt :: Monad m => ScaleFactor -> [Panel] -> DepT m ()
guiStmt :: forall (m :: * -> *).
Monad m =>
ScaleFactor -> [Panel] -> DepT m ()
guiStmt ScaleFactor
defaultScaleUI [Panel]
panels = E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Exp E -> E
noRate (ScaleFactor -> Exp E
forall {a}. ScaleFactor -> MainExp a
phi ScaleFactor
defaultScaleUI)
    where phi :: ScaleFactor -> MainExp a
phi ScaleFactor
scaleUI
            | [Panel] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Panel]
panels = MainExp a
forall a. MainExp a
EmptyExp
            | Bool
otherwise   = Text -> MainExp a
forall a. Text -> MainExp a
Verbatim (Text -> MainExp a) -> Text -> MainExp a
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
forall a. Show a => a -> [Char]
show (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.vcat [[Doc] -> Doc
P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Panel -> Doc) -> [Panel] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScaleFactor -> Panel -> Doc
drawGui ScaleFactor
scaleUI) [Panel]
panels, Text -> Doc
P.textStrict Text
"FLrun"]

drawGui :: ScaleFactor -> Panel -> Doc
drawGui :: ScaleFactor -> Panel -> Doc
drawGui ScaleFactor
defaultScaleUI Panel
x = case Panel
x of
    Single Win
w    Bool
isKeybd -> Bool -> Rect -> Doc -> Doc
panel Bool
isKeybd Rect
boundingRect (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> Win -> Doc
drawWin (Rect -> Rect
withWinMargin Rect
boundingRect) Win
w
    Tabs Text
_ Maybe Rect
_ [Win]
ws Bool
isKeybd -> Bool -> Rect -> Doc -> Doc
panel Bool
isKeybd Rect
tabPanelRect (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ case [Win]
ws of
        [] -> Doc
P.empty
        [Win]
_  -> Rect -> Doc -> Doc
onTabs Rect
mainTabRect (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Rect, Win) -> Doc) -> [(Rect, Win)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rect -> Win -> Doc) -> (Rect, Win) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Rect -> Win -> Doc) -> (Rect, Win) -> Doc)
-> (Rect -> Win -> Doc) -> (Rect, Win) -> Doc
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Rect -> Win -> Doc
drawTab (Int, Int)
shift) [(Rect, Win)]
tabsRs
    where boundingRect :: Rect
boundingRect = ScaleFactor -> [Rect] -> Panel -> Rect
panelRect ScaleFactor
defaultScaleUI (((Rect, Win) -> Rect) -> [(Rect, Win)] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect, Win) -> Rect
forall a b. (a, b) -> a
fst [(Rect, Win)]
tabsRs) Panel
x
          tabsRs :: [(Rect, Win)]
tabsRs = ScaleFactor -> Panel -> [(Rect, Win)]
tabsRects ScaleFactor
defaultScaleUI Panel
x
          (Rect
mainTabRect, (Int, Int)
shift) = Rect -> (Rect, (Int, Int))
mainTabRectAndShift Rect
boundingRect

          tabPanelRect :: Rect
tabPanelRect = Rect
            { px :: Int
px = Int
100
            , py :: Int
py = Int
100
            , width :: Int
width = Rect -> Int
width Rect
mainTabRect Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20
            , height :: Int
height = Rect -> Int
height Rect
mainTabRect Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20
            }

          panel :: Bool -> Rect -> Doc -> Doc
panel = Text -> Bool -> Rect -> Doc -> Doc
onPanel (Panel -> Text
panelTitle Panel
x)

          onPanel :: Text -> Bool -> Rect -> Doc -> Doc
onPanel Text
title Bool
isKeybdSensitive Rect
rect Doc
body = [Doc] -> Doc
P.vcat
            -- panel with default position no border and capture of keyboard events
            [ Text -> [Doc] -> Doc
ppProc Text
"FLpanel" [ Text -> Doc
P.textStrict Text
title, Int -> Doc
P.int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> Int
width Rect
rect, Int -> Doc
P.int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> Int
height Rect
rect, Int -> Doc
P.int (-Int
1), Int -> Doc
P.int (-Int
1), Int -> Doc
P.int Int
0
                               , Int -> Doc
P.int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
isKeybdSensitive then Int
1 else Int
0 ]
            , Doc
body
            , Text -> [Doc] -> Doc
ppProc Text
"FLpanelEnd" []]

          onTabs :: Rect -> Doc -> Doc
onTabs Rect
rect Doc
body = [Doc] -> Doc
P.vcat
            [ Text -> [Doc] -> Doc
ppProc Text
"FLtabs" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> [Doc]
rectToFrame Rect
rect
            , Doc
body
            , Text -> [Doc] -> Doc
ppProc Text
"FLtabsEnd" []]


panelTitle :: Panel -> Text
panelTitle :: Panel -> Text
panelTitle Panel
x = case Panel
x of
    Single Win
w Bool
_       -> Win -> Text
winTitle Win
w
    Tabs Text
title Maybe Rect
_ [Win]
_ Bool
_ -> Text
title

panelRect :: ScaleFactor -> [Rect] -> Panel -> Rect
panelRect :: ScaleFactor -> [Rect] -> Panel -> Rect
panelRect ScaleFactor
defaultScaleUI [Rect]
rs Panel
x = case Panel
x of
    Single Win
w Bool
_       -> ScaleFactor -> Win -> Rect
winBoundingRect ScaleFactor
defaultScaleUI Win
w
    Tabs Text
_ Maybe Rect
mrect [Win]
_ Bool
_ -> case [Rect]
rs of
        [] -> Rect
Box.zeroRect
        [Rect]
_  -> Rect -> (Rect -> Rect) -> Maybe Rect -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Rect -> Rect -> Rect) -> Rect -> [Rect] -> Rect
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rect -> Rect -> Rect
boundingRect ([Rect] -> Rect
forall a. HasCallStack => [a] -> a
head [Rect]
rs) [Rect]
rs) Rect -> Rect
forall a. a -> a
id Maybe Rect
mrect
    where boundingRect :: Rect -> Rect -> Rect
boundingRect Rect
a Rect
b = Rect { px :: Int
px = Int
x1, py :: Int
py = Int
y1, width :: Int
width = Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1, height :: Int
height = Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1 }
              where x1 :: Int
x1 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Rect -> Int
px Rect
a) (Rect -> Int
px Rect
b)
                    y1 :: Int
y1 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Rect -> Int
py Rect
a) (Rect -> Int
py Rect
b)
                    x2 :: Int
x2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Rect -> Int
px Rect
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
width Rect
a) (Rect -> Int
px Rect
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
width Rect
b)
                    y2 :: Int
y2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Rect -> Int
py Rect
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
height Rect
a) (Rect -> Int
py Rect
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
height Rect
b)

mainTabRectAndShift :: Rect -> (Rect, (Int, Int))
mainTabRectAndShift :: Rect -> (Rect, (Int, Int))
mainTabRectAndShift Rect
r = (Rect
res, (Int
dx, Int
dy))
    where res :: Rect
res = Rect
            { px :: Int
px     = Int
5
            , py :: Int
py     = Int
5
            , width :: Int
width  = Rect -> Int
px Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
width Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
            , height :: Int
height = Rect -> Int
py Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rect -> Int
height Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
yBox Int
15 Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
            }
          dx :: Int
dx = Int
10
          dy :: Int
dy = Int -> Int -> Int
yBox Int
15 Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10



tabsRects :: ScaleFactor -> Panel -> [(Rect, Win)]
tabsRects :: ScaleFactor -> Panel -> [(Rect, Win)]
tabsRects ScaleFactor
defaultScaleUI Panel
x = case Panel
x of
    Single Win
_ Bool
_    -> []
    Tabs Text
_ Maybe Rect
_ [Win]
ws Bool
_ -> [Rect] -> [Win] -> [(Rect, Win)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Win -> Rect) -> [Win] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScaleFactor -> Win -> Rect
winBoundingRect ScaleFactor
defaultScaleUI) [Win]
ws) [Win]
ws

winBoundingRect :: ScaleFactor -> Win -> Rect
winBoundingRect :: ScaleFactor -> Win -> Rect
winBoundingRect ScaleFactor
defaultScaleUI Win
w = Rect -> (Rect -> Rect) -> Maybe Rect -> Rect
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Rect -> Rect
shiftBy Int
50 (Rect -> Rect) -> Rect -> Rect
forall a b. (a -> b) -> a -> b
$ ScaleFactor -> Gui -> Rect
bestRect ScaleFactor
defaultScaleUI (Gui -> Rect) -> Gui -> Rect
forall a b. (a -> b) -> a -> b
$ Win -> Gui
winGui Win
w) Rect -> Rect
forall a. a -> a
id (Maybe Rect -> Rect) -> Maybe Rect -> Rect
forall a b. (a -> b) -> a -> b
$ Win -> Maybe Rect
winRect Win
w
    where shiftBy :: Int -> Rect -> Rect
shiftBy Int
n Rect
r = Rect
r { px = n + px r, py = n + py r }

drawTab :: (Int, Int) -> Rect -> Win -> Doc
drawTab :: (Int, Int) -> Rect -> Win -> Doc
drawTab (Int, Int)
shift Rect
r Win
w = Text -> Rect -> Doc -> Doc
forall {a}. Show a => a -> Rect -> Doc -> Doc
group (Win -> Text
winTitle Win
w) Rect
r (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> Win -> Doc
drawWin (Rect -> Rect
withRelWinMargin (Rect -> Rect) -> Rect -> Rect
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Rect -> Rect
shiftRect (Int, Int)
shift Rect
r) Win
w
    where group :: a -> Rect -> Doc -> Doc
group a
title Rect
rect Doc
body = [Doc] -> Doc
P.vcat
            [ Text -> [Doc] -> Doc
ppProc Text
"FLgroup" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Text -> Doc
P.textStrict (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
title) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Rect -> [Doc]
rectToFrame Rect
rect
            , Doc
body
            , Text -> [Doc] -> Doc
ppProc Text
"FLgroupEnd" []]

          shiftRect :: (Int, Int) -> Rect -> Rect
shiftRect (Int
dx, Int
dy) Rect
rect = Rect
rect
            { px = dx + px rect
            , py = dy + py rect }

rectToFrame :: Rect -> [Doc]
rectToFrame :: Rect -> [Doc]
rectToFrame Rect
rect = (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Doc
P.int [Rect -> Int
width Rect
rect, Rect -> Int
height Rect
rect, Rect -> Int
px Rect
rect, Rect -> Int
py Rect
rect]

drawWin :: Rect -> Win -> Doc
drawWin :: Rect -> Win -> Doc
drawWin Rect
rect Win
w = AbsScene Props ElemWithOuts -> Doc
renderAbsScene (AbsScene Props ElemWithOuts -> Doc)
-> AbsScene Props ElemWithOuts -> Doc
forall a b. (a -> b) -> a -> b
$ Rect -> LowGui -> AbsScene Props ElemWithOuts
forall ctx a. Rect -> Scene ctx a -> AbsScene ctx a
Box.draw Rect
rect (LowGui -> AbsScene Props ElemWithOuts)
-> LowGui -> AbsScene Props ElemWithOuts
forall a b. (a -> b) -> a -> b
$ Gui -> LowGui
unGui (Gui -> LowGui) -> Gui -> LowGui
forall a b. (a -> b) -> a -> b
$ Win -> Gui
winGui Win
w
    where
        renderAbsScene :: AbsScene Props ElemWithOuts -> Doc
renderAbsScene = (PropCtx -> Rect -> ElemWithOuts -> Doc)
-> Doc
-> ([Doc] -> Doc)
-> (Rect -> Props -> Doc -> Doc)
-> (Props -> PropCtx -> PropCtx)
-> PropCtx
-> AbsScene Props ElemWithOuts
-> Doc
forall totalCtx a res ctx.
(totalCtx -> Rect -> a -> res)
-> res
-> ([res] -> res)
-> (Rect -> ctx -> res -> res)
-> (ctx -> totalCtx -> totalCtx)
-> totalCtx
-> AbsScene ctx a
-> res
Box.cascade PropCtx -> Rect -> ElemWithOuts -> Doc
drawPrim Doc
P.empty [Doc] -> Doc
P.vcat Rect -> Props -> Doc -> Doc
onCtx Props -> PropCtx -> PropCtx
setProps PropCtx
forall a. Default a => a
def
            where
                setProps :: Props -> PropCtx -> PropCtx
setProps Props
ps = Endo PropCtx -> PropCtx -> PropCtx
forall a. Endo a -> a -> a
appEndo (Endo PropCtx -> PropCtx -> PropCtx)
-> Endo PropCtx -> PropCtx -> PropCtx
forall a b. (a -> b) -> a -> b
$ [Endo PropCtx] -> Endo PropCtx
forall a. Monoid a => [a] -> a
mconcat ([Endo PropCtx] -> Endo PropCtx) -> [Endo PropCtx] -> Endo PropCtx
forall a b. (a -> b) -> a -> b
$ (Prop -> Endo PropCtx) -> [Prop] -> [Endo PropCtx]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PropCtx -> PropCtx) -> Endo PropCtx
forall a. (a -> a) -> Endo a
Endo ((PropCtx -> PropCtx) -> Endo PropCtx)
-> (Prop -> PropCtx -> PropCtx) -> Prop -> Endo PropCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prop -> PropCtx -> PropCtx
setPropCtx) (Props -> [Prop]
otherProps Props
ps)

                onCtx :: Rect -> Props -> Doc -> Doc
onCtx Rect
r Props
ps Doc
res = Doc -> (BorderType -> Doc) -> Maybe BorderType -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
res (\BorderType
borderType -> BorderType -> Rect -> Doc -> Doc
drawBorder BorderType
borderType Rect
r Doc
res) (Props -> Maybe BorderType
propsBorder Props
ps)

drawBorder :: BorderType -> Rect -> Doc -> Doc
drawBorder :: BorderType -> Rect -> Doc -> Doc
drawBorder BorderType
borderType Rect
rect Doc
a = [Doc] -> Doc
P.vcat
    [ Text -> [Doc] -> Doc
ppProc Text
"FLgroup" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc
P.empty Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
frame) [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [BorderType -> Doc
borderAsInt BorderType
borderType]
    , Doc
a
    , Text -> [Doc] -> Doc
ppProc Text
"FLgroupEnd" []]
    where borderAsInt :: BorderType -> Doc
borderAsInt = Int -> Doc
P.int (Int -> Doc) -> (BorderType -> Int) -> BorderType -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BorderType -> Int
forall a. Enum a => a -> Int
fromEnum
          frame :: [Doc]
frame = Rect -> [Doc]
rectToFrame Rect
rect

drawPrim :: PropCtx -> Rect -> ElemWithOuts -> Doc
drawPrim :: PropCtx -> Rect -> ElemWithOuts -> Doc
drawPrim PropCtx
ctx Rect
rect ElemWithOuts
elem = [Doc] -> Doc
P.vcat
    [ PropCtx -> Rect -> ElemWithOuts -> Doc
drawElemDef PropCtx
ctx Rect
rect ElemWithOuts
elem
    , PropCtx -> ElemWithOuts -> Doc
drawAppearance PropCtx
ctx ElemWithOuts
elem
    , ElemWithOuts -> Doc
drawInitVal ElemWithOuts
elem ]

drawAppearance :: PropCtx -> ElemWithOuts -> Doc
drawAppearance :: PropCtx -> ElemWithOuts -> Doc
drawAppearance PropCtx
ctx ElemWithOuts
el = Doc -> (Var -> Doc) -> Maybe Var -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
P.empty ((Var -> PropCtx -> Doc) -> PropCtx -> Var -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Var -> PropCtx -> Doc
flSetAll PropCtx
ctx)
    (Maybe Var -> Doc) -> Maybe Var -> Doc
forall a b. (a -> b) -> a -> b
$ [Var] -> Maybe Var
getPropHandle ([Var] -> Maybe Var) -> [Var] -> Maybe Var
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> [Var]
elemOuts ElemWithOuts
el

drawInitVal :: ElemWithOuts -> Doc
drawInitVal :: ElemWithOuts -> Doc
drawInitVal = [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> (ElemWithOuts -> [Doc]) -> ElemWithOuts -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitMe -> Doc) -> [InitMe] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InitMe -> Doc
flSetVal_i ([InitMe] -> [Doc])
-> (ElemWithOuts -> [InitMe]) -> ElemWithOuts -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemWithOuts -> [InitMe]
elemInits

drawElemDef :: PropCtx -> Rect -> ElemWithOuts -> Doc
drawElemDef :: PropCtx -> Rect -> ElemWithOuts -> Doc
drawElemDef PropCtx
ctx Rect
rectWithoutLabel ElemWithOuts
el = case ElemWithOuts -> Elem
elemContent ElemWithOuts
el of
    -- valuators
    Count  ValDiap
diap Double
step1 Maybe Double
step2 -> ValDiap -> Double -> Maybe Double -> Doc
drawCount ValDiap
diap Double
step1 Maybe Double
step2
    Joy    ValSpan
span1 ValSpan
span2      -> ValSpan -> ValSpan -> Doc
drawJoy ValSpan
span1 ValSpan
span2
    Knob   ValSpan
span             -> ValSpan -> Doc
drawKnob ValSpan
span
    Roller ValSpan
span Double
step        -> ValSpan -> Double -> Doc
drawRoller ValSpan
span Double
step
    Slider ValSpan
span             -> ValSpan -> Doc
drawSlider ValSpan
span
    Text   ValDiap
diap Double
step        -> ValDiap -> Double -> Doc
drawText ValDiap
diap Double
step

    -- other widgets
    Box Text
label               -> Text -> Doc
drawBox Text
label
    ButBank Int
xn Int
yn           -> Int -> Int -> Doc
drawButBank Int
xn Int
yn
    Button InstrId
instrId          -> InstrId -> Doc
drawButton InstrId
instrId
    Elem
Toggle                  -> Doc
drawToggle
    Elem
Value                   -> Doc
drawValue
    Elem
Vkeybd                  -> Doc
drawVkeybd

    -- error
    GuiVar GuiHandle
guiHandle        -> GuiHandle -> Doc
forall a. GuiHandle -> a
orphanGuiVar GuiHandle
guiHandle
    where
        rect :: Rect
rect = Rect -> Rect
clearSpaceForLabel (Rect -> Rect) -> Rect -> Rect
forall a b. (a -> b) -> a -> b
$ Rect
rectWithoutLabel
        clearSpaceForLabel :: Rect -> Rect
clearSpaceForLabel Rect
a
            | Text
label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""   = Rect
a
            | Bool
otherwise     = Rect
a { height = max 20 $ height a - yLabelBox (getIntFontSize ctx) }
            where label :: Text
label = PropCtx -> Text
getLabel PropCtx
ctx

        f :: Text -> [Doc] -> Doc
f = Text -> Text -> [Doc] -> Doc
fWithLabel (PropCtx -> Text
getLabel PropCtx
ctx)

        fWithLabel :: Text -> Text -> [Doc] -> Doc
        fWithLabel :: Text -> Text -> [Doc] -> Doc
fWithLabel Text
label Text
name [Doc]
args = [Doc] -> Text -> [Doc] -> Doc
ppMoOpc ((Var -> Doc) -> [Var] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> Doc
ppVar ([Var] -> [Doc]) -> [Var] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> [Var]
elemOuts ElemWithOuts
el) Text
name ((Text -> Doc
P.textStrict Text
label) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
args)
        fNoLabel :: Text -> [Doc] -> Doc
fNoLabel Text
name [Doc]
args = [Doc] -> Text -> [Doc] -> Doc
ppMoOpc ((Var -> Doc) -> [Var] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> Doc
ppVar ([Var] -> [Doc]) -> [Var] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> [Var]
elemOuts ElemWithOuts
el) Text
name [Doc]
args
        frame :: [Doc]
frame = Rect -> [Doc]
frameBy Rect
rect
        frameWithoutLabel :: [Doc]
frameWithoutLabel = Rect -> [Doc]
frameBy Rect
rectWithoutLabel
        frameBy :: Rect -> [Doc]
frameBy Rect
x = (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Doc
P.int [Rect -> Int
width Rect
x, Rect -> Int
height Rect
x, Rect -> Int
px Rect
x, Rect -> Int
py Rect
x]
        noDisp :: Doc
noDisp = Int -> Doc
P.int (-Int
1)
        noOpc :: Doc
noOpc  = Int -> Doc
P.int (-Int
1)
        onOpc :: InstrId -> [Double] -> [Doc]
onOpc InstrId
instrId [Double]
xs = Int -> Doc
P.int Int
0 Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Int -> Doc
P.int (InstrId -> Int
instrIdCeil InstrId
instrId) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Double -> Doc) -> [Double] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Doc
P.double [Double]
xs
        drawSpan :: ValSpan -> [Doc]
drawSpan (ValSpan ValDiap
diap ValScaleType
scale) = [ValDiap -> Doc
imin ValDiap
diap, ValDiap -> Doc
imax ValDiap
diap, ValScaleType -> Doc
getScale ValScaleType
scale]

        imin :: ValDiap -> Doc
imin = Double -> Doc
P.double (Double -> Doc) -> (ValDiap -> Double) -> ValDiap -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValDiap -> Double
valDiapMin
        imax :: ValDiap -> Doc
imax = Double -> Doc
P.double (Double -> Doc) -> (ValDiap -> Double) -> ValDiap -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValDiap -> Double
valDiapMax

        -----------------------------------------------------------------------
        -- valuators

        -- FLcount
        drawCount :: ValDiap -> Double -> Maybe Double -> Doc
drawCount ValDiap
diap Double
step1 Maybe Double
mValStep2 = Text -> [Doc] -> Doc
f Text
"FLcount" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [ ValDiap -> Doc
imin ValDiap
diap, ValDiap -> Doc
imax ValDiap
diap
            , Double -> Doc
P.double Double
step1, Double -> Doc
P.double Double
step2
            , Int -> Doc
P.int Int
itype ]
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frame [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
noOpc]
            where (Double
step2, Int
itype) = case Maybe Double
mValStep2 of
                    -- type 1 FLcount with 2 steps
                    Just Double
n  -> (Double
n, Int
1)
                    -- type 2 FLcount with a single step
                    Maybe Double
Nothing -> (Double
step1, Int
2)

        -- FLjoy
        drawJoy :: ValSpan -> ValSpan -> Doc
drawJoy (ValSpan ValDiap
dX ValScaleType
sX) (ValSpan ValDiap
dY ValScaleType
sY) = Text -> [Doc] -> Doc
f Text
"FLjoy" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [ ValDiap -> Doc
imin ValDiap
dX, ValDiap -> Doc
imax ValDiap
dX, ValDiap -> Doc
imin ValDiap
dY, ValDiap -> Doc
imax ValDiap
dY
            , ValScaleType -> Doc
getScale ValScaleType
sX, ValScaleType -> Doc
getScale ValScaleType
sY
            , Doc
noDisp, Doc
noDisp
            ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frame

        -- FLknob
        drawKnob :: ValSpan -> Doc
drawKnob ValSpan
span = Text -> [Doc] -> Doc
f Text
"FLknob" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            ValSpan -> [Doc]
drawSpan ValSpan
span [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [PropCtx -> Doc
getKnobType PropCtx
ctx, Doc
noDisp]
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Doc
P.int [Int]
knobFrame [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PropCtx -> [Doc]
getKnobCursorSize PropCtx
ctx
            where
                knobFrame :: [Int]
knobFrame
                    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h     = [Int
w, Int
x, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d]
                    | Bool
otherwise = [Int
h, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d, Int
y]
                h :: Int
h = Rect -> Int
height Rect
rect
                w :: Int
w = Rect -> Int
width Rect
rect
                x :: Int
x = Rect -> Int
px Rect
rect
                y :: Int
y = Rect -> Int
py Rect
rect
                d :: Int
d = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Int
2

        -- FLroller
        drawRoller :: ValSpan -> Double -> Doc
drawRoller (ValSpan ValDiap
d ValScaleType
s) Double
step = Text -> [Doc] -> Doc
f Text
"FLroller" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [ ValDiap -> Doc
imin ValDiap
d, ValDiap -> Doc
imax ValDiap
d, Double -> Doc
P.double Double
step
            , ValScaleType -> Doc
getScale ValScaleType
s, Orient -> PropCtx -> Doc
getRollerType (Rect -> Orient
getDefOrient Rect
rect) PropCtx
ctx, Doc
noDisp
            ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frame

        -- FLslider
        drawSlider :: ValSpan -> Doc
drawSlider ValSpan
span = Text -> [Doc] -> Doc
f Text
"FLslider" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            ValSpan -> [Doc]
drawSpan ValSpan
span
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Orient -> PropCtx -> Doc
getSliderType (Rect -> Orient
getDefOrient Rect
rect) PropCtx
ctx, Doc
noDisp]
            [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frame

        -- FLtext
        drawText :: ValDiap -> Double -> Doc
drawText ValDiap
diap Double
step = Text -> [Doc] -> Doc
f Text
"FLtext" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [ValDiap -> Doc
imin ValDiap
diap, ValDiap -> Doc
imax ValDiap
diap, Double -> Doc
P.double Double
step, PropCtx -> Doc
getTextType PropCtx
ctx] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frame

        -----------------------------------------------------------------------
        -- other widgets

        -- FLbox
        drawBox :: Text -> Doc
drawBox Text
label = Text -> Text -> [Doc] -> Doc
fWithLabel Text
label Text
"FLbox" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [ PropCtx -> Doc
getBoxType PropCtx
ctx, PropCtx -> Doc
getFontType PropCtx
ctx, PropCtx -> Doc
getFontSize PropCtx
ctx ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frameWithoutLabel

        -- FLbutBank
        drawButBank :: Int -> Int -> Doc
drawButBank Int
xn Int
yn = Text -> [Doc] -> Doc
fNoLabel Text
"FLbutBank" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            [PropCtx -> Doc
getButtonBankType PropCtx
ctx, Int -> Doc
P.int Int
xn, Int -> Doc
P.int Int
yn] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frameWithoutLabel [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
noOpc]

        -- FLbutton's
        drawButton :: InstrId -> Doc
drawButton InstrId
instrId = Text -> [Doc] -> Doc
f Text
"FLbutton" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Int -> Doc
P.int Int
1, Int -> Doc
P.int Int
0, PropCtx -> Doc
getButtonType PropCtx
ctx] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frameWithoutLabel [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (InstrId -> [Double] -> [Doc]
onOpc InstrId
instrId [Double
0, Double
forall a. Num a => a
infiniteDur])

        drawToggle :: Doc
drawToggle = Text -> [Doc] -> Doc
f Text
"FLbutton" ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Int -> Doc
P.int Int
1, Int -> Doc
P.int Int
0, PropCtx -> Doc
getToggleType PropCtx
ctx] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
frameWithoutLabel [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
noOpc]

        -- FLvalue
        drawValue :: Doc
drawValue = Text -> [Doc] -> Doc
f Text
"FLvalue" [Doc]
frame

        -- FLvkeybd
        drawVkeybd :: Doc
drawVkeybd = Text -> Text -> [Doc] -> Doc
fWithLabel Text
"" Text
"FLvkeybd" [Doc]
frame

-----------------------------------------------------------------
-- handy shortcuts

setProp :: Prop -> Gui -> Gui
setProp :: Prop -> Gui -> Gui
setProp Prop
p = [Prop] -> Gui -> Gui
props [Prop
p]

setLabel :: Text -> Gui -> Gui
setLabel :: Text -> Gui -> Gui
setLabel = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Text -> Prop) -> Text -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Prop
SetLabel

setLabelType :: LabelType -> Gui -> Gui
setLabelType :: LabelType -> Gui -> Gui
setLabelType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (LabelType -> Prop) -> LabelType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabelType -> Prop
SetLabelType

setMaterial :: Material -> Gui -> Gui
setMaterial :: Material -> Gui -> Gui
setMaterial = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (Material -> Prop) -> Material -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Material -> Prop
SetMaterial

setBoxType :: BoxType -> Gui -> Gui
setBoxType :: BoxType -> Gui -> Gui
setBoxType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (BoxType -> Prop) -> BoxType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoxType -> Prop
SetBoxType

setColor1 :: Color -> Gui -> Gui
setColor1 :: Color -> Gui -> Gui
setColor1 = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Color -> Prop) -> Color -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Prop
SetColor1

setColor2 :: Color -> Gui -> Gui
setColor2 :: Color -> Gui -> Gui
setColor2 = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Color -> Prop) -> Color -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Prop
SetColor2

setColors :: Color -> Color -> Gui -> Gui
setColors :: Color -> Color -> Gui -> Gui
setColors Color
primary Color
secondary = Color -> Gui -> Gui
setColor1 Color
primary (Gui -> Gui) -> (Gui -> Gui) -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Gui -> Gui
setColor2 Color
secondary

setTextColor :: Color -> Gui -> Gui
setTextColor :: Color -> Gui -> Gui
setTextColor = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Color -> Prop) -> Color -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Prop
SetTextColor

setFontSize :: Int -> Gui -> Gui
setFontSize :: Int -> Gui -> Gui
setFontSize = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Int -> Prop) -> Int -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Prop
SetFontSize

setFontType :: FontType -> Gui -> Gui
setFontType :: FontType -> Gui -> Gui
setFontType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (FontType -> Prop) -> FontType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontType -> Prop
SetFontType

setEmphasis :: Emphasis -> Gui -> Gui
setEmphasis :: Emphasis -> Gui -> Gui
setEmphasis = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (Emphasis -> Prop) -> Emphasis -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emphasis -> Prop
SetEmphasis

setSliderType :: SliderType -> Gui -> Gui
setSliderType :: SliderType -> Gui -> Gui
setSliderType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (SliderType -> Prop) -> SliderType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SliderType -> Prop
SetSliderType

setTextType :: TextType -> Gui -> Gui
setTextType :: TextType -> Gui -> Gui
setTextType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (TextType -> Prop) -> TextType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextType -> Prop
SetTextType

setButtonType :: ButtonType -> Gui -> Gui
setButtonType :: ButtonType -> Gui -> Gui
setButtonType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (ButtonType -> Prop) -> ButtonType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ButtonType -> Prop
SetButtonType

setOrient :: Orient -> Gui -> Gui
setOrient :: Orient -> Gui -> Gui
setOrient = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui) -> (Orient -> Prop) -> Orient -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orient -> Prop
SetOrient

setKnobType :: KnobType -> Gui -> Gui
setKnobType :: KnobType -> Gui -> Gui
setKnobType = Prop -> Gui -> Gui
setProp (Prop -> Gui -> Gui)
-> (KnobType -> Prop) -> KnobType -> Gui -> Gui
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnobType -> Prop
SetKnobType

------------------------------------------------------------------
-- best rectangles for the elements
--

winMargin :: Int
winMargin :: Int
winMargin = Int
10

appendWinMargin :: Rect -> Rect
appendWinMargin :: Rect -> Rect
appendWinMargin Rect
r = Rect
r
    { width  = 2 * winMargin + width r
    , height = 2 * winMargin + height r
    }

withWinMargin :: Rect -> Rect
withWinMargin :: Rect -> Rect
withWinMargin Rect
r = Rect
r
    { px = winMargin
    , py = winMargin
    , height = height r - 2 * winMargin
    , width  = width  r - 2 * winMargin
    }

withRelWinMargin :: Rect -> Rect
withRelWinMargin :: Rect -> Rect
withRelWinMargin Rect
r = Rect
r
    { px = winMargin + px r
    , py = winMargin + py r
    , height = height r - 2 * winMargin
    , width  = width  r - 2 * winMargin
    }

bestRect :: ScaleFactor -> Gui -> Rect
bestRect :: ScaleFactor -> Gui -> Rect
bestRect ScaleFactor
defaultScaleUI
    = Rect -> Rect
appendWinMargin (Rect -> Rect) -> (Gui -> Rect) -> Gui -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scene Props Rect -> Rect
forall ctx. Scene ctx Rect -> Rect
Box.boundingRect
    (Scene Props Rect -> Rect)
-> (Gui -> Scene Props Rect) -> Gui -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScaleFactor
-> (Orient -> ScaleFactor -> ElemWithOuts -> Rect)
-> LowGui
-> Scene Props Rect
forall a b.
ScaleFactor
-> (Orient -> ScaleFactor -> a -> b)
-> Scene Props a
-> Scene Props b
mapWithOrientAndScale ScaleFactor
defaultScaleUI (\Orient
curOrient ScaleFactor
curScaleFactor ElemWithOuts
x -> (Int -> Int -> Rect) -> (Int, Int) -> Rect
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Rect
noShiftRect ((Int, Int) -> Rect) -> (Int, Int) -> Rect
forall a b. (a -> b) -> a -> b
$ ScaleFactor -> (Int, Int) -> (Int, Int)
bestElemSizesRescaled ScaleFactor
curScaleFactor ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Orient -> Elem -> (Int, Int)
bestElemSizes Orient
curOrient (Elem -> (Int, Int)) -> Elem -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ ElemWithOuts -> Elem
elemContent ElemWithOuts
x)
    (LowGui -> Scene Props Rect)
-> (Gui -> LowGui) -> Gui -> Scene Props Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gui -> LowGui
unGui
    where noShiftRect :: Int -> Int -> Rect
noShiftRect Int
w Int
h = Rect { px :: Int
px = Int
0, py :: Int
py = Int
0, width :: Int
width = Int
w, height :: Int
height = Int
h }

mapWithOrientAndScale :: ScaleFactor -> (Orient -> ScaleFactor -> a -> b) -> Box.Scene Props a -> Box.Scene Props b
mapWithOrientAndScale :: forall a b.
ScaleFactor
-> (Orient -> ScaleFactor -> a -> b)
-> Scene Props a
-> Scene Props b
mapWithOrientAndScale ScaleFactor
defaultScaleUI Orient -> ScaleFactor -> a -> b
f = Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
Hor ScaleFactor
defaultScaleUI
    where
        iter :: Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
curOrient ScaleFactor
curScale Scene Props a
x = case Scene Props a
x of
            Box.Prim a
a          -> b -> Scene Props b
forall ctx a. a -> Scene ctx a
Box.Prim (b -> Scene Props b) -> b -> Scene Props b
forall a b. (a -> b) -> a -> b
$ Orient -> ScaleFactor -> a -> b
f Orient
curOrient ScaleFactor
curScale a
a
            Scene Props a
Box.Space           -> Scene Props b
forall a b. Scene a b
Box.Space
            Box.Scale Double
d Scene Props a
a       -> Double -> Scene Props b -> Scene Props b
forall a b. Double -> Scene a b -> Scene a b
Box.Scale Double
d (Scene Props b -> Scene Props b) -> Scene Props b -> Scene Props b
forall a b. (a -> b) -> a -> b
$ Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
curOrient ScaleFactor
curScale Scene Props a
a
            Box.Hor Offset
offs [Scene Props a]
as     -> Offset -> [Scene Props b] -> Scene Props b
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Box.Hor Offset
offs ([Scene Props b] -> Scene Props b)
-> [Scene Props b] -> Scene Props b
forall a b. (a -> b) -> a -> b
$ (Scene Props a -> Scene Props b)
-> [Scene Props a] -> [Scene Props b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
Hor ScaleFactor
curScale) [Scene Props a]
as
            Box.Ver Offset
offs [Scene Props a]
as     -> Offset -> [Scene Props b] -> Scene Props b
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Box.Ver Offset
offs ([Scene Props b] -> Scene Props b)
-> [Scene Props b] -> Scene Props b
forall a b. (a -> b) -> a -> b
$ (Scene Props a -> Scene Props b)
-> [Scene Props a] -> [Scene Props b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
Ver ScaleFactor
curScale) [Scene Props a]
as
            Box.Context Props
ctx Scene Props a
a   -> case Props -> Maybe ScaleFactor
propsScaleFactor Props
ctx of
                    Maybe ScaleFactor
Nothing -> Props -> Scene Props b -> Scene Props b
forall ctx a. ctx -> Scene ctx a -> Scene ctx a
Box.Context Props
ctx (Scene Props b -> Scene Props b) -> Scene Props b -> Scene Props b
forall a b. (a -> b) -> a -> b
$ Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
curOrient ScaleFactor
curScale Scene Props a
a
                    Just ScaleFactor
newScale -> Props -> Scene Props b -> Scene Props b
forall ctx a. ctx -> Scene ctx a -> Scene ctx a
Box.Context Props
ctx (Scene Props b -> Scene Props b) -> Scene Props b -> Scene Props b
forall a b. (a -> b) -> a -> b
$ Orient -> ScaleFactor -> Scene Props a -> Scene Props b
iter Orient
curOrient (ScaleFactor -> ScaleFactor -> ScaleFactor
forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
mulFactors ScaleFactor
curScale ScaleFactor
newScale) Scene Props a
a
            where
                mulFactors :: (a, b) -> (a, b) -> (a, b)
mulFactors (a
x1, b
y1) (a
x2, b
y2) = (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
* a
x2, b
y1 b -> b -> b
forall a. Num a => a -> a -> a
* b
y2)

bestElemSizesRescaled :: ScaleFactor -> (Int, Int) -> (Int, Int)
bestElemSizesRescaled :: ScaleFactor -> (Int, Int) -> (Int, Int)
bestElemSizesRescaled (Double
scaleX, Double
scaleY) (Int
sizeX, Int
sizeY) = (Double -> Int -> Int
forall {a} {b} {a}.
(RealFrac a, Integral b, Integral a) =>
a -> a -> b
mul Double
scaleX Int
sizeX, Double -> Int -> Int
forall {a} {b} {a}.
(RealFrac a, Integral b, Integral a) =>
a -> a -> b
mul Double
scaleY Int
sizeY)
    where mul :: a -> a -> b
mul a
d a
n = a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
d a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n

bestElemSizes :: Orient -> Elem -> (Int, Int)
bestElemSizes :: Orient -> Elem -> (Int, Int)
bestElemSizes Orient
orient Elem
x = case Elem
x of
    -- valuators
    Count   ValDiap
_ Double
_ Maybe Double
_   -> (Int
120, Int
30)
    Joy     ValSpan
_ ValSpan
_     -> (Int
200, Int
200)
    Knob    ValSpan
_       -> (Int
80, Int
80)
    Roller  ValSpan
_ Double
_     -> (Int, Int) -> (Int, Int)
forall {a}. (a, a) -> (a, a)
inVer (Int
150, Int
30)
    Slider  ValSpan
_       -> (Int, Int) -> (Int, Int)
forall {a}. (a, a) -> (a, a)
inVer (Int
150, Int
25)
    Text    ValDiap
_ Double
_     -> (Int
100, Int
35)

    -- other widgets
    Box     Text
label    ->
        let symbolsPerLine :: Int
symbolsPerLine = Int
60
            numOfLines :: Int
numOfLines = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Text -> Int
Text.length Text
label) Int
symbolsPerLine
        in  (Int -> Int -> Int
xBox Int
15 Int
symbolsPerLine, Int -> Int -> Int
yBox Int
15 Int
numOfLines)

    ButBank Int
xn Int
yn   -> (Int
xn Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
70, Int
yn Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
35)
    Button InstrId
_        -> (Int
75, Int
35)
    Elem
Toggle          -> (Int
75, Int
35)
    Elem
Value           -> (Int
80, Int
35)
    Elem
Vkeybd          -> (Int
1080, Int
240)

    -- error
    GuiVar GuiHandle
h        -> GuiHandle -> (Int, Int)
forall a. GuiHandle -> a
orphanGuiVar GuiHandle
h
    where inVer :: (a, a) -> (a, a)
inVer (a
a, a
b) = case Orient
orient of
            Orient
Ver -> (a
a, a
b)
            Orient
Hor -> (a
b, a
a)

------------------------------------------------------------
-- FLbox font coefficients

xBox, yBox :: Int -> Int -> Int

xBox :: Int -> Int -> Int
xBox Int
fontSize Int
xn = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
0.6 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xn)

yBox :: Int -> Int -> Int
yBox Int
fontSize Int
yn = (Int
fontSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yn)

yLabelBox :: Int -> Int
yLabelBox :: Int -> Int
yLabelBox Int
fontSize = Int
fontSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5

------------------------------------------------------------
-- set properties

flSetAll :: Var -> PropCtx -> Doc
flSetAll :: Var -> PropCtx -> Doc
flSetAll Var
handle PropCtx
ctx = [Doc] -> Doc
P.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Var -> PropCtx -> Doc) -> Doc)
-> [Var -> PropCtx -> Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Var -> PropCtx -> Doc
f -> Var -> PropCtx -> Doc
f Var
handle PropCtx
ctx)
    [ Var -> PropCtx -> Doc
flSetColor, Var -> PropCtx -> Doc
flSetColor2, Var -> PropCtx -> Doc
flSetTextColor
    , Var -> PropCtx -> Doc
flSetTextSize, Var -> PropCtx -> Doc
flSetTextType, Var -> PropCtx -> Doc
flSetFont ]

flSetColor, flSetColor2, flSetTextColor, flSetTextSize, flSetTextType,
    flSetFont :: Var -> PropCtx -> Doc

flSetProp :: Text
    -> (PropCtx -> Maybe a)
    -> (PropCtx -> Doc)
    -> Var -> PropCtx -> Doc
flSetProp :: forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
name PropCtx -> Maybe a
isDef PropCtx -> Doc
select Var
handle PropCtx
ctx
    | Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ PropCtx -> Maybe a
isDef PropCtx
ctx = Doc
P.empty
    | Bool
otherwise             = Text -> [Doc] -> Doc
ppProc Text
name [PropCtx -> Doc
select PropCtx
ctx, Var -> Doc
ppVar Var
handle]

flSetColor :: Var -> PropCtx -> Doc
flSetColor        = Text
-> (PropCtx -> Maybe Color)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetColor"        PropCtx -> Maybe Color
ctxColor1       PropCtx -> Doc
getColor1
flSetColor2 :: Var -> PropCtx -> Doc
flSetColor2       = Text
-> (PropCtx -> Maybe Color)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetColor2"       PropCtx -> Maybe Color
ctxColor2       PropCtx -> Doc
getColor2
flSetTextColor :: Var -> PropCtx -> Doc
flSetTextColor    = Text
-> (PropCtx -> Maybe Color)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetTextColor"    PropCtx -> Maybe Color
ctxTextColor    PropCtx -> Doc
getTextColor
flSetTextSize :: Var -> PropCtx -> Doc
flSetTextSize     = Text
-> (PropCtx -> Maybe Int)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetTextSize"     (Maybe Int -> PropCtx -> Maybe Int
forall a b. a -> b -> a
const (Maybe Int -> PropCtx -> Maybe Int)
-> Maybe Int -> PropCtx -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
15 :: Int)) PropCtx -> Doc
getFontSize
flSetTextType :: Var -> PropCtx -> Doc
flSetTextType     = Text
-> (PropCtx -> Maybe LabelType)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetTextType"     PropCtx -> Maybe LabelType
ctxLabelType    PropCtx -> Doc
getLabelType
flSetFont :: Var -> PropCtx -> Doc
flSetFont         = Text
-> (PropCtx -> Maybe FontType)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
forall a.
Text
-> (PropCtx -> Maybe a)
-> (PropCtx -> Doc)
-> Var
-> PropCtx
-> Doc
flSetProp Text
"FLsetFont"         PropCtx -> Maybe FontType
ctxFontType     PropCtx -> Doc
getFontType

flSetVal_i :: InitMe -> Doc
flSetVal_i :: InitMe -> Doc
flSetVal_i (InitMe Var
handle Double
v0) = Text -> [Doc] -> Doc
ppProc Text
"FLsetVal_i" [Double -> Doc
P.double Double
v0, Var -> Doc
ppVar Var
handle]

------------------------------------------------------------
-- extract handle.Hor

getPropHandle :: [Var] -> Maybe Var
getPropHandle :: [Var] -> Maybe Var
getPropHandle [Var]
xs = case [Var]
xs of
    [] -> Maybe Var
forall a. Maybe a
Nothing
    [Var]
_  -> Var -> Maybe Var
forall a. a -> Maybe a
Just ([Var] -> Var
forall a. HasCallStack => [a] -> a
last [Var]
xs)

------------------------------------------------------------
-- error messages

orphanGuiVar :: GuiHandle -> a
orphanGuiVar :: forall a. GuiHandle -> a
orphanGuiVar (GuiHandle Int
n) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"orphan GuiHandle: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n