Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[wxhaskell-from-cvs @ 2004-07-22 18:30:02 by dleijen]

Improved support for initial attributes.

darcs-hash:20040722183007-deb31-55da7f38f4badbb054b2566cff5398d5ddd9082f.gz
  • Loading branch information...
commit 7decb8487bf7fda25d167cc78fc77c26bededf94 1 parent 229d240
dleijen authored
View
16 changes.txt
@@ -6,9 +6,9 @@
Version 0.7.1
-------------
-Not backward compatible changes:
+Non backward compatible changes:
- Added wildcards argument to the "fileSaveDialog" function.
-- Removed to call to "buttonSetDefault" in the "defaultButton"
+- Removed the call to "buttonSetDefault" in the "defaultButton"
property since GTK seems to enlarge the button in that case.
- Removed alignment argument for text controls
- Removed sorted and labels argument for choice and combo boxes.
@@ -16,10 +16,11 @@ Not backward compatible changes:
- Added default "stretch" to every toplevel layout, assuring that
such layout gets at least all available space assigned.
- (un)set "maximize box" when "resizeable" is set.
-
+- Removed default "wxTAB_TRAVERSAL" style on frames (to make the grid
+ work correctly).
Backward compatible additions:
-- Added wxGrid events.
+- Added wxGrid events and demo (samples/wx/Grid.hs).
- Improved signatures for wxGrid.
- Added "changes.txt" file :-)
- Added "HAS_RADIO_MENU_ITEMS" to "isDefined".
@@ -37,6 +38,7 @@ Backward compatible additions:
- Defaulted background color of "Frame"s to Color3DFace (as a Panel).
- Made the definition of "Closure" in "wrappers.h" more liberal to
support wxOCaml better.
+- Added "frameCentre" method
Bug fixes:
- HtmlLinkClicked events are now properly generated.
@@ -46,9 +48,3 @@ Bug fixes:
item and disregarded the parameter. Thanks to Olivier Spier for
sending a fix.
-WxWindows patches:
-- changed line 565 of src/generic/grid.cpp:
- , wxTE_PROCESS_TAB | wxTE_AUTO_SCROLL
- to
- , wxTE_PROCESS_TAB | wxTE_AUTO_SCROLL | wxTE_PROCESS_ENTER
-
View
2  samples/wx/Grid.hs
@@ -11,7 +11,7 @@ main
gui :: IO ()
gui
- = do f <- frame [text := "Grid test",clientSize := sz 10 10, style :~ \stl -> stl .-. wxTAB_TRAVERSAL]
+ = do f <- frame [text := "Grid test", style :~ \stl -> stl .-. wxTAB_TRAVERSAL]
-- use text control as logger
textlog <- textCtrl f [enabled := False, wrap := WrapNone]
View
8 samples/wx/ImageViewer.hs
@@ -62,11 +62,11 @@ imageViewer
status <- statusField [text := "Welcome to the wxHaskell ImageViewer"]
-- set the statusbar, menubar, layout, and add menu item event handlers
- set f [statusbar := [status]
- ,menubar := [file,hlp]
- ,layout := column 1 [hfill $ hrule 1 -- add divider between toolbar and scrolledWindow
+ -- note: set the layout before the menubar!
+ set f [layout := column 1 [hfill $ hrule 1 -- add divider between toolbar and scrolledWindow
,fill (widget sw)]
- ,clientSize := sz 300 200
+ ,statusbar := [status]
+ ,menubar := [file,hlp]
,on (menu about) := infoDialog f "About ImageViewer" "This is a wxHaskell demo"
,on (menu quit) := close f
,on (menu open) := onOpen f sw vbitmap mclose status
View
4 samples/wx/Layout.hs
@@ -15,8 +15,8 @@ gui
p <- panel f [] -- panel for color and tab management.
ok <- button p [text := "Ok", on command := close f]
can <- button p [text := "Cancel", on command := infoDialog f "Info" "Pressed 'Cancel'"]
- xinput <- textEntry p AlignRight [text := "100"]
- yinput <- textEntry p AlignRight [text := "100"]
+ xinput <- textEntry p [text := "100", alignment := AlignRight]
+ yinput <- textEntry p [text := "100", alignment := AlignRight]
set p [defaultButton := ok]
set f [layout := container p $
View
2  samples/wx/ListCtrl.hs
@@ -34,7 +34,7 @@ gui
f <- frame [text := "List Sample"]
-- panel: just for the nice grey color
p <- panel f []
- textlog <- textCtrl p WrapLine [enabled := False]
+ textlog <- textCtrl p [enabled := False, wrap := WrapLine]
-- use text control as logger
textCtrlMakeLogActiveTarget textlog
View
11 samples/wx/TimeFlowsEx.hs
@@ -62,6 +62,11 @@ timeFlows
flowText <- varGet vflowText
status <- statusField [text := flowText]
+ -- set layout (before the menubar!)
+ set f [ layout := fill $ widget p
+ , clientSize := sz 300 300 --initial size
+ ]
+
-- set menu and status bar
set f [ menuBar := [mfile,medit,mhelp]
, statusBar := [status]
@@ -80,10 +85,6 @@ timeFlows
, on drag := onDrag vmouseHistory
]
- -- set layout
- set f [ layout := fill $ widget p
- , clientSize := sz 300 300 --initial size
- ]
return ()
{-------------------------------------------------------------------------
@@ -103,7 +104,7 @@ showOptionDialog frame vtimeSpan vflowText status
-- create dialog
d <- dialog frame [text := "Options", resizeable := True]
p <- panel d []
- entry <- textEntry p AlignLeft [text := flowText]
+ entry <- textEntry p [text := flowText]
delay <- spinCtrl p 1 10 [selection := round timeSpan]
ok <- button p [text := "Ok"]
can <- button p [text := "Cancel"]
View
126 wx/src/Graphics/UI/WX/Attributes.hs
@@ -65,11 +65,17 @@ module Graphics.UI.WX.Attributes
-- ** Attributes
, newAttr, readAttr, writeAttr, nullAttr, constAttr
-- ** Reflection
- , attrName, propName, containsProp
+ , attrName, propName, containsProperty
-- ** Reflective attributes
- , reflectiveAttr, createAttr, getPropValue
+ , reflectiveAttr, createAttr, withProperty, findProperty
+ , withStyleProperty, withStylePropertyNot
+
+ -- *** Filter
+ , PropValue(..)
+ , filterProperty
) where
+import Graphics.UI.WX.Types
import Data.Dynamic
infixr 0 :=,:~,::=,::~
@@ -92,7 +98,7 @@ type ReadAttr w a = Attr w a
type WriteAttr w a = Attr w a
-- | Widgets @w@ can have attributes of type @a@.
-data Attr w a = Attr String (Maybe (a -> Dynamic)) (w -> IO a) (w -> a -> IO ()) -- name, getter, setter
+data Attr w a = Attr String (Maybe (a -> Dynamic, Dynamic -> Maybe a)) (w -> IO a) (w -> a -> IO ()) -- name, getter, setter
-- | Create a /reflective/ attribute with a specified name: value can possibly
@@ -100,7 +106,7 @@ data Attr w a = Attr String (Maybe (a -> Dynamic)) (w -> IO a) (w -> a -> IO (
-- as it leads to non-compositional code.
reflectiveAttr :: Typeable a => String -> (w -> IO a) -> (w -> a -> IO ()) -> Attr w a
reflectiveAttr name getter setter
- = Attr name (Just toDyn) getter setter
+ = Attr name (Just (toDyn, fromDynamic)) getter setter
-- | Create a /reflective/ attribute with a specified name: value can possibly
-- retrieved using 'getPropValue'. Note: the use of this function is discouraged
@@ -194,19 +200,105 @@ propName (attr :~ f) = attrName attr
propName (attr ::= f) = attrName attr
propName (attr ::~ f) = attrName attr
+
+-- | Is a certain property in a list of properties?
+containsProperty :: Attr w a -> [Prop w] -> Bool
+containsProperty attr props
+ = containsPropName (attrName attr) props
+
-- | Is a certain property in a list of properties?
-containsProp :: String -> [Prop w] -> Bool
-containsProp name props
+containsPropName :: String -> [Prop w] -> Bool
+containsPropName name props
= any (\p -> propName p == name) props
--- | Get a value of a reflective property. Only works on attributes
--- created with 'reflectiveAttr' and when the property is set using ':='.
--- Returns 'Nothing' whenever the property is not present or when the types
--- do not match.
-getPropValue :: Typeable a => Attr w a -> [Prop w] -> Maybe a
-getPropValue (Attr name1 (Just todyn1) _ _) ((Attr name2 (Just todyn2) _ _ := x):props)
- | name1 == name2 = fromDynamic (todyn2 x)
-getPropValue attr (prop:props)
- = getPropValue attr props
-getPropValue attr []
- = Nothing
+
+-- | Property value: used when retrieving a property from a list.
+data PropValue a = PropValue a
+ | PropModify (a -> a)
+ | PropNone
+
+instance Show a => Show (PropValue a) where
+ show (PropValue x) = "PropValue " ++ show x
+ show (PropModify f) = "PropModify"
+ show (PropNone) = "PropNone"
+
+-- | Retrieve the value of a property and the list with the property removed.
+filterProperty :: Typeable a => Attr w a -> [Prop w] -> (PropValue a, [Prop w])
+filterProperty (Attr name _ _ _) props
+ = walk [] PropNone props
+ where
+ -- Daan: oh, how a simple thing like properties can result into this... ;-)
+ walk :: Typeable a => [Prop w] -> PropValue a -> [Prop w] -> (PropValue a, [Prop w])
+ walk acc res props
+ = case props of
+ -- Property setter found.
+ (((Attr attr (Just (todyn,fromdyn)) _ _) := x):rest) | name == attr
+ -> case fromDynamic (todyn x) of
+ Just x -> walk acc (PropValue x) rest
+ Nothing -> walk acc res props
+
+ -- Property modifier found.
+ (((Attr attr (Just (todyn,fromdyn)) _ _) :~ f):rest) | name == attr
+ -> let dynf x = case fromdyn (toDyn x) of
+ Just xx -> case fromDynamic (todyn (f xx)) of
+ Just y -> y
+ Nothing -> x -- identity
+ Nothing -> x -- identity
+ in case res of
+ PropValue x -> walk acc (PropValue (dynf x)) rest
+ PropModify g -> walk acc (PropModify (dynf . g)) rest
+ PropNone -> walk acc (PropModify dynf) rest
+
+ -- Property found, but with the wrong arguments
+ (((Attr attr _ _ _) := _):rest) | name == attr -> stop
+ (((Attr attr _ _ _) :~ _):rest) | name == attr -> stop
+ (((Attr attr _ _ _) ::= _):rest) | name == attr -> stop
+ (((Attr attr _ _ _) ::~ _):rest) | name == attr -> stop
+
+ -- Defaults
+ (prop:rest)
+ -> walk (prop:acc) res rest
+ [] -> stop
+ where
+ stop = (res, reverse acc ++ props)
+
+
+-- | Try to find a property value and call the contination function with that value
+-- and the property list witht the searched property removed. If the property is not
+-- found, use the default value and the unchanged property list.
+withProperty :: Typeable a => Attr w a -> a -> (a -> [Prop w] -> b) -> [Prop w] -> b
+withProperty attr def cont props
+ = case filterProperty attr props of
+ (PropValue x, ps) -> cont x ps
+ (PropModify f, ps) -> cont (f def) ps
+ (PropNone, ps) -> cont def ps
+
+-- | Try to find a property value. Return |Nothing| if not found at all.
+findProperty :: Typeable a => Attr w a -> a -> [Prop w] -> Maybe (a,[Prop w])
+findProperty attr def props
+ = case filterProperty attr props of
+ (PropValue x, ps) -> Just (x,ps)
+ (PropModify f, ps) -> Just (f def,ps)
+ (PropNone, ps) -> Nothing
+
+
+
+-- | Transform the properties based on a style property.
+withStyleProperty :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStyleProperty prop flag
+ = withStylePropertyEx prop (bitsSet flag) (\isSet style -> if isSet then (style .+. flag) else (style .-. flag))
+
+-- | Transform the properties based on a style property. The flag is interpreted negatively, i.e. |True|
+-- removes the bit instead of setting it.
+withStylePropertyNot :: Attr w Bool -> Style -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStylePropertyNot prop flag
+ = withStylePropertyEx prop (not . bitsSet flag) (\isSet style -> if isSet then (style .-. flag) else (style .+. flag))
+
+
+-- | Transform the properties based on a style property.
+withStylePropertyEx :: Attr w Bool -> (Style -> Bool) -> (Bool -> Style -> Style) -> ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+withStylePropertyEx prop def transform cont props style
+ = case filterProperty prop props of
+ (PropValue x, ps) -> cont ps (transform x style)
+ (PropModify f, ps) -> cont ps (transform (f (def style)) style)
+ (PropNone, ps) -> cont ps style
View
132 wx/src/Graphics/UI/WX/Controls.hs
@@ -93,7 +93,9 @@ panel parent props
-- 'Textual', 'Literate', 'Reactive', 'Paint'
panelEx :: Window a -> Style -> [Prop (Panel ())] -> IO (Panel ())
panelEx parent style props
- = do p <- panelCreate parent idAny rectNull (clipChildrenFlags props (fullRepaintOnResizeFlags props style))
+ = feed2 props style $
+ initialContainer $ \id rect -> \props flags ->
+ do p <- panelCreate parent id rect flags
windowSetFocus p
set p props
return p
@@ -128,8 +130,9 @@ focusOn w
-- 'Textual', 'Literate', 'Reactive', 'Paint'
notebook :: Window a -> [Prop (Notebook ())] -> IO (Notebook ())
notebook parent props
- = do nb <- notebookCreate parent idAny rectNull
- (clipChildrenFlags props (fullRepaintOnResizeFlags props defaultStyle))
+ = feed2 props defaultStyle $
+ initialContainer $ \id rect -> \props flags ->
+ do nb <- notebookCreate parent id rect flags
set nb props
return nb
@@ -162,9 +165,12 @@ smallButton parent props
-- * Instances: 'Commanding' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child',
-- 'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
--
-buttonEx :: Window a -> Int -> [Prop (Button ())] -> IO (Button ())
-buttonEx parent flags props
- = do b <- buttonCreate parent idAny "?" rectNull flags
+buttonEx :: Window a -> Style -> [Prop (Button ())] -> IO (Button ())
+buttonEx parent stl props
+ = feed2 props stl $
+ initialWindow $ \id rect ->
+ initialText $ \txt -> \props flags ->
+ do b <- buttonCreate parent id txt rect flags
set b props
return b
@@ -179,7 +185,9 @@ instance Commanding (Button a) where
--
bitmapButton :: Window a -> [Prop (BitmapButton ())] -> IO (BitmapButton ())
bitmapButton parent props
- = do bb <- bitmapButtonCreate parent idAny nullBitmap rectNull wxBU_AUTODRAW
+ = feed2 props wxBU_AUTODRAW $
+ initialWindow $ \id rect -> \props flags ->
+ do bb <- bitmapButtonCreate parent id nullBitmap rect flags
set bb props
return bb
@@ -197,13 +205,13 @@ instance HasImage (BitmapButton a) where
--------------------------------------------------------------------------------}
-- | Alignment.
data Align = AlignLeft | AlignRight | AlignCentre
- deriving (Eq,Typeable)
+ deriving (Eq,Show,Read,Typeable)
-- | Wrap mode.
data Wrap = WrapNone -- ^ No wrapping (and show a horizontal scrollbar).
| WrapLine -- ^ Wrap lines that are too long at any position.
| WrapWord -- ^ Wrap lines that are too long at word boundaries.
- deriving (Eq,Typeable)
+ deriving (Eq,Show,Read,Typeable)
instance BitMask Align where
assocBitMask
@@ -225,12 +233,14 @@ instance BitMask Wrap where
class Aligned w where
-- | Set the alignment of the content. Due to wxWidgets constrictions,
-- this property has to be set at creation time.
- alignment :: Attr w Align
+ alignment :: CreateAttr w Align
-alignmentFlags props stl
- = case getPropValue alignment props of
- Just align -> setBitMask align stl
- Nothing -> stl
+initialAlignment :: Aligned w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialAlignment cont props style
+ = case filterProperty alignment props of
+ (PropValue x, ps) -> cont ps (setBitMask x style)
+ (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)
+ (PropNone, ps) -> cont ps style
instance Aligned (TextCtrl a) where
@@ -247,12 +257,13 @@ instance Aligned (TextCtrl a) where
-- | Widgets that have wrappable content.
class Wrapped w where
-- | Set the wrap mode of a widget.
- wrap :: Attr w Wrap
+ wrap :: CreateAttr w Wrap
-wrapFlags props stl
- = case getPropValue wrap props of
- Just mode -> setBitMask mode stl
- Nothing -> stl
+initialWrap cont props style
+ = case filterProperty wrap props of
+ (PropValue x, ps) -> cont ps (setBitMask x style)
+ (PropModify f, ps) -> cont ps (setBitMask (f (fromBitMask style)) style)
+ (PropNone, ps) -> cont ps style
instance Wrapped (TextCtrl a) where
wrap
@@ -266,6 +277,7 @@ instance Wrapped (TextCtrl a) where
= set w [style :~ setBitMask mode]
+
{-
instance Able (TextCtrl a) where
enabled
@@ -321,8 +333,13 @@ textCtrlRich parent props
-- 'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'.
--
textCtrlEx :: Window a -> Style -> [Prop (TextCtrl ())] -> IO (TextCtrl ())
-textCtrlEx parent flags props
- = do e <- textCtrlCreate parent idAny "" rectNull (wrapFlags props $ alignmentFlags props $ flags)
+textCtrlEx parent stl props
+ = feed2 props stl $
+ initialWindow $ \id rect ->
+ initialText $ \txt ->
+ initialWrap $
+ initialAlignment $ \props flags ->
+ do e <- textCtrlCreate parent id txt rect flags
set e props
return e
@@ -365,7 +382,10 @@ processTab
-- | Create static text label, see also 'label'.
staticText :: Window a -> [Prop (StaticText ())] -> IO (StaticText ())
staticText parent props
- = do t <- staticTextCreate parent idAny "" rectNull 0 {- (wxALIGN_LEFT + wxST_NO_AUTORESIZE) -}
+ = feed2 props 0 $
+ initialWindow $ \id rect ->
+ initialText $ \txt -> \props flags ->
+ do t <- staticTextCreate parent id txt rect flags {- (wxALIGN_LEFT + wxST_NO_AUTORESIZE) -}
set t props
return t
@@ -390,7 +410,10 @@ instance Checkable (CheckBox a) where
--
checkBox :: Window a -> [Prop (CheckBox ())] -> IO (CheckBox ())
checkBox parent props
- = do c <- checkBoxCreate parent idAny "" rectNull 0
+ = feed2 props 0 $
+ initialWindow $ \id rect ->
+ initialText $ \txt -> \props flags ->
+ do c <- checkBoxCreate parent id txt rect flags
set c props
return c
@@ -412,11 +435,10 @@ instance Sorted (Choice a) where
setter w sort
= set w [style :~ \st -> if sort then st .+. wxCB_SORT else st .-. wxCB_SORT]
-sortedFlags mask props st
- = case getPropValue sorted props of
- Just True -> st .+. mask
- Just False -> st .-. mask
- Nothing -> st
+initialSorted :: Sorted w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialSorted
+ = withStyleProperty sorted wxCB_SORT
+
instance Selecting (Choice ()) where
select = newEvent "select" choiceGetOnCommand choiceOnCommand
@@ -457,7 +479,10 @@ choice parent props
--
choiceEx :: Window a -> Style -> [Prop (Choice ())] -> IO (Choice ())
choiceEx parent flags props
- = do c <- choiceCreate parent idAny rectNull [] (sortedFlags wxCB_SORT props flags)
+ = feed2 props flags $
+ initialWindow $ \id rect ->
+ initialSorted $ \props flags ->
+ do c <- choiceCreate parent id rect [] flags
set c props
return c
@@ -516,7 +541,11 @@ comboBox parent props
-- 'processEnter' has been set to 'True'.
comboBoxEx :: Window a -> Style -> [Prop (ComboBox ())] -> IO (ComboBox ())
comboBoxEx parent flags props
- = do cb <- comboBoxCreate parent idAny "" rectNull [] (sortedFlags wxCB_SORT props flags)
+ = feed2 props flags $
+ initialWindow $ \id rect ->
+ initialText $ \txt ->
+ initialSorted $ \props flags ->
+ do cb <- comboBoxCreate parent id txt rect [] flags
set cb props
return cb
@@ -585,8 +614,10 @@ instance Selections (MultiListBox a) where
--
singleListBox :: Window a -> [Prop (SingleListBox ())] -> IO (SingleListBox ())
singleListBox parent props
- = do lb <- listBoxCreate parent idAny rectNull []
- (wxLB_SINGLE .+. wxHSCROLL .+. wxLB_NEEDED_SB .+. (sortedFlags wxLB_SORT props 0))
+ = feed2 props (wxLB_SINGLE .+. wxHSCROLL .+. wxLB_NEEDED_SB) $
+ initialWindow $ \id rect ->
+ initialSorted $ \props flags ->
+ do lb <- listBoxCreate parent id rect [] flags
let sl = (objectCast lb :: SingleListBox ())
set sl props
return sl
@@ -598,8 +629,10 @@ singleListBox parent props
--
multiListBox :: Window a -> [Prop (MultiListBox ())] -> IO (MultiListBox ())
multiListBox parent props
- = do lb <- listBoxCreate parent idAny rectNull []
- (wxLB_MULTIPLE .+. wxLB_EXTENDED .+. wxHSCROLL .+. wxLB_NEEDED_SB .+. (sortedFlags wxLB_SORT props 0))
+ = feed2 props (wxLB_MULTIPLE .+. wxLB_EXTENDED .+. wxHSCROLL .+. wxLB_NEEDED_SB) $
+ initialWindow $ \id rect ->
+ initialSorted $ \props flags ->
+ do lb <- listBoxCreate parent id rect [] flags
let ml = (objectCast lb :: MultiListBox ())
set ml props
return ml
@@ -637,15 +670,13 @@ instance Items (RadioBox a) String where
--
radioBox :: Window a -> Orientation -> [String] -> [Prop (RadioBox ())] -> IO (RadioBox ())
radioBox parent direction labels props
- = do r <- radioBoxCreate parent idAny title rectNull labels 1 flags
+ = feed2 props (if (direction==Horizontal) then wxRA_SPECIFY_ROWS else wxRA_SPECIFY_COLS) $
+ initialWindow $ \id rect ->
+ initialText $ \title -> \props flags ->
+ do putStrLn title
+ r <- radioBoxCreate parent id title rect labels 1 flags
set r props
return r
- where
- title
- = if (containsProp "text" props) then " " else ""
-
- flags
- = (if (direction==Horizontal) then wxRA_SPECIFY_ROWS else wxRA_SPECIFY_COLS)
{--------------------------------------------------------------------------------
Gauge
@@ -763,7 +794,10 @@ instance Selection (Slider a) where
--
spinCtrl :: Window a -> Int -> Int -> [Prop (SpinCtrl ())] -> IO (SpinCtrl ())
spinCtrl parent lo hi props
- = do sc <- spinCtrlCreate parent idAny "" rectNull wxSP_ARROW_KEYS (min lo hi) (max lo hi) lo
+ = feed2 props wxSP_ARROW_KEYS $
+ initialWindow $ \id rect ->
+ initialText $ \txt -> \props flags ->
+ do sc <- spinCtrlCreate parent id txt rect flags (min lo hi) (max lo hi) lo
set sc props
return sc
@@ -811,7 +845,9 @@ treeCtrl parent props
--
treeCtrlEx :: Window a -> Style -> [Prop (TreeCtrl ())] -> IO (TreeCtrl ())
treeCtrlEx parent style props
- = do t <- treeCtrlCreate2 parent idAny rectNull (clipChildrenFlags props (fullRepaintOnResizeFlags props style))
+ = feed2 props style $
+ initialContainer $ \id rect -> \props flags ->
+ do t <- treeCtrlCreate2 parent id rect flags
set t props
return t
@@ -913,7 +949,9 @@ listCtrl parent props
--
listCtrlEx :: Window a -> Style -> [Prop (ListCtrl ())] -> IO (ListCtrl ())
listCtrlEx parent style props
- = do l <- listCtrlCreate parent idAny rectNull (clipChildrenFlags props (fullRepaintOnResizeFlags props style))
+ = feed2 props style $
+ initialContainer $ \id rect -> \props flags ->
+ do l <- listCtrlCreate parent id rect flags
set l props
return l
@@ -927,9 +965,9 @@ listCtrlEx parent style props
--
splitterWindow :: Window a -> [Prop (SplitterWindow ())] -> IO (SplitterWindow ())
splitterWindow parent props
- = do s <- splitterWindowCreate parent idAny rectNull
- (clipChildrenFlags props (fullRepaintOnResizeFlags props
- (wxSP_LIVE_UPDATE .+. defaultStyle)))
+ = feed2 props (defaultStyle .+. wxSP_LIVE_UPDATE) $
+ initialContainer $ \id rect -> \props flags ->
+ do s <- splitterWindowCreate parent id rect flags
set s props
return s
View
10 wx/src/Graphics/UI/WX/Dialogs.hs
@@ -58,13 +58,9 @@ dialog parent props
-- | Create a dialog window with a certain style.
dialogEx :: Window a -> Style -> [Prop (Dialog ())] -> IO (Dialog ())
dialogEx parent style props
- = do d <- dialogCreate parent idAny "" rectNull
- ( minimizeableFlags props
- $ maximizeableFlags props
- $ clipChildrenFlags props
- $ resizeableFlags props
- $ closeableFlags props
- $ fullRepaintOnResizeFlags props style)
+ = feed2 props style $
+ initialFrame $ \id rect txt -> \props flags ->
+ do d <- dialogCreate parent id txt rect flags
set d props
return d
View
128 wx/src/Graphics/UI/WX/Frame.hs
@@ -28,7 +28,7 @@ module Graphics.UI.WX.Frame
, activeChild, activateNext, activatePrevious, arrangeIcons
, cascade, tile
-- * Internal
- , resizeableFlags, maximizeableFlags, minimizeableFlags, closeableFlags
+ , initialFrame, initialResizeable, initialMaximizeable, initialMinimizeable, initialCloseable
) where
import Graphics.UI.WXCore
@@ -41,7 +41,7 @@ import Graphics.UI.WX.Window
import Graphics.UI.WX.Events
defaultStyle
- = frameDefaultStyle .+. wxTAB_TRAVERSAL -- .+. wxNO_FULL_REPAINT_ON_RESIZE
+ = frameDefaultStyle -- .+. wxTAB_TRAVERSAL -- .+. wxNO_FULL_REPAINT_ON_RESIZE
-- | Create a top-level frame window.
frame :: [Prop (Frame ())] -> IO (Frame ())
@@ -62,23 +62,31 @@ frameTool props parent
-- | Create a top-level frame window in a custom style.
frameEx :: Style -> [Prop (Frame ())] -> Window a -> IO (Frame ())
frameEx style props parent
- = do f <- frameCreate parent idAny "" rectNull
- ( minimizeableFlags props
- $ clipChildrenFlags props
- $ resizeableFlags props
- $ maximizeableFlags props
- $ closeableFlags props
- $ fullRepaintOnResizeFlags props style)
- wxcAppSetTopWindow f
- let initProps = (if (containsProp "visible" props)
- then [] else [visible := True]) ++
- (if (containsProp "clientSize" props)
- then [] else [clientSize := sizeZero]) ++
- [bgcolor := colorSystem Color3DFace]
+ = feed2 props style $
+ initialFrame $ \id rect txt -> \props style ->
+ do f <- frameCreate parent id txt rect style
+ let initProps = (if (containsProperty visible props)
+ then [] else [visible := True]) ++
+ (if (containsProperty bgcolor props)
+ then [] else [bgcolor := colorSystem Color3DFace])
set f initProps
set f props
return f
-
+
+
+-- | initial Frame flags
+initialFrame :: (Id -> Rect -> String -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialFrame cont
+ = initialContainer $ \id rect ->
+ initialText $ \txt ->
+ initialResizeable $
+ initialMinimizeable $
+ initialMaximizeable $
+ initialCloseable $
+ initialClipChildren $
+ initialFullRepaintOnResize $
+ cont id rect txt
+
-- The image of a frame.
instance HasImage (Frame a) where
@@ -136,18 +144,18 @@ mdiParentFrame props
-- | Create an MDI parent frame with a custom style.
mdiParentFrameEx :: Window a -> Style -> [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())
mdiParentFrameEx parent stl props
- = do f <- mdiParentFrameCreate parent idAny "" rectNull
- ( minimizeableFlags props
- $ maximizeableFlags props
- $ clipChildrenFlags props
- $ resizeableFlags props
- $ closeableFlags props
- $ fullRepaintOnResizeFlags props stl)
- wxcAppSetTopWindow f
- set f [visible := True, clientSize := sizeZero]
+ = feed2 props stl $
+ initialFrame $ \id rect txt -> \props stl ->
+ do f <- mdiParentFrameCreate parent id txt rect stl
+ let initProps = (if (containsProperty visible props)
+ then [] else [visible := True]) ++
+ (if (containsProperty bgcolor props)
+ then [] else [bgcolor := colorSystem Color3DFace])
+ set f initProps
set f props
return f
+
-- | Create a MDI child frame.
mdiChildFrame :: MDIParentFrame a -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
mdiChildFrame parent props
@@ -156,15 +164,18 @@ mdiChildFrame parent props
-- | Create a MDI child frame with a custom style.
mdiChildFrameEx :: MDIParentFrame a -> Style -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
mdiChildFrameEx parent stl props
- = do f <- mdiChildFrameCreate parent idAny "" rectNull
- ( minimizeableFlags props
- $ maximizeableFlags props
- $ clipChildrenFlags props
- $ resizeableFlags props
- $ fullRepaintOnResizeFlags props stl)
- set f [visible := True, clientSize := sizeZero]
+ = feed2 props stl $
+ initialFrame $ \id rect txt -> \props stl ->
+ do f <- mdiChildFrameCreate parent id txt rect stl
+ let initProps = (if (containsProperty visible props)
+ then [] else [visible := True]) ++
+ (if (containsProperty bgcolor props)
+ then [] else [bgcolor := colorSystem Color3DFace])
+ set f initProps
set f props
return f
+
+
-- | Return the active child frame ('objectIsNull' when no child is active)
activeChild :: ReadAttr (MDIParentFrame a) (MDIChildFrame ())
@@ -197,7 +208,7 @@ tile = mdiParentFrameTile
-- | Display a resize border on a 'Frame' or 'Dialog' window. Also enables or
-- disables the the maximize box.
-- This attribute must be set at creation time.
-windowResizeable :: Attr (Window a) Bool
+windowResizeable :: CreateAttr (Window a) Bool
windowResizeable
= reflectiveAttr "resizeable" getFlag setFlag
where
@@ -210,18 +221,15 @@ windowResizeable
else stl .-. wxRESIZE_BORDER .-. wxMAXIMIZE_BOX]
-- | Helper function that transforms the style accordding
--- to the 'resizeable' flag out of the properties
-resizeableFlags :: [Prop (Window a)] -> Int -> Int
-resizeableFlags props stl
- = case getPropValue windowResizeable props of
- Just True -> stl .+. wxRESIZE_BORDER .+. wxMAXIMIZE_BOX
- Just False -> stl .-. wxRESIZE_BORDER .-. wxMAXIMIZE_BOX
- Nothing -> stl
+-- to the 'windowResizable' flag in of the properties
+initialResizeable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialResizeable
+ = withStyleProperty windowResizeable (wxRESIZE_BORDER .+. wxMAXIMIZE_BOX)
-- | Display a maximize box on a 'Frame' or 'Dialog' window.
-- This attribute must be set at creation time.
-windowMaximizeable :: Attr (Window a) Bool
+windowMaximizeable :: CreateAttr (Window a) Bool
windowMaximizeable
= reflectiveAttr "maximizeable" getFlag setFlag
where
@@ -232,18 +240,15 @@ windowMaximizeable
= set w [style :~ \stl -> if max then stl .+. wxMAXIMIZE_BOX else stl .-. wxMAXIMIZE_BOX]
-- | Helper function that transforms the style accordding
--- to the 'maximizable' flag out of the properties
-maximizeableFlags :: [Prop (Window a)] -> Int -> Int
-maximizeableFlags props stl
- = case getPropValue windowMaximizeable props of
- Just True -> stl .+. wxMAXIMIZE_BOX
- Just False -> stl .-. wxMAXIMIZE_BOX
- Nothing -> stl
+-- to the 'windowMaximizable' flag in of the properties
+initialMaximizeable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialMaximizeable
+ = withStyleProperty windowMaximizeable wxMAXIMIZE_BOX
-- | Display a minimize box on a 'Frame' or 'Dialog' window.
-- This attribute must be set at creation time.
-windowMinimizeable :: Attr (Window a) Bool
+windowMinimizeable :: CreateAttr (Window a) Bool
windowMinimizeable
= reflectiveAttr "minimizeable" getFlag setFlag
where
@@ -254,18 +259,15 @@ windowMinimizeable
= set w [style :~ \stl -> if min then stl .+. wxMINIMIZE_BOX else stl .-. wxMINIMIZE_BOX]
-- | Helper function that transforms the style accordding
--- to the 'minimizable' flag out of the properties
-minimizeableFlags :: [Prop (Window a)] -> Int -> Int
-minimizeableFlags props stl
- = case getPropValue windowMinimizeable props of
- Just True -> stl .+. wxMINIMIZE_BOX
- Just False -> stl .-. wxMINIMIZE_BOX
- Nothing -> stl
+-- to the 'windowMinimizable' flag in of the properties
+initialMinimizeable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialMinimizeable
+ = withStyleProperty windowMinimizeable wxMINIMIZE_BOX
-- | Display a close box on a 'Frame' or 'Dialog' window.
-- This attribute must be set at creation time.
-windowCloseable :: Attr (Window a) Bool
+windowCloseable :: CreateAttr (Window a) Bool
windowCloseable
= reflectiveAttr "closeable" getFlag setFlag
where
@@ -276,11 +278,7 @@ windowCloseable
= set w [style :~ \stl -> if min then stl .+. wxCLOSE_BOX else stl .-. wxCLOSE_BOX]
-- | Helper function that transforms the style accordding
--- to the 'closeable' flag out of the properties
-closeableFlags :: [Prop (Window a)] -> Int -> Int
-closeableFlags props stl
- = case getPropValue windowCloseable props of
- Just True -> stl .+. wxCLOSE_BOX
- Just False -> stl .-. wxCLOSE_BOX
- Nothing -> stl
-
+-- to the 'windowMinimizable' flag in of the properties
+initialCloseable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialCloseable
+ = withStyleProperty windowCloseable wxCLOSE_BOX
View
24 wx/src/Graphics/UI/WX/Menu.hs
@@ -129,12 +129,12 @@ instance Textual (Menu a) where
menuSub :: Menu b -> Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
menuSub parent menu props
= do id <- idCreate
- label <- case (getPropValue text props) of
- Just txt -> return txt
- Nothing -> do title <- menuGetTitle menu
- if (null title)
- then return "<empty>"
- else return title
+ label <- case (findProperty text "" props) of
+ Just (txt,_) -> return txt
+ Nothing -> do title <- menuGetTitle menu
+ if (null title)
+ then return "<empty>"
+ else return title
menuSetTitle menu "" -- remove title on submenus
menuAppendSub parent id label menu ""
item <- menuFindItem parent id objectNull
@@ -164,9 +164,9 @@ menuLine menu
--
menuItem :: Menu a -> [Prop (MenuItem ())] -> IO (MenuItem ())
menuItem menu props
- = do let kind = case (getPropValue checkable props) of
- Just True -> wxITEM_CHECK
- _ -> wxITEM_NORMAL
+ = do let kind = case (findProperty checkable False props) of
+ Just (True,_) -> wxITEM_CHECK
+ _ -> wxITEM_NORMAL
menuItemKind menu kind props
-- | Append a radio menu item. These items are 'checkable' by default.
@@ -182,9 +182,9 @@ menuRadioItem menu props
menuItemKind menu kind props
= do id <- idCreate
- let label = case (getPropValue text props) of
- Nothing -> "<empty>"
- Just txt -> txt
+ let label = case (findProperty text "" props) of
+ Nothing -> "<empty>"
+ Just (txt,_) -> txt
menuItemEx menu id label kind props
View
15 wx/src/Graphics/UI/WX/Types.hs
@@ -15,8 +15,10 @@ module Graphics.UI.WX.Types
(
-- * Basic Types
+ Orientation(..)
+
-- ** Objects
- ( # )
+ , ( # ), feed, feed2
, Object, objectNull, objectIsNull, objectCast
, Managed, managedNull, managedIsNull, managedCast, createManaged, withManaged, managedTouch
@@ -88,6 +90,17 @@ module Graphics.UI.WX.Types
import Graphics.UI.WXCore.Types
import Graphics.UI.WXCore.Draw
+import Graphics.UI.WXCore.Events( Orientation(..) )
+
+-- | Inverse application, i.e. @feed x f@ = @f x@.
+feed :: a -> (a -> b) -> b
+feed x f
+ = f x
+
+-- | Composed Inverse application, i.e. @feed2 x y f@ = @f x y@.
+feed2 :: a -> b -> (a -> b -> c) -> c
+feed2 x y f
+ = f x y
-- | Data types that can be represented through a bit mask. Only the @assocBitMask@ method
-- is required for a new instance.
View
91 wx/src/Graphics/UI/WX/Window.hs
@@ -20,7 +20,9 @@ module Graphics.UI.WX.Window
-- * ScrolledWindow
, ScrolledWindow, scrolledWindow, scrollRate
-- * Internal
- , fullRepaintOnResizeFlags, clipChildrenFlags
+ , initialWindow, initialContainer
+ , initialIdentity, initialStyle, initialText
+ , initialFullRepaintOnResize, initialClipChildren
) where
import Graphics.UI.WXCore
@@ -31,6 +33,7 @@ import Graphics.UI.WX.Layout
import Graphics.UI.WX.Classes
import Graphics.UI.WX.Events
+
{--------------------------------------------------------------------------------
ScrolledWindow
--------------------------------------------------------------------------------}
@@ -45,8 +48,9 @@ import Graphics.UI.WX.Events
--
scrolledWindow :: Window a -> [Prop (ScrolledWindow ())] -> IO (ScrolledWindow ())
scrolledWindow parent props
- = do sw <- scrolledWindowCreate parent idAny rectNull
- (clipChildrenFlags props (fullRepaintOnResizeFlags props 0))
+ = feed2 props 0 $
+ initialContainer $ \id rect -> \props style ->
+ do sw <- scrolledWindowCreate parent id rect style
set sw props
return sw
@@ -67,6 +71,25 @@ scrollRate
{--------------------------------------------------------------------------------
Properties
--------------------------------------------------------------------------------}
+-- | Helper function that retrieves initial window settings, including
+-- |identity|, |style|, and |area| (or |position| and |outerSize|).
+initialWindow :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialWindow cont
+ = initialIdentity $ \id ->
+ initialArea $ \rect ->
+ initialStyle $
+ cont id rect
+
+-- | Helper function that retrieves initial window settings, including |clipChildren|
+-- and |fullRepaintOnResize|.
+initialContainer :: (Id -> Rect -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a
+initialContainer cont
+ = initialWindow $ \id rect ->
+ initialFullRepaintOnResize $
+ initialClipChildren $
+ cont id rect
+
+
instance Able (Window a) where
enabled
= newAttr "enabled" windowIsEnabled setter
@@ -78,7 +101,7 @@ instance Able (Window a) where
instance Textual (Window a) where
text
- = newAttr "text" getter setter
+ = reflectiveAttr "text" getter setter
where
getter w
= fst (getset w)
@@ -100,6 +123,12 @@ instance Textual (Window a) where
(set w [text :~ (++s)])
+-- | Retrieve the initial title from the |text| attribute.
+initialText :: Textual w => (String -> [Prop w] -> a) -> [Prop w] -> a
+initialText cont props
+ = withProperty text "" cont props
+
+
instance Dimensions (Window a) where
outerSize
= newAttr "size" windowGetSize setSize
@@ -126,6 +155,23 @@ instance Dimensions (Window a) where
= newAttr "virtualSize" windowGetVirtualSize windowSetVirtualSize
+-- | Retrieve the initial creation area from the |area|, or the |position| and
+-- |outerSize| properties.
+initialArea :: Dimensions w => (Rect -> [Prop w] -> a) -> [Prop w] -> a
+initialArea cont props
+ = case findProperty area rectNull props of
+ Just (rect,props') -> cont rect props'
+ Nothing
+ -> case findProperty position pointNull props of
+ Just (p,props') -> case findProperty outerSize sizeNull props of
+ Just (sz,props'') -> cont (rect p sz) props''
+ Nothing -> cont (rect p sizeNull) props'
+ Nothing -> case findProperty outerSize sizeNull props of
+ Just (sz,props') -> cont (rect pointNull sz) props'
+ Nothing -> cont rectNull props
+
+
+
instance Colored (Window a) where
bgcolor
= newAttr "bgcolor" windowGetBackgroundColour (\w x -> do{ windowSetBackgroundColour w x; return ()})
@@ -242,22 +288,19 @@ instance Visible (Window a) where
then stl .+. wxCLIP_CHILDREN
else stl .-. wxCLIP_CHILDREN]
--- | Helper function that transforms the style according to the 'fullRepaintOnResize' flags.
-fullRepaintOnResizeFlags :: Visible w => [Prop w] -> Int -> Int
-fullRepaintOnResizeFlags props stl
- = case getPropValue fullRepaintOnResize props of
- Just True -> stl .-. wxNO_FULL_REPAINT_ON_RESIZE
- Just False -> stl .+. wxNO_FULL_REPAINT_ON_RESIZE
- other -> stl
+
+-- | Helper function that transforms the style accordding
+-- to the 'fullRepaintOnResize' flag in of the properties
+initialFullRepaintOnResize :: Visible w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialFullRepaintOnResize
+ = withStylePropertyNot fullRepaintOnResize wxNO_FULL_REPAINT_ON_RESIZE
+
-- | Helper function that transforms the style accordding
-- to the 'clipChildren' flag out of the properties
-clipChildrenFlags :: [Prop (Window a)] -> Int -> Int
-clipChildrenFlags props stl
- = case getPropValue clipChildren props of
- Just True -> stl .+. wxCLIP_CHILDREN
- Just False-> stl .-. wxCLIP_CHILDREN
- Nothing -> stl
+initialClipChildren :: Visible w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialClipChildren
+ = withStyleProperty clipChildren wxCLIP_CHILDREN
@@ -294,11 +337,21 @@ frameParent
instance Identity (Window a) where
identity
- = newAttr "identity" windowGetId windowSetId
+ = reflectiveAttr "identity" windowGetId windowSetId
+
+-- | Helper function that retrieves the initial |identity|.
+initialIdentity :: Identity w => (Id -> [Prop w] -> a) -> [Prop w] -> a
+initialIdentity
+ = withProperty identity idAny
instance Styled (Window a) where
style
- = newAttr "style" windowGetWindowStyleFlag windowSetWindowStyleFlag
+ = reflectiveAttr "style" windowGetWindowStyleFlag windowSetWindowStyleFlag
+
+-- | Helper function that retrieves the initial |style|.
+initialStyle :: Styled w => ([Prop w] -> Style -> a) -> [Prop w] -> Style -> a
+initialStyle cont props stl
+ = withProperty style stl (\stl' props' -> cont props' stl') props
instance Tipped (Window a) where
tooltip
View
1  wxc/include/wxc.h
@@ -47,6 +47,7 @@ void wxFrame_SetTitle( TSelf(wxFrame) _frame, TString _txt );
TBool wxFrame_SetShape( TSelf(wxFrame) self, TClass(wxRegion) region);
TBool wxFrame_ShowFullScreen( TSelf(wxFrame) self, TBool show, int style);
TBool wxFrame_IsFullScreen( TSelf(wxFrame) self );
+void wxFrame_Centre( TSelf(wxFrame) self, int orientation );
/* Create/Delete */
void wxCursor_Delete( TSelf(wxCursor) _obj );
View
6 wxc/src/extra.cpp
@@ -1297,6 +1297,12 @@ EWXWEXPORT(bool, wxFrame_IsFullScreen)( wxFrame* self )
return self->IsFullScreen();
}
+EWXWEXPORT(void, wxFrame_Centre)( wxFrame* self, int orientation )
+{
+ self->Centre();
+}
+
+
EWXWEXPORT(void, wxNotebook_AssignImageList)( wxNotebook* _obj, wxImageList* imageList )
{
_obj->AssignImageList(imageList);
View
19 wxcore/src/Graphics/UI/WXCore/Frame.hs
@@ -16,6 +16,9 @@ module Graphics.UI.WXCore.Frame
, frameCreateDefault
, frameSetTopFrame
, frameDefaultStyle
+ , frameCenter
+ , frameCenterHorizontal
+ , frameCenterVertical
-- * Window
, windowGetRootParent
, windowGetFrameParent
@@ -67,6 +70,22 @@ frameCreateDefault :: String -> IO (Frame ())
frameCreateDefault title
= frameCreate objectNull idAny title rectNull frameDefaultStyle
+
+-- | Center the frame on the screen.
+frameCenter :: Frame a -> IO ()
+frameCenter f
+ = frameCentre f wxBOTH
+
+-- | Center the frame horizontally on the screen.
+frameCenterHorizontal :: Frame a -> IO ()
+frameCenterHorizontal f
+ = frameCentre f wxHORIZONTAL
+
+-- | Center the frame vertically on the screen.
+frameCenterVertical :: Frame a -> IO ()
+frameCenterVertical f
+ = frameCentre f wxVERTICAL
+
------------------------------------------------------------------------------------------
-- Window
------------------------------------------------------------------------------------------
View
3  wxcore/src/Graphics/UI/WXCore/Types.hs
@@ -87,7 +87,8 @@ infixl 5 .+.
infixl 5 .-.
infix 5 #
--- | Reverse application. Useful for an object oriented style of programming.
+-- | Reverse application, i.e. @x # f@ = @f x@.
+-- Useful for an object oriented style of programming.
--
-- > (frame # frameSetTitle) "hi"
--
View
16 wxcore/src/Graphics/UI/WXCore/WxcTypes.hs
@@ -107,6 +107,9 @@ import Foreign.Concurrent
import Data.Bits( shiftL, shiftR, (.&.), (.|.) )
+{- note: this is just for instances for the WX library and not necessary for WXCore -}
+import Data.Dynamic
+
{-----------------------------------------------------------------------------------------
Objects
-----------------------------------------------------------------------------------------}
@@ -193,7 +196,7 @@ data Point = Point
{ pointX :: !Int -- ^ x component of a point.
, pointY :: !Int -- ^ y component of a point.
}
- deriving (Eq,Show)
+ deriving (Eq,Show,Read,Typeable)
-- | Construct a point.
point :: Int -> Int -> Point
@@ -253,7 +256,7 @@ data Size = Size
{ sizeW :: !Int -- ^ the width of a size
, sizeH :: !Int -- ^ the height of a size
}
- deriving (Eq,Show)
+ deriving (Eq,Show,Typeable)
-- | Construct a size from a width and height.
size :: Int -> Int -> Size
@@ -313,7 +316,7 @@ data Vector = Vector
{ vecX :: !Int -- ^ delta-x component of a vector
, vecY :: !Int -- ^ delta-y component of a vector
}
- deriving (Eq,Show)
+ deriving (Eq,Show,Read,Typeable)
-- | Construct a vector.
vector :: Int -> Int -> Vector
@@ -377,7 +380,7 @@ data Rect = Rect
, rectWidth :: !Int
, rectHeight :: !Int
}
- deriving (Eq,Show)
+ deriving (Eq,Show,Read,Typeable)
rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight :: Rect -> Point
@@ -741,7 +744,7 @@ foreign import ccall "wxGridCellCoordsArray_Create" wxGridCellCoordsArray_Create
-- | Identifies tree items. Note: Replaces the @TreeItemId@ object and takes automatically
-- care of allocation issues.
newtype TreeItem = TreeItem Int
- deriving Eq
+ deriving (Eq,Show,Read)
-- | Invalid tree item.
treeItemInvalid :: TreeItem
@@ -814,7 +817,8 @@ foreign import ccall "wxString_GetString" wxString_GetString :: (WxStringObject
Color
-----------------------------------------------------------------------------------------}
-- | An abstract data type to define colors.
-newtype Color = Color Int deriving Eq
+newtype Color = Color Int
+ deriving (Eq,Typeable)
instance Show Color where
showsPrec d c
Please sign in to comment.
Something went wrong with that request. Please try again.