Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Panel
- data Win = Win {}
- data GuiNode = GuiNode {}
- newtype GuiHandle = GuiHandle {
- unGuiHandle :: Int
- newtype Gui = Gui {
- unGui :: LowGui
- data Elem
- data InitMe = InitMe {
- initHandle :: Var
- initValue :: Double
- restoreTree :: GuiMap -> Gui -> Gui
- guiMap :: [GuiNode] -> GuiMap
- mapGuiOnPanel :: (Gui -> Gui) -> Panel -> Panel
- fromElem :: ElemOuts -> [InitMe] -> Elem -> Gui
- fromGuiHandle :: GuiHandle -> Gui
- panelIsKeybdSensitive :: Panel -> Bool
- defText :: String -> Gui
- guiStmt :: Monad m => ScaleFactor -> [Panel] -> DepT m ()
- hor :: [Gui] -> Gui
- ver :: [Gui] -> Gui
- space :: Gui
- sca :: Double -> Gui -> Gui
- horSca :: [(Double, Gui)] -> Gui
- verSca :: [(Double, Gui)] -> Gui
- padding :: Int -> Gui -> Gui
- margin :: Int -> Gui -> Gui
- type ScaleFactor = (Double, Double)
- resizeGui :: ScaleFactor -> Gui -> Gui
- props :: [Prop] -> Gui -> Gui
- forceProps :: [Prop] -> Gui -> Gui
- 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 BorderType
- type Color = Colour Double
- data Rect = Rect {}
- data FontType
- data Emphasis
- = NoEmphasis
- | Italic
- | Bold
- | BoldItalic
- data Material
- data Orient
- data LabelType
- setBorder :: BorderType -> Gui -> Gui
- setLabel :: String -> Gui -> Gui
- setMaterial :: Material -> Gui -> Gui
- setLabelType :: LabelType -> Gui -> Gui
- setColor1 :: Color -> Gui -> Gui
- setColor2 :: Color -> Gui -> Gui
- setColors :: Color -> Color -> Gui -> Gui
- setTextColor :: Color -> Gui -> Gui
- setFontSize :: Int -> Gui -> Gui
- setFontType :: FontType -> Gui -> Gui
- setEmphasis :: Emphasis -> Gui -> Gui
- setOrient :: Orient -> Gui -> Gui
- data ValDiap = ValDiap {
- valDiapMin :: Double
- valDiapMax :: Double
- type ValStep = Double
- data ValScaleType
- data ValSpan = ValSpan {}
- linSpan :: Double -> Double -> ValSpan
- expSpan :: Double -> Double -> ValSpan
- uspan :: ValSpan
- bspan :: ValSpan
- uspanExp :: ValSpan
- data KnobType
- setKnobType :: KnobType -> Gui -> Gui
- data SliderType
- setSliderType :: SliderType -> Gui -> Gui
- data TextType
- = NormalText
- | NoDrag
- | NoEdit
- setTextType :: TextType -> Gui -> Gui
- data BoxType
- setBoxType :: BoxType -> Gui -> Gui
- data ButtonType
- setButtonType :: ButtonType -> Gui -> Gui
- panel :: Gui -> SE ()
- keyPanel :: Gui -> SE ()
- tabs :: [(String, Gui)] -> SE ()
- keyTabs :: [(String, Gui)] -> SE ()
- panels :: [Gui] -> SE ()
- keyPanels :: [Gui] -> SE ()
- panelBy :: String -> Maybe Rect -> Gui -> SE ()
- keyPanelBy :: String -> Maybe Rect -> Gui -> SE ()
- tabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE ()
- keyTabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE ()
- type Input a = a
- type Output a = a -> SE ()
- type Inner = SE ()
- noInput :: Input ()
- noOutput :: Output ()
- noInner :: Inner
- type Widget a b = SE (Gui, Output a, Input b, Inner)
- widget :: SE (Gui, Output a, Input b, Inner) -> Widget a b
- type Source a = SE (Gui, Input a)
- source :: SE (Gui, Input a) -> Source a
- type Sink a = SE (Gui, Output a)
- sink :: SE (Gui, Output a) -> Sink a
- type Display = SE Gui
- display :: SE Gui -> Display
- type SinkSource a = SE (Gui, Output a, Input a)
- sinkSource :: SE (Gui, Output a, Input a) -> SinkSource a
- sourceSlice :: SinkSource a -> Source a
- sinkSlice :: SinkSource a -> Sink a
- mapSource :: (a -> b) -> Source a -> Source b
- mapGuiSource :: (Gui -> Gui) -> Source a -> Source a
- mhor :: Monoid a => [Source a] -> Source a
- mver :: Monoid a => [Source a] -> Source a
- msca :: Double -> Source a -> Source a
- count :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source (Evt D)
- countSig :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source Sig
- joy :: ValSpan -> ValSpan -> (Double, Double) -> Source (Sig, Sig)
- knob :: String -> ValSpan -> Double -> Source Sig
- roller :: String -> ValSpan -> ValStep -> Double -> Source Sig
- slider :: String -> ValSpan -> Double -> Source Sig
- sliderBank :: String -> [Double] -> Source [Sig]
- numeric :: String -> ValDiap -> ValStep -> Double -> Source Sig
- meter :: String -> ValSpan -> Double -> Sink Sig
- box :: String -> Display
- button :: String -> Source (Evt Unit)
- butBank :: String -> Int -> Int -> (Int, Int) -> Source (Evt (D, D))
- butBankSig :: String -> Int -> Int -> (Int, Int) -> Source (Sig, Sig)
- butBank1 :: String -> Int -> Int -> (Int, Int) -> Source (Evt D)
- butBankSig1 :: String -> Int -> Int -> (Int, Int) -> Source Sig
- toggle :: String -> Bool -> Source (Evt D)
- toggleSig :: String -> Bool -> Source Sig
- setNumeric :: String -> ValDiap -> ValStep -> Double -> Sink Sig
- setToggle :: String -> Bool -> SinkSource (Evt D)
- setToggleSig :: String -> Bool -> SinkSource Sig
- setKnob :: String -> ValSpan -> Double -> SinkSource Sig
- setSlider :: String -> ValSpan -> Double -> SinkSource Sig
- setTitle :: String -> Gui -> SE Gui
- data KeyEvt
- data Key
- = CharKey Char
- | F1
- | F2
- | F3
- | F4
- | F5
- | F6
- | F7
- | F8
- | F9
- | F10
- | F11
- | F12
- | Scroll
- | CapsLook
- | LeftShift
- | RightShift
- | LeftCtrl
- | RightCtrl
- | Enter
- | LeftAlt
- | RightAlt
- | LeftWinKey
- | RightWinKey
- | Backspace
- | ArrowUp
- | ArrowLeft
- | ArrowRight
- | ArrowDown
- | Insert
- | Home
- | PgUp
- | Delete
- | End
- | PgDown
- | NumLock
- | NumDiv
- | NumMul
- | NumSub
- | NumHome
- | NumArrowUp
- | NumPgUp
- | NumArrowLeft
- | NumSpace
- | NumArrowRight
- | NumEnd
- | NumArrowDown
- | NumPgDown
- | NumIns
- | NumDel
- | NumEnter
- | NumPlus
- | Num7
- | Num8
- | Num9
- | Num4
- | Num5
- | Num6
- | Num1
- | Num2
- | Num3
- | Num0
- | NumDot
- keyIn :: KeyEvt -> Evt Unit
Documentation
restoreTree :: GuiMap -> Gui -> Gui Source #
fromGuiHandle :: GuiHandle -> Gui Source #
panelIsKeybdSensitive :: Panel -> Bool Source #
Layout
Horizontal groupping of the elements. All elements are placed in the stright horizontal line and aligned by Y-coordinate and height.
Vertical groupping of the elements. All elements are placed in the stright vertical line and aligned by X-coordinate and width.
sca :: Double -> Gui -> Gui Source #
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]
horSca :: [(Double, Gui)] -> Gui Source #
Weighted horizontal grouping. It takes a list of scaling factors and elements.
verSca :: [(Double, Gui)] -> Gui Source #
Weighted vertical grouping. It takes a list of scaling factors and elements.
padding :: Int -> Gui -> Gui Source #
Sets the padding of the element. How much empty space to reserve outside the element.
margin :: Int -> Gui -> Gui Source #
Sets the margin of the element. How much empty space to reserve between the elements within the group. It affects only compound elements.
type ScaleFactor = (Double, Double) Source #
Props
Properties of the widgets.
data BorderType Source #
Instances
Enum BorderType Source # | |
Defined in Csound.Typed.Gui.Types succ :: BorderType -> BorderType # pred :: BorderType -> BorderType # toEnum :: Int -> BorderType # fromEnum :: BorderType -> Int # enumFrom :: BorderType -> [BorderType] # enumFromThen :: BorderType -> BorderType -> [BorderType] # enumFromTo :: BorderType -> BorderType -> [BorderType] # enumFromThenTo :: BorderType -> BorderType -> BorderType -> [BorderType] # |
A rectangle.
The type of the material of the element. It affects sliders and buttons.
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.
Some values are not implemented on the Csound level.
Setters
Handy short-cuts for the function props
.
Widgets
The diapason of the continuous value.
ValDiap | |
|
A value span is a diapason of the value and a type of the scale (can be linear or exponential).
linSpan :: Double -> Double -> ValSpan Source #
Makes a linear ValSpan
with specified boundaries.
linSpan minVal maxVal
expSpan :: Double -> Double -> ValSpan Source #
Makes an exponential ValSpan
with specified boundaries.
expSpan minVal maxVal
data SliderType Source #
Instances
Default SliderType Source # | |
Defined in Csound.Typed.Gui.Types def :: SliderType # |
setSliderType :: SliderType -> Gui -> Gui Source #
The type of the box. Some values are not implemented on the Csound level.
Instances
Enum BoxType Source # | |
Default BoxType Source # | |
Defined in Csound.Typed.Gui.Types |
data ButtonType Source #
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).
Instances
Default ButtonType Source # | |
Defined in Csound.Typed.Gui.Types def :: ButtonType # |
setButtonType :: ButtonType -> Gui -> Gui Source #
Panels
panel :: Gui -> SE () Source #
Renders the GUI elements on the window. Rectangle is calculated automatically (window doesn't listens for keyboard events).
keyPanel :: Gui -> SE () Source #
Renders the GUI elements on the window. Rectangle is calculated automatically (window listens for keyboard events).
tabs :: [(String, Gui)] -> SE () Source #
Renders the GUI elements with tabs. Rectangles are calculated automatically.
keyTabs :: [(String, Gui)] -> SE () Source #
Renders the GUI elements with tabs. Rectangles are calculated automatically.
keyPanels :: [Gui] -> SE () Source #
Renders a list of panels. Panels are sensitive to keyboard events.
panelBy :: String -> Maybe Rect -> Gui -> SE () Source #
Renders the GUI elements on the window. We can specify the window title and rectangle of the window.
keyPanelBy :: String -> Maybe Rect -> Gui -> SE () Source #
Renders the GUI elements on the window. We can specify the window title and rectangle of the window. Panesls are sensitive to keyboard events.
tabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE () Source #
Renders the GUI elements with tabs. We can specify the window title and rectangles for all tabs and for the main window.
keyTabsBy :: String -> Maybe Rect -> [(String, Maybe Rect, Gui)] -> SE () Source #
Renders the GUI elements with tabs. We can specify the window title and rectangles for all tabs and for the main window. Tabs are sensitive to keyboard events.
Types
type Widget a b = SE (Gui, Output a, Input b, Inner) Source #
A widget consists of visible element (Gui), value consumer (Output) and producer (Input) and an inner state (Inner).
sinkSource :: SE (Gui, Output a, Input a) -> SinkSource a Source #
sourceSlice :: SinkSource a -> Source a Source #
sinkSlice :: SinkSource a -> Sink a Source #
mapSource :: (a -> b) -> Source a -> Source b Source #
A handy function for transforming the value of producers.
mapGuiSource :: (Gui -> Gui) -> Source a -> Source a Source #
A handy function for transforming the GUIs of producers.
mhor :: Monoid a => [Source a] -> Source a Source #
Horizontal grouping of widgets that can produce monoidal values.
mver :: Monoid a => [Source a] -> Source a Source #
Vertical grouping of widgets that can produce monoidal values.
Widgets
count :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source (Evt D) Source #
Allows the user to increase/decrease a value with mouse clicks on a corresponding arrow button. Output is an event stream that contains values when counter changes.
count diapason fineValStep maybeCoarseValStep initValue
countSig :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source Sig Source #
A variance on the function count
, but it produces
a signal of piecewise constant function.
joy :: ValSpan -> ValSpan -> (Double, Double) -> Source (Sig, Sig) Source #
It is a squared area that allows the user to modify two output values at the same time. It acts like a joystick.
joy valueSpanX valueSpanY (initX, initY)
knob :: String -> ValSpan -> Double -> Source Sig Source #
A FLTK widget opcode that creates a knob.
knob valueSpan initValue
roller :: String -> ValSpan -> ValStep -> Double -> Source Sig Source #
FLroller is a sort of knob, but put transversally.
roller valueSpan step initVal
slider :: String -> ValSpan -> Double -> Source Sig Source #
FLslider puts a slider into the corresponding container.
slider valueSpan initVal
sliderBank :: String -> [Double] -> Source [Sig] Source #
Constructs a list of linear unit sliders (ranges in [0, 1]). It takes a list of init values.
numeric :: String -> ValDiap -> ValStep -> Double -> Source Sig Source #
numeric (originally FLtext in the Csound) allows the user to modify a parameter value by directly typing it into a text field.
numeric diapason step initValue
meter :: String -> ValSpan -> Double -> Sink Sig Source #
A slider that serves as indicator. It consumes values instead of producing.
meter valueSpan initValue
box :: String -> Display Source #
A FLTK widget that displays text inside of a box. If the text is longer than 255 characters the text is split on several parts (Csound limitations).
box text
button :: String -> Source (Evt Unit) Source #
A FLTK widget opcode that creates a button.
button text
butBank :: String -> Int -> Int -> (Int, Int) -> Source (Evt (D, D)) Source #
A FLTK widget opcode that creates a bank of buttons. Result is (x, y) coordinate of the triggered button.
butBank xNumOfButtons yNumOfButtons
butBankSig :: String -> Int -> Int -> (Int, Int) -> Source (Sig, Sig) Source #
A variance on the function butBank
, but it produces
a signal of piecewise constant function.
Result is (x, y) coordinate of the triggered button.
butBank1 :: String -> Int -> Int -> (Int, Int) -> Source (Evt D) Source #
A FLTK widget opcode that creates a bank of buttons.
butBank xNumOfButtons yNumOfButtons
toggle :: String -> Bool -> Source (Evt D) Source #
A FLTK widget opcode that creates a toggle button.
button text
toggleSig :: String -> Bool -> Source Sig Source #
A variance on the function toggle
, but it produces
a signal of piecewise constant function.
setNumeric :: String -> ValDiap -> ValStep -> Double -> Sink Sig Source #
FLtext that is sink shows current the value of a valuator in a text field.
setToggleSig :: String -> Bool -> SinkSource Sig Source #
Transformers
Keyboard
Keyboard events.
Keys.