ObjectIO-1.0.1.1: Graphics/UI/ObjectIO/StdControlClass.hs
-----------------------------------------------------------------------------
-- |
-- Module : StdControlClass
-- Copyright : (c) Krasimir Andreev 2002
-- License : BSD-style
--
-- Maintainer : ka2_mail@yahoo.com
-- Stability : provisional
-- Portability : portable
--
-- StdControlClass define the standard set of controls instances.
--
-----------------------------------------------------------------------------
module Graphics.UI.ObjectIO.StdControlClass (Controls(..), Graphics.UI.ObjectIO.Window.Handle.ControlState) where
import Graphics.UI.ObjectIO.CommonDef
import Graphics.UI.ObjectIO.Process.IOState
import Graphics.UI.ObjectIO.StdControlAttribute
import Graphics.UI.ObjectIO.Window.Handle
import Graphics.UI.ObjectIO.Window.Validate(validateViewDomain)
import Graphics.UI.ObjectIO.Control.Validate
import Graphics.UI.ObjectIO.StdIOCommon
import Graphics.UI.ObjectIO.StdPicture(stdUnfillUpdAreaLook)
import Graphics.UI.ObjectIO.OS.Font
import Graphics.UI.ObjectIO.OS.Types
import Graphics.UI.ObjectIO.OS.Window
import Graphics.UI.ObjectIO.OS.Picture(setPenAttribute, defaultPen)
import Graphics.UI.ObjectIO.OS.Rgn(osNoRgn)
import Data.List(find)
-- | For every user defined control we must have instance of Controls class.
-- There is also instances for 'AddLS', 'NewLS', 'ListLS', 'NilLS' and 'TupLS' data types.
-- Controls can be combined with ':+:' 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.
class Controls cdef where
controlToHandles :: cdef ls ps -> GUI ps [ControlState ls ps]
-- ^ controlToHandles translates control definition to internal representation
instance (Controls c) => Controls (AddLS c) where
controlToHandles (AddLS addLS addDef)
= do {
cs <- controlToHandles addDef;
return [wElementHandleToControlState
(WExtendLSHandle addLS (map controlStateToWElementHandle cs))
]
}
instance (Controls c) => Controls (NewLS c) where
controlToHandles (NewLS newLS newDef)
= do {
cs <- controlToHandles newDef;
return [wElementHandleToControlState
(WChangeLSHandle newLS (map controlStateToWElementHandle cs))
]
}
instance (Controls c) => Controls (ListLS c) where
controlToHandles (ListLS cDefs)
= do {
css <- sequence (map controlToHandles cDefs);
return [wElementHandleToControlState (WListLSHandle (map controlStateToWElementHandle (concat css)))]
}
instance Controls NilLS where
controlToHandles NilLS
= return []
instance (Controls c1,Controls c2) => Controls (TupLS c1 c2) where
controlToHandles (c1 :+: c2)
= do {
cs1 <- controlToHandles c1;
cs2 <- controlToHandles c2;
return (cs1 ++ cs2)
}
instance Controls ButtonControl where
controlToHandles (ButtonControl textLine atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getButtonSize wMetrics textLine cWidth);
return
[wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsButtonControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WButtonInfo (ButtonInfo {buttonInfoText=textLine})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
cWidth = getControlWidthAttribute atts
getButtonSize :: OSWindowMetrics -> String -> Maybe ControlWidth -> IO Size
getButtonSize wMetrics _ (Just (PixelWidth reqW))
= return (Size {w=wOK,h=hOK})
where
wOK = max (osGetButtonControlMinWidth wMetrics) reqW
hOK = osGetButtonControlHeight wMetrics
getButtonSize wMetrics _ (Just (TextWidth wtext))
= do {
width <- getDialogFontTextWidth wMetrics wtext;
let wOK = max (osGetButtonControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
where
hOK = osGetButtonControlHeight wMetrics
getButtonSize wMetrics _ (Just (ContentWidth wtext))
= do {
(width,hOK) <- osGetButtonControlSize wMetrics wtext;
let wOK = max (osGetButtonControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
getButtonSize wMetrics text Nothing
= do {
(width,hOK) <- osGetButtonControlSize wMetrics text;
let wOK = max (osGetButtonControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
instance Controls CheckControl where
controlToHandles (CheckControl items layout atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
infoItems <- liftIO (mapM (checkItemToInfo wMetrics) items);
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsCheckControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WCheckInfo (CheckInfo
{ checkItems = infoItems
, checkLayout= validateLayout (length items) layout
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = zero
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
checkItemToInfo :: OSWindowMetrics -> CheckControlItem ps (ls,ps) -> IO (CheckItemInfo ls ps)
checkItemToInfo wMetrics (text,Just (PixelWidth reqW),mark,f) =
let
wOK = max (osGetCheckControlItemMinWidth wMetrics) reqW
hOK = osGetCheckControlItemHeight wMetrics
in
return (CheckItemInfo {checkItem=(text,wOK,mark,f)
,checkItemSize=Size{w=wOK,h=hOK}
,checkItemPos=zero
,checkItemPtr=osNoWindowPtr})
checkItemToInfo wMetrics (text,Just (TextWidth wtext),mark,f) = do
w <- getDialogFontTextWidth wMetrics wtext
let wOK = max (osGetCheckControlItemMinWidth wMetrics) w
hOK = osGetCheckControlItemHeight wMetrics
return (CheckItemInfo{checkItem=(text,wOK,mark,f)
,checkItemSize=Size{w=wOK,h=hOK}
,checkItemPos=zero
,checkItemPtr=osNoWindowPtr})
checkItemToInfo wMetrics (text,Just (ContentWidth wtext),mark,f) = do
(w,hOK) <- osGetCheckControlItemSize wMetrics wtext
let wOK = max (osGetCheckControlItemMinWidth wMetrics) w
return (CheckItemInfo{checkItem=(text,wOK,mark,f)
,checkItemSize=Size{w=wOK,h=hOK}
,checkItemPos=zero
,checkItemPtr=osNoWindowPtr})
checkItemToInfo wMetrics (text,Nothing,mark,f) = do
(w,hOK) <- osGetCheckControlItemSize wMetrics text
let wOK = max (osGetCheckControlItemMinWidth wMetrics) w
return (CheckItemInfo{checkItem=(text,wOK,mark,f)
,checkItemSize=Size{w=wOK,h=hOK}
,checkItemPos=zero
,checkItemPtr=osNoWindowPtr})
instance Controls c => Controls (CompoundControl c) where
controlToHandles (CompoundControl controls atts)
= do {
cs <- controlToHandles controls;
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsCompoundControl
, wItemShow = isNothing (find isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WCompoundInfo (CompoundInfo
{ compoundDomain = rectangleToRect domain
, compoundOrigin = origin
, compoundHScroll = hScrollInfo
, compoundVScroll = vScrollInfo
, compoundLookInfo = CompoundLookInfo
{ compoundLook= LookInfo
{ lookFun = lookFun
, lookPen = pen
, lookSysUpdate = sysLook
}
, compoundClip=ClipState{clipRgn=osNoRgn,clipOk=False}
}
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = map controlStateToWElementHandle cs
, wItemVirtual = False
, wItemPos = zero
, wItemSize = zero
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
(_,lookAtt) = cselect isControlLook (ControlLook True stdUnfillUpdAreaLook) atts
(sysLook,lookFun) = getControlLookAtt lookAtt
defaultDomain = ControlViewDomain viewDomainRange{corner1=zero}
(_,domainAtt) = cselect isControlViewDomain defaultDomain atts
domain = validateViewDomain (getControlViewDomainAtt domainAtt)
(_,originAtt) = cselect isControlOrigin (ControlOrigin (corner1 domain)) atts
origin = validateOrigin domain (getControlOriginAtt originAtt)
pen = getInitialPen atts
hScrollInfo = case find isControlHScroll atts of
Just hScrollAtt -> Just ScrollInfo
{ scrollFunction = getControlHScrollFun hScrollAtt
, scrollItemPos = zero
, scrollItemSize = zero
, scrollItemPtr = osNoWindowPtr
}
Nothing -> Nothing
vScrollInfo = case find isControlVScroll atts of
Just vScrollAtt -> Just ScrollInfo
{ scrollFunction = getControlVScrollFun vScrollAtt
, scrollItemPos = zero
, scrollItemSize = zero
, scrollItemPtr = osNoWindowPtr
}
Nothing -> Nothing
instance Controls CustomButtonControl where
controlToHandles (CustomButtonControl (Size {w=w,h=h}) controlLook atts) = do
let size = Size{w=max 0 w,h=max 0 h}
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsCustomButtonControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WCustomButtonInfo (CustomButtonInfo {cButtonInfoLook=LookInfo{lookFun=controlLook,lookPen=getInitialPen atts,lookSysUpdate=True}})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
instance Controls CustomControl where
controlToHandles (CustomControl (Size {w=w,h=h}) controlLook atts) = do
let size = Size {w=max 0 w,h=max 0 h}
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsCustomControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WCustomInfo (CustomInfo {customInfoLook=LookInfo{lookFun=controlLook,lookPen=getInitialPen atts,lookSysUpdate=True}})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
instance Controls EditControl where
controlToHandles (EditControl textLine cWidth nrLines atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getEditSize wMetrics nrLines cWidth);
return
[wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsEditControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WEditInfo (EditInfo
{ editInfoText = textLine
, editInfoWidth = w size
, editInfoNrLines = nrLines
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
getEditSize :: OSWindowMetrics -> Int -> ControlWidth -> IO Size
getEditSize wMetrics nrLines (PixelWidth reqW)
= do {
(width,hOK) <- osGetEditControlSize wMetrics reqW nrLines;
let wOK = max (osGetEditControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
getEditSize wMetrics nrLines (TextWidth wtext)
= do {
width <- getDialogFontTextWidth wMetrics wtext;
(width1,hOK) <- osGetEditControlSize wMetrics width nrLines;
let wOK = max (osGetEditControlMinWidth wMetrics) width1
in return (Size {w=wOK,h=hOK})
}
getEditSize wMetrics nrLines (ContentWidth wtext)
= do {
width <- getDialogFontTextWidth wMetrics (wtext++"mm");
(width1,hOK) <- osGetEditControlSize wMetrics width nrLines;
let wOK = max (osGetEditControlMinWidth wMetrics) width1
in return (Size {w=wOK,h=hOK})
}
instance (Controls c) => Controls (LayoutControl c) where
controlToHandles (LayoutControl controls atts)
= do {
cs <- controlToHandles controls;
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsLayoutControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = NoWItemInfo
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = map controlStateToWElementHandle cs
, wItemVirtual = False
, wItemPos = zero
, wItemSize = zero
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
instance Controls PopUpControl where
controlToHandles (PopUpControl popUpItems index atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getPopUpSize wMetrics (map fst popUpItems) cWidth);
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsPopUpControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WPopUpInfo (PopUpInfo
{ popUpInfoItems = popUpItems
, popUpInfoIndex = validateIndex (length popUpItems) index
, popUpInfoEdit = Nothing
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})]
}
where
cWidth = getControlWidthAttribute atts
getPopUpSize :: OSWindowMetrics -> [String] -> (Maybe ControlWidth) -> IO Size
getPopUpSize wMetrics _ (Just (PixelWidth reqW)) =
let wOK = max (osGetPopUpControlMinWidth wMetrics) reqW
hOK = osGetPopUpControlHeight wMetrics
in
return (Size{w=wOK,h=hOK})
getPopUpSize wMetrics _ (Just (TextWidth wtext)) = do
w <- getDialogFontTextWidth wMetrics wtext
(let wOK = max (osGetPopUpControlMinWidth wMetrics) w
hOK = osGetPopUpControlHeight wMetrics
in return (Size{w=wOK,h=hOK}))
getPopUpSize wMetrics _ (Just (ContentWidth wtext)) = do
(w,hOK) <- osGetPopUpControlSize wMetrics [wtext]
(let wOK = max (osGetPopUpControlMinWidth wMetrics) w
in return (Size{w=wOK,h=hOK}))
getPopUpSize wMetrics itemtexts Nothing = do
(w,hOK) <- osGetPopUpControlSize wMetrics (if null itemtexts then ["MMMMMMMMMM"] else itemtexts)
(let wOK = max (osGetPopUpControlMinWidth wMetrics) w
in return (Size{w=wOK,h=hOK}))
instance Controls ListBoxControl where
controlToHandles (ListBoxControl listBoxItems nrLines multi atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getListBoxSize wMetrics (map fst3 listBoxItems) cWidth);
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsListBoxControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WListBoxInfo (ListBoxInfo
{ listBoxInfoItems = listBoxItems
, listBoxNrLines = nrLines
, listBoxInfoMultiSel = multi
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})]
}
where
fst3 (a,b,c) = a
cWidth = getControlWidthAttribute atts
getListBoxSize :: OSWindowMetrics -> [String] -> (Maybe ControlWidth) -> IO Size
getListBoxSize wMetrics _ (Just (PixelWidth reqW)) =
let wOK = max (osGetListBoxControlMinWidth wMetrics) reqW
hOK = osGetListBoxControlHeight wMetrics nrLines
in
return (Size{w=wOK,h=hOK})
getListBoxSize wMetrics _ (Just (TextWidth wtext)) = do
w <- getDialogFontTextWidth wMetrics wtext
(let wOK = max (osGetListBoxControlMinWidth wMetrics) w
hOK = osGetListBoxControlHeight wMetrics nrLines
in return (Size{w=wOK,h=hOK}))
getListBoxSize wMetrics _ (Just (ContentWidth wtext)) = do
(w,hOK) <- osGetListBoxControlSize wMetrics nrLines [wtext]
(let wOK = max (osGetListBoxControlMinWidth wMetrics) w
in return (Size{w=wOK,h=hOK}))
getListBoxSize wMetrics itemtexts Nothing = do
(w,hOK) <- osGetListBoxControlSize wMetrics nrLines (if null itemtexts then ["MMMMMMMMMM"] else itemtexts)
(let wOK = max (osGetListBoxControlMinWidth wMetrics) w
in return (Size{w=wOK,h=hOK}))
instance Controls RadioControl where
controlToHandles (RadioControl items layout index atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
infoItems <- liftIO (mapM (radioItemToInfo wMetrics) items);
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsRadioControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = let nrItems = length items in
WRadioInfo (RadioInfo
{ radioItems = infoItems
, radioLayout= validateLayout nrItems layout
, radioIndex = setBetween index 1 nrItems
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = zero
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})]
}
where
radioItemToInfo :: OSWindowMetrics -> (RadioControlItem ps (ls,ps)) -> IO (RadioItemInfo ls ps)
radioItemToInfo wMetrics (text,Just (PixelWidth reqW),f) =
let
wOK = max (osGetRadioControlItemMinWidth wMetrics) reqW
hOK = osGetRadioControlItemHeight wMetrics
in
return (RadioItemInfo {radioItem=(text,wOK,f)
, radioItemSize=Size{w=wOK,h=hOK}
, radioItemPos=zero
, radioItemPtr=osNoWindowPtr})
radioItemToInfo wMetrics (text,Just (TextWidth wtext),f) = do
w <- getDialogFontTextWidth wMetrics wtext
let wOK = max (osGetRadioControlItemMinWidth wMetrics) w
hOK = osGetRadioControlItemHeight wMetrics
return (RadioItemInfo{radioItem=(text,wOK,f)
,radioItemSize=Size{w=wOK,h=hOK}
,radioItemPos=zero
,radioItemPtr=osNoWindowPtr})
radioItemToInfo wMetrics (text,Just (ContentWidth wtext),f) = do
(w,hOK) <- osGetRadioControlItemSize wMetrics wtext
let wOK = max (osGetRadioControlItemMinWidth wMetrics) w
return (RadioItemInfo{radioItem=(text,wOK,f)
,radioItemSize=Size{w=wOK,h=hOK}
,radioItemPos=zero
,radioItemPtr=osNoWindowPtr})
radioItemToInfo wMetrics (text,Nothing,f) = do
(w,hOK) <- osGetRadioControlItemSize wMetrics text
let wOK = max (osGetRadioControlItemMinWidth wMetrics) w
return (RadioItemInfo{radioItem=(text,wOK,f)
,radioItemSize=Size{w=wOK,h=hOK}
,radioItemPos=zero
,radioItemPtr=osNoWindowPtr})
instance Controls SliderControl where
controlToHandles (SliderControl direction cWidth sliderState action atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getSliderSize wMetrics isHorizontal cWidth);
return [wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsSliderControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WSliderInfo (SliderInfo
{ sliderInfoDir = direction
, sliderInfoLength= (if isHorizontal then w else h) size -- PA: maybe this field is now redundant
, sliderInfoState = validateSliderState sliderState
, sliderInfoAction= action
})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
isHorizontal = direction == Horizontal
getSliderSize :: OSWindowMetrics -> Bool -> ControlWidth -> IO Size
getSliderSize wMetrics isHorizontal (PixelWidth reqW) = do
let (wOK,hOK) = osGetSliderControlSize wMetrics isHorizontal reqW
return (Size{w=wOK,h=hOK})
getSliderSize wMetrics isHorizontal (TextWidth wtext) = do
w <- getDialogFontTextWidth wMetrics wtext
let (wOK,hOK) = osGetSliderControlSize wMetrics isHorizontal w
return (Size{w=wOK,h=hOK})
getSliderSize wMetrics isHorizontal (ContentWidth wtext) = do
w <- getDialogFontTextWidth wMetrics wtext
let (wOK,hOK) = osGetSliderControlSize wMetrics isHorizontal w
return (Size{w=wOK,h=hOK})
instance Controls TextControl where
controlToHandles (TextControl textLine atts)
= do {
wMetrics <- accIOEnv ioStGetOSWindowMetrics;
size <- liftIO (getTextSize wMetrics textLine cWidth);
return
[wElementHandleToControlState
(WItemHandle
{ wItemId = getIdAttribute atts
, wItemNr = 0
, wItemKind = IsTextControl
, wItemShow = not (any isControlHide atts)
, wItemSelect = getSelectStateAttribute atts
, wItemInfo = WTextInfo (TextInfo {textInfoText=textLine})
, wItemAtts = filter (not . redundantAttribute) atts
, wItems = []
, wItemVirtual = False
, wItemPos = zero
, wItemSize = size
, wItemPtr = osNoWindowPtr
, wItemLayoutInfo = undefined
})
]
}
where
cWidth = getControlWidthAttribute atts
getTextSize :: OSWindowMetrics -> String -> Maybe ControlWidth -> IO Size
getTextSize wMetrics _ (Just (PixelWidth reqW))
= return (Size {w=wOK,h=hOK})
where
wOK = max (osGetTextControlMinWidth wMetrics) reqW
hOK = osGetTextControlHeight wMetrics
getTextSize wMetrics _ (Just (TextWidth wtext))
= do {
width <- getDialogFontTextWidth wMetrics wtext;
let wOK = max (osGetTextControlMinWidth wMetrics) width
hOK = osGetTextControlHeight wMetrics
in return (Size {w=wOK,h=hOK})
}
getTextSize wMetrics _ (Just (ContentWidth wtext))
= do {
(width,hOK) <- osGetTextControlSize wMetrics wtext;
let wOK = max (osGetTextControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
getTextSize wMetrics text Nothing
= do {
(width,hOK) <- osGetTextControlSize wMetrics text;
let wOK = max (osGetTextControlMinWidth wMetrics) width
in return (Size {w=wOK,h=hOK})
}
-- getDialogFontTextWidth is not the proper implementation because accScreenPicture class not yet implemented.
-- This version gives a crude estimation in terms of max width times text length.
getDialogFontTextWidth :: OSWindowMetrics -> String -> IO Int
getDialogFontTextWidth wMetrics text
= do {
(_,_,_,maxwidth) <- osGetFontMetrics Nothing (osmFont wMetrics);
return ((length text) * maxwidth)
}
getIdAttribute :: [ControlAttribute ls ps] -> Maybe Id
getIdAttribute atts = fmap getControlIdAtt (find isControlId atts)
getControlWidthAttribute :: [ControlAttribute ls ps] -> Maybe ControlWidth
getControlWidthAttribute atts = fmap getControlWidthAtt (find isControlWidth atts)
getSelectStateAttribute :: [ControlAttribute ls ps] -> Bool
getSelectStateAttribute atts = maybe True (enabled . getControlSelectStateAtt) (find isControlSelectState atts)
redundantAttribute :: ControlAttribute ls ps -> Bool
redundantAttribute (ControlId _) = True
redundantAttribute _ = False
getInitialPen :: [ControlAttribute ls ps] -> Pen
getInitialPen atts =
case find isControlPen atts of
Just penAttsAtt -> foldr setPenAttribute defaultPen (getControlPenAtt penAttsAtt)
Nothing -> defaultPen
validateLayout :: Int -> RowsOrColumns -> RowsOrColumns
validateLayout nrItems (Rows n) = Rows (setBetween n 1 nrItems)
validateLayout nrItems (Columns n) = Columns (setBetween n 1 nrItems)
validateIndex :: Int -> Index -> Index
validateIndex nrItems index
| isBetween index 1 nrItems = index
| otherwise = 1
validateOrigin :: ViewDomain -> Point2 -> Point2
validateOrigin (Rectangle{corner1=Point2{x=corX1, y=corY1}, corner2=Point2{x=corX2, y=corY2}}) (Point2{x=origX, y=origY})
= Point2 { x=setBetween origX corX1 corX2
, y=setBetween origY corY1 corY2
}