8. StdControl

Object I/O library supports various kinds of built-in controls which can be placed inside windows and dialogs. In order to define his/her own type controls, the user should give an instance of Controls class (see Section 7.1, “Windows creation.”)

class Controls cdef where
        controlToHandles :: cdef ls ps -> GUI ps [ControlState ls ps]

instance Controls c => Controls (AddLS c)
instance Controls c => Controls (NewLS c)
instance Controls c => Controls (ListLS c)
instance Controls NilLS
instance (Controls c1,Controls c2) => Controls (TupLS c1 c2)

For every user defined control we must have instance of Controls class. Controls can be combined with :+: (TupLS type) and ListLS constructors. With AddLS and NewLS we can extend or change the local state of a given group of controls. NilLS specifies empty control.

Controls can be dynamically added to an existing window with openControls function.

openControls :: Controls cdef => Id -> ls -> cdef ls ps -> GUI ps ()

8.1. Common

Control attributes

data    ControlAttribute ls ps                      -- Default:
 -- General control attributes:
 =      ControlActivate     (GUIFun ls ps)          -- return
 |      ControlDeactivate   (GUIFun ls ps)          -- return
 |      ControlFunction (GUIFun ls ps)              -- (\st->return st)
 |      ControlHide                                 -- initially visible
 |      ControlId       Id                          -- no id
 |      ControlKeyboard KeyboardStateFilter SelectState (KeyboardFunction ls ps)
                                                                                                -- no keyboard input/overruled
 |      ControlMinimumSize  Size                    -- zero
 |      ControlModsFunction (ModifiersFunction ls ps)
                                                                                                        -- ControlFunction
 |      ControlMouse        MouseStateFilter    SelectState (MouseFunction ls ps)
                                                                                        -- no mouse input/overruled
 |      ControlPen          [PenAttribute]          -- default pen attributes
 |      ControlPos          ItemPos                 -- (RightTo previous,zero)
 |      ControlResize       ControlResizeFunction   -- no resize
 |      ControlSelectState  SelectState             -- control Able
 |      ControlTip          String                  -- no tip
 |      ControlWidth        ControlWidth            -- system derived
 --     For CompoundControls only:
 |      ControlHMargin      Int Int                 -- system dependent
 |      ControlHScroll      ScrollFunction          -- no horizontal scrolling
 |      ControlItemSpace    Int Int                 -- system dependent
 |      ControlLook         Bool Look               -- control is transparant
 |      ControlOrigin       Point2                  -- Left top of ViewDomain
 |      ControlOuterSize    Size                    -- enclose elements
 |      ControlViewDomain   ViewDomain              -- {zero,max range}
 |      ControlViewSize     Size                    -- enclose elements
 |      ControlVMargin      Int Int                 -- system dependent
 |      ControlVScroll      ScrollFunction          -- no vertical   scrolling


type ControlResizeFunction =
        Size ->                                                 -- current control outer size
        Size ->                                                 -- old     parent  view  size
        Size ->                                                 -- new     parent  view  size
        Size                                                    -- new     control outer size

data    RowsOrColumns
 = Rows       Int
 | Columns    Int

data    ControlWidth                                -- The width of the control:
 =      PixelWidth   Int                            -- the exact number of pixels
 |      TextWidth    String                         -- the exact string width in dialog font
 |      ContentWidth String                         -- width of the control as if string is its content

8.1.1. Utils

getParentWindowId :: Id -> GUI ps (Maybe Id)

controlSize :: (Controls cdef) => cdef ls ps -> Bool -> Maybe (Int,Int) -> Maybe (Int,Int) -> Maybe (Int,Int) -> GUI ps Size
getParentWindowId

returns id of parent window of control with specified Id

controlSize

giving horizontal and vertical margins and item spaces calculates the size of the given control.

theSize <- controlSize (ButtonControl "Ok" []) isWindow (Just (left, right)) (Just (top, bottom)) (Just (horz,vert))

8.1.2. Show/Hide controls

showControls :: [Id] -> GUI ps ()
showControl :: Id -> GUI ps ()

hideControls :: [Id] -> GUI ps ()
hideControl :: Id -> GUI ps ()

setControlsShowState :: Bool -> [Id] -> GUI ps ()

getControlShowStates :: [Id] -> GUI ps [(Bool,Bool)]
getControlShowState :: Id -> GUI ps (Bool,Bool)
showControls,showControl

shows a given control or a set of controls

hideControls,hideControl

hides a given control or a set of controls

setControlsShowState

shows or hides a given set of controls according to the given boolean parameter

getControlShowStates,getControlShowState

returns current show state of the given control or set of controls

8.1.3. Enabling/Disabling of controls

enableControls :: [Id] -> GUI ps ()
enableControl :: Id -> GUI ps ()

disableControls :: [Id] -> GUI ps ()
disableControl :: Id -> GUI ps ()

getControlSelectStates :: [Id] -> GUI ps [(Bool,SelectState)]
getControlSelectState :: Id -> GUI ps (Bool,SelectState)
enableControls,enableControl

enables given control or set of controls

disableControls,disableControl

disables given control or set of controls

getControlSelectStates,getControlSelectState

returns current select state of given control or set of controls

8.1.4. Getting and setting text of EditControl, TextControl and ButtonControl

setControlTexts :: [(Id,String)] -> GUI ps ()
setControlText :: Id -> String -> GUI ps ()

getControlTexts :: [Id] -> GUI ps [(Bool,Maybe String)]
getControlText :: Id -> GUI ps (Bool,Maybe String)
setControlTexts, setControlText

Change the text of given control or set of controls.

getControlTexts, getControlText

returns the text of given control or set of controls.

8.1.5. Drawing in CustomControl, CustomButtonControl and CompoundControl

drawInControl :: Id -> Draw x -> GUI ps (Maybe x)

updateControl :: Id -> Maybe ViewFrame -> GUI ps ()

setControlLooks :: [(Id,Bool,(Bool,Look))] -> GUI ps ()
setControlLook :: Id -> Bool -> (Bool,Look) -> GUI ps ()

getControlLooks :: [Id] -> GUI ps [(Bool,Maybe (Bool,Look))]
getControlLook :: Id -> GUI ps (Bool,Maybe (Bool,Look))
setControlLooks, setControlLook

change the Look of the corresponding control or set of controls but redraw only if the first boolean parameter is True

getControlLooks, getControlLook

returns current controls look

drawInControl

direct draw in control

updateControl

update look of control

See Section 10, “StdPicture” for details about drawing.

8.1.6. Positioning and resizing of controls

setControlPos :: Id -> [(Id,ItemPos)] -> GUI ps Bool

getControlViewSizes :: [Id] -> GUI ps [(Bool,Size)]
getControlViewSize :: Id -> GUI ps (Bool,Size)

getControlOuterSizes :: [Id] -> GUI ps [(Bool,Size)]
getControlOuterSize :: Id -> GUI ps (Bool,Size)

getControlMinimumSizes :: [Id] -> GUI ps [(Bool,Maybe Size)]
getControlMinimumSize :: Id -> GUI ps (Bool,Maybe Size)

getControlResizes :: [Id] -> GUI ps [(Bool,Maybe ControlResizeFunction)]
getControlResize :: Id -> GUI ps (Bool,Maybe ControlResizeFunction)
setControlPos

repositions control to given position

getControlViewSizes, getControlViewSize

returns current view size

getControlOuterSizes, getControlOuterSize

returns current view size including the size of border

getControlMinimumSizes, getControlMinimumSize

returns the minimal valid size when resizing

getControlResizes, getControlResize

returns the control resizing function. When the parent window of a given control is resized, then the control can be resized if it has a resize function.

8.2. ButtonControl

Data definition

data    ButtonControl ls ps
 =      ButtonControl String                                                    [ControlAttribute ls ps]

Section 8.1.4, “Getting and setting text of EditControl, TextControl and ButtonControl” describes how to get or set the caption of a button

8.3. CheckControl

Data definition

data    CheckControl  ls ps
  =     CheckControl  [CheckControlItem ps (ls,ps)]  RowsOrColumns              [ControlAttribute ls ps]

type    CheckControlItem ps st = (String, Maybe ControlWidth, MarkState, st -> GUI ps st)

Access functions:

setControlsMarkState :: MarkState -> Id -> [Index] -> GUI ps ()
markCheckControlItems :: Id -> [Index] -> GUI ps ()
unmarkCheckControlItems :: Id -> [Index] -> GUI ps ()

getCheckControlItems :: [Id] -> GUI ps [(Bool,Maybe [String])]
getCheckControlItem :: Id -> GUI ps (Bool,Maybe [String])

getCheckControlSelections :: [Id] -> GUI ps [(Bool,Maybe [Index])]
getCheckControlSelection :: Id -> GUI ps (Bool,Maybe [Index])
setControlsMarkState

This function is used for marking/unmarking of the check control according to the MarkState value.

markCheckControlItems

This function is used for marking of check controls.

markCheckControlItems = setControlsMarkState Mark
unmarkCheckControlItems

This function is used for unmarking of check controls.

unmarkCheckControlItems = setControlsMarkState Unmark
getCheckControlItems, getCheckControlItem

returns the list of items for a given control or set of controls

getCheckControlSelections, getCheckControlSelection

returns a the list of indexes for selected items

8.4. CompoundControl

The compound control is a control that contains other controls. It introduces a new layout scope like LayoutControl (see Section 8.8, “LayoutControl”) but it provides programmers with a lot more functionality. Just like the windows, the compound controls have a view domain and can have its own Look function. If we add ControlHScroll or ControlVScroll then the control will be decorated with scroll bars.

Data definition

data    CompoundControl c ls ps
 =      CompoundControl (c ls ps)                                               [ControlAttribute ls ps]

Access functions:

getControlViewFrame :: Id -> GUI ps (Bool,Maybe ViewFrame)
getControlViewFrames :: [Id] -> GUI ps [(Bool,Maybe ViewFrame)]

moveControlViewFrame :: Id -> Vector2 -> GUI ps ()

setControlViewDomain :: Id -> ViewDomain -> GUI ps ()

getControlViewDomain :: Id -> GUI ps (Bool,Maybe ViewDomain)
getControlViewDomains :: [Id] -> GUI ps [(Bool,Maybe ViewDomain)]

setControlScrollFunction :: Id -> Direction -> ScrollFunction -> GUI ps ()

getControlScrollFunction ::   Id  -> GUI ps  (Bool,Maybe ((Direction,Maybe ScrollFunction),(Direction,Maybe ScrollFunction)))
getControlScrollFunctions :: [Id] -> GUI ps [(Bool,Maybe ((Direction,Maybe ScrollFunction),(Direction,Maybe ScrollFunction)))]

openCompoundControls :: Controls cdef => Id -> ls -> cdef ls ps -> GUI ps ()
getControlViewFrames, getControlViewFrame

ViewFrame is the current visible Rectangle of CompoundControl. When there are horizontal and vertical scroll bars then the changing of the scroller thumb will change the ViewFrame.

moveControlViewFrame :: Id -> Vector2 -> GUI ps ()

moves the ViewFrame of the CompoundControl in the direction of the given vector.

getControlViewDomains, getControlViewDomain

ViewDomain is the Rectangle, which specifies the logical drawing area of the CompoundControl.

setControlViewDomain :: Id -> ViewDomain -> GUI ps ()

sets a new view domain of the CompoundControl.

setControlScrollFunction :: Id -> Direction -> ScrollFunction -> GUI ps ()

sets a new scroll function of the CompoundControl.

getControlScrollFunction, getControlScrollFunctions

getControlScrollFunction(s) yields the ScrollFunctions of the indicated CompoundControl. If the given control is not a CompoundControl, then Nothing is returned.

openCompoundControls :: Controls cdef => Id -> ls -> cdef ls ps -> GUI ps ()

openCompoundControls adds controls to the indicated CompoundControl.

Section 8.1.5, “Drawing in CustomControl, CustomButtonControl and CompoundControl” describes how to draw inside the CompoundControl

8.5. CustomButtonControl

CustomButtonControl is like the ButtonControl but has its own Look and doesn't accept the ControlTitle attribute

data    CustomButtonControl ls ps
 =      CustomButtonControl Size Look [ControlAttribute ls ps]

Section 8.1.5, “Drawing in CustomControl, CustomButtonControl and CompoundControl” describes how to draw inside the CustomButtonControl

8.6. CustomControl

CustomControl allows the programmer to design his/her own controls.

data    CustomControl       ls ps
 =      CustomControl Size Look [ControlAttribute ls ps]

Section 8.1.5, “Drawing in CustomControl, CustomButtonControl and CompoundControl” describes how to draw inside the CustomControl

8.7. EditControl

Data definition

data EditControl   ls ps
  =      EditControl   String ControlWidth NrLines [ControlAttribute ls ps]

type NrLines = Int

Access functions

setEditControlCursor :: Id -> Int -> GUI ps ()

getControlNrLines :: [Id] -> GUI ps [(Bool,Maybe NrLines)]
getControlNrLine :: Id -> GUI ps (Bool,Maybe NrLines)
setEditControlCursor

sets the cursor position

getControlsNrLines, getControlNrLines

returns the number of lines that can be seen (on the screen at the moment) for a given control

Section 8.1.4, “Getting and setting text of EditControl, TextControl and ButtonControl” describes how to get or set the text of an edit control

8.8. LayoutControl

The layout control is a control that contains other controls. It introduces a new layout scope: i.e. the controls inside it are positioned in relation to the bounds of the layout control.

data    LayoutControl     c ls ps
 =      LayoutControl     (c ls ps)                                             [ControlAttribute ls ps]

8.9. PopUpControl

Data definition

data    PopUpControl    ls ps
  =     PopUpControl    [PopUpControlItem ps (ls,ps)] Index                     [ControlAttribute ls ps]
type    PopUpControlItem ps st = (String,                                st -> GUI ps st)

Access functions

openPopUpControlItems :: Id -> Index -> [PopUpControlItem ps ps] -> GUI ps ()

closePopUpControlItems :: Id -> [Index] -> GUI ps ()

selectPopUpControlItem :: Id -> Index -> GUI ps ()

getPopUpControlItems :: [Id] -> GUI ps [(Bool,Maybe [String])]
getPopUpControlItem :: Id -> GUI ps (Bool,Maybe [String])

getPopUpControlSelections :: [Id] -> GUI ps [(Bool,Maybe Index)]
getPopUpControlSelection :: Id -> GUI ps (Bool,Maybe Index)
openPopUpControlItems

openPopUpControlItems adds items to the PopUpControl.

closePopUpControlItems

deletes a string in the list box of a popup control.

selectPopUpControlItem

selects a string in the list box of a popup control. If necessary, the list box scrolls the string into view (if the list box is visible). Any previous selection in the control is removed.

getPopUpControlsItems, getPopUpControlItems

returns a list of control items

getPopUpControlsSelection, getPopUpControlSelection

Call this function to determine which item in the popup control is selected. It returns an index into the list.

8.10. RadioControl

Data definition

data    RadioControl    ls ps
  =     RadioControl    [RadioControlItem ps (ls,ps)] RowsOrColumns Index       [ControlAttribute ls ps]

type    RadioControlItem ps st = (String, Maybe ControlWidth,            st -> GUI ps st)

Access functions

selectRadioControlItem :: Id -> Index -> GUI ps ()

getRadioControlSelections :: [Id] -> GUI ps [(Bool,Maybe Index)]
getRadioControlSelection :: Id -> GUI ps (Bool,Maybe Index)

getRadioControlItems :: [Id] -> GUI ps [(Bool,Maybe [String])]
getRadioControlItem :: Id -> GUI ps (Bool,Maybe [String])
selectRadioControlItem

sets a current selection of a radio control

getRadioControlSelections, getRadioControlSelection

returns the current control selection

getRadioControlItems, getRadioControlItem

returns the list of control items

8.11. SliderControl

Data definition

data    SliderControl   ls ps
 =      SliderControl   Direction ControlWidth SliderState  (SliderAction  ls ps) [ControlAttribute ls ps]

Access functions

setSliderStates :: [(Id,IdFun SliderState)] -> GUI ps ()
setSliderState :: Id -> IdFun SliderState -> GUI ps ()

setSliderThumbs :: [(Id,Int)] -> GUI ps ()
setSliderThumb :: Id -> Int -> GUI ps ()

getSliderStates :: [Id] -> GUI ps [(Bool,Maybe SliderState)]
getSliderState :: Id -> GUI ps (Bool,Maybe SliderState)

getSliderDirections :: [Id] -> GUI ps [(Bool,Maybe Direction)]
getSliderDirection :: Id -> GUI ps (Bool,Maybe Direction)
setSliderStates, setSliderState

changes the SliderState and redraws the settings of the SliderControls.

setSliderThumbs, setSliderThumb

changes the thumb values of the SliderState of SliderControl or a set of controls.

getSliderStates, getSliderState

gets a current SliderState.

getSliderDirections, getSliderDirection

gets the slider direction i. e. Horizontal or Vertical.

8.12. TextControl

This is a simple control that just displays its caption. In Section 8.1.4, “Getting and setting text of EditControl, TextControl and ButtonControl” is described how to change the caption.

data    TextControl   ls ps
 =      TextControl   String                                                    [ControlAttribute ls ps]

8.13. Controls closing

closeControls :: Id -> [Id] -> Bool -> GUI ps ()

closeAllControls :: Id -> GUI ps ()
closeControls

closes the specified controls in the indicated window.

closeAllControls

closes all controls in the indicated window.