packages feed

WxGeneric 0.4.0 → 0.5.1

raw patch · 4 files changed

+127/−117 lines, 4 files

Files

WxGeneric.cabal view
@@ -1,5 +1,5 @@ Name:           WxGeneric-Version:        0.4.0+Version:        0.5.1 Copyright:      Mads Lindstrøm <mads_lindstroem@yahoo.dk> License:        LGPL License-file:   COPYRIGHT.txt
examples/Examples.hs view
@@ -12,7 +12,7 @@ import Graphics.UI.XTC import Graphics.UI.WX import Graphics.UI.WXCore-+import Graphics.UI.SybWidget.PriLabel  import Graphics.UI.SybWidget.MySYB @@ -29,7 +29,7 @@ $(derive [''Person]) instance WxGen Person -main = listTest+main = setOuterLabelTest  someTree = Leaf 5 5.2 @@ -98,6 +98,13 @@               listWid <- genericWidget p [1::Int, 2, 8]               set listWid [ on change := get listWid widgetValue >>= print ]               set f [ layout := container p $ fill $ widget listWid ]++setOuterLabelTest = start $+    do f <- frame []+       p <- panel f []+       en <- fromOuter p $ setOuterLabel (userDefinedLabel "User-set label") $ mkWid (Person "Bob" 17 [])+       set f [ layout := container p $ fill $ widget en ]+                      data MyEnum = Enum1 | Enum2 | Enum3 deriving Show $(derive [''MyEnum])
src/Graphics/UI/WxGeneric/Composite.hs view
@@ -6,17 +6,17 @@ -- composite widget. module Graphics.UI.WxGeneric.Composite     ( -- * Composite type-      Composite, pickPanel, pickSuper, pickUser+      Composite, pickPanel, pickUser     , compose, singleComposite     -- * Mapping attributes-    , mapFromPanel, forAllChildren-    , mapFromSuper-    , mapFromUser+    , mapPanelAttr, forAllChildren+    , mapUserAttr, mapInheritedAttr     -- * Mapping events-    , mapEventF, mapEventSuper, mapEventPanel+    , mapEventF, mapPanelEvent, mapInheritedEvent     -- * Other     , ValuedWidget, widgetValue-    , updateSuper, updateUser+    , updateUser, updateInherited+    , Inherit(..), CompositeInherit     ) where @@ -27,12 +27,21 @@ -- What about Styled, Dockable, and Pictured classes?  -- |Data type which contains a composite widget-data Composite super user = forall w. -    Composite { pickPanel :: Window w-              , pickSuper :: super+data Composite user = forall w. +    Composite { pickPanel :: Window w    -- ^ Contains the widget, which this Composite represent.+                                         -- The term widget is used broadly here. It can either refer to+                                         -- some basic widget, like a text-box, or to a panel containing+                                         -- multiple sub-widgets.                , pickUser  :: user               } +-- | A marker type, which indicates that we want to derive or inherit all+-- wxHaskell type classes possible.+newtype Inherit super = Inherit { inherit :: super }++-- Ugly name CompositeInherit - but could not figure out a better one.+type CompositeInherit super = Composite (Inherit super)+ {- |Composes zero-to-many widgets to a larger composite widget  The composite will automatically implement the following classes:@@ -55,8 +64,8 @@  * Reactive (event class) -if the supertype implements one of the following classes, so will the-Composite:+if the user type = (Inherit x) and x implements one of the following+classes, then so will the Composite:  * Items @@ -78,7 +87,7 @@ follows:  @-type MyComposite = Composite super user+type MyComposite = Composite user   instance Foo MyComposite where    ...@@ -86,76 +95,76 @@  -} -compose :: (Panel () -> IO (Layout, super, user))-        -> Window w -> [Prop (Composite super user)] -> IO (Composite super user)+compose :: (Panel () -> IO (Layout, user))+        -> Window w -> [Prop (Composite user)] -> IO (Composite user) compose f w props =     do p <- panel w []-       (lay, super, user) <- f p+       (lay, user) <- f p        set p [ layout := lay ]-       let composite = Composite p super user+       let composite = Composite p user        set composite props        return composite  -- |Encapsulate a single 'Window w' in the composite type-singleComposite :: Window w -> super -> user -> Composite super user+singleComposite :: Window w -> user -> Composite user singleComposite w = Composite w  -- |Used when an attribute should apply to the panel-mapFromPanel :: (forall w. Attr (Window w) attr) -> Attr (Composite super user) attr-mapFromPanel attr = newAttr (attrName attr) getter setter-    where getter (Composite wid _ _)   = get wid attr-          setter (Composite wid _ _) x = set wid [ attr := x ]+mapPanelAttr :: (forall w. Attr (Window w) attr) -> Attr (Composite user) attr+mapPanelAttr attr = newAttr (attrName attr) getter setter+    where getter (Composite wid _)   = get wid attr+          setter (Composite wid _) x = set wid [ attr := x ]  -- |Used when an attribute should apply to the panel and all of its -- children forAllChildren :: Attr (Window ()) attr -> (forall w. Attr (Window w) attr)-               -> Attr (Composite super user) attr+               -> Attr (Composite user) attr forAllChildren childAttr panelAttr = newAttr (attrName panelAttr) getter setter-    where getter (Composite wid _ _)     = get wid panelAttr-          setter (Composite wid _ _) val =+    where getter (Composite wid _)     = get wid panelAttr+          setter (Composite wid _) val =               do set wid [ panelAttr := val ]                  xs <- get wid children                  mapM_ (\x -> set x [ childAttr := val ]) xs  --- |Used when an attribute should apply to the "supertype"-mapFromSuper :: Attr super attr -> Attr (Composite super user) attr-mapFromSuper = mapAttrW pickSuper- -- |Used when an attribute should apply to the "usertype"-mapFromUser :: Attr user attr -> Attr (Composite super user) attr-mapFromUser = mapAttrW pickUser+mapUserAttr :: Attr user attr -> Attr (Composite user) attr+mapUserAttr = mapAttrW pickUser --- *** Inherit from Panel ()-instance Widget (Composite super user) where-    widget (Composite w _ _) = widget w+-- |Used when an attribute should apply to the inherited "usertype"+mapInheritedAttr :: Attr super attr -> Attr (CompositeInherit super) attr+mapInheritedAttr = mapAttrW (inherit . pickUser) -instance Able (Composite super user) where-    enabled = mapFromPanel enabled+-- *** Inherit from Widget w+instance Widget (Composite user) where+    widget (Composite w _) = widget w -instance Bordered (Composite super user) where-    border = mapFromPanel border+instance Able (Composite user) where+    enabled = mapPanelAttr enabled -instance Child (Composite super user) where-    parent = mapFromPanel parent+instance Bordered (Composite user) where+    border = mapPanelAttr border -instance Colored (Composite super user) where+instance Child (Composite user) where+    parent = mapPanelAttr parent++instance Colored (Composite user) where     bgcolor = forAllChildren bgcolor bgcolor     color   = forAllChildren color color  -- Does this instance declaration make sense?-instance Dimensions (Composite super user) where-    outerSize   = mapFromPanel outerSize-    position    = mapFromPanel position-    area        = mapFromPanel area-    bestSize    = mapFromPanel bestSize-    clientSize  = mapFromPanel clientSize-    virtualSize = mapFromPanel virtualSize+instance Dimensions (Composite user) where+    outerSize   = mapPanelAttr outerSize+    position    = mapPanelAttr position+    area        = mapPanelAttr area+    bestSize    = mapPanelAttr bestSize+    clientSize  = mapPanelAttr clientSize+    virtualSize = mapPanelAttr virtualSize -instance Identity (Composite super user) where-    identity = mapFromPanel identity+instance Identity (Composite user) where+    identity = mapPanelAttr identity -instance Literate (Composite super user) where+instance Literate (Composite user) where     font          = forAllChildren font font     fontSize      = forAllChildren fontSize fontSize     fontWeight    = forAllChildren fontWeight fontWeight@@ -166,96 +175,96 @@     textColor     = forAllChildren textColor textColor     textBgcolor   = forAllChildren textBgcolor textBgcolor -instance Visible (Composite super user) where-    visible = mapFromPanel visible-    refresh (Composite w _ _) = refresh w-    fullRepaintOnResize = mapFromPanel fullRepaintOnResize+instance Visible (Composite user) where+    visible = mapPanelAttr visible+    refresh (Composite w _) = refresh w+    fullRepaintOnResize = mapPanelAttr fullRepaintOnResize     -- fullRepaintOnResize unfortunately do not make any sense,     -- it must be set at creation time, but the panel has no     -- attributes set at creation time :(  -- *** Inherit from super -instance Checkable super => Checkable (Composite super user) where-    checkable = mapFromSuper checkable-    checked   = mapFromSuper checked+instance Checkable super => Checkable (CompositeInherit super) where+    checkable = mapInheritedAttr checkable+    checked   = mapInheritedAttr checked -instance Help super => Help (Composite super user) where-    help = mapFromSuper help+instance Help super => Help (CompositeInherit super) where+    help = mapInheritedAttr help -instance Observable super => Observable (Composite super user) where-    change = mapEventSuper change+instance Observable super => Observable (CompositeInherit super) where+    change = mapInheritedEvent change -instance Tipped super => Tipped (Composite super user) where-    tooltip = mapFromSuper tooltip+instance Tipped super => Tipped (CompositeInherit super) where+    tooltip = mapInheritedAttr tooltip  -- if we change String into just "a", then we also need the flag -- -fallow-undecidable-instances, which we do not want to do.-instance Items super String => Items (Composite super user) String where-    itemCount      = mapFromSuper itemCount-    items          = mapFromSuper items-    item x         = mapFromSuper (item x)-    itemDelete w x = itemDelete  (pickSuper w) x-    itemsDelete w  = itemsDelete (pickSuper w)-    itemAppend w x = itemAppend  (pickSuper w) x+instance Items super String => Items (CompositeInherit super) String where+    itemCount      = mapInheritedAttr itemCount+    items          = mapInheritedAttr items+    item x         = mapInheritedAttr (item x)+    itemDelete w x = itemDelete  (inherit $ pickUser w) x+    itemsDelete w  = itemsDelete (inherit $ pickUser w)+    itemAppend w x = itemAppend  (inherit $ pickUser w) x -instance Selection super => Selection (Composite super user) where-    selection = mapFromSuper selection+instance Selection super => Selection (CompositeInherit super) where+    selection = mapInheritedAttr selection -instance Selections super => Selections (Composite super user) where-    selections = mapFromSuper selections+instance Selections super => Selections (CompositeInherit super) where+    selections = mapInheritedAttr selections -instance Textual super => Textual (Composite super user) where-    text = mapFromSuper text+instance Textual super => Textual (CompositeInherit super) where+    text = mapInheritedAttr text  -- We need to use (super a) to make this instance decidable-instance ValuedWidget a (super a) => ValuedWidget a (Composite (super a) user) where-    widgetValue = mapFromSuper widgetValue+instance ValuedWidget a (super a) => ValuedWidget a (Composite (Inherit (super a))) where+    widgetValue = mapInheritedAttr widgetValue  -- *** Events --- | Mapping events from supertype-mapEventSuper :: Event super event -> Event (Composite super user) event-mapEventSuper event = mapEventF pickSuper event- -- | Mapping events from the Panel ()-mapEventPanel :: (forall w. Event (Window w) event) -> Event (Composite super user) event-mapEventPanel event = newEvent "" getter setter where-    getter (Composite w _ _)     = get w (on event)-    setter (Composite w _ _) val = set w [ on event := val ]+mapPanelEvent :: (forall w. Event (Window w) event) -> Event (Composite user) event+mapPanelEvent event = newEvent "" getter setter where+    getter (Composite w _)     = get w (on event)+    setter (Composite w _) val = set w [ on event := val ] +-- |Mapping events from the inherited "usertype"+mapInheritedEvent :: Event super event -> Event (CompositeInherit super) event+mapInheritedEvent event = mapEventF (inherit . pickUser) event+ -- | Mapping events using a mapper function mapEventF :: (to -> from) -> Event from event -> Event to event mapEventF f event = newEvent "" getter setter where     getter w     = get (f w) (on event)     setter w val = set (f w) [ on event := val ]-            -instance Selecting super => Selecting (Composite super user) where-    select = mapEventSuper select -instance Commanding super => Commanding (Composite super user) where-    command = mapEventSuper command+instance Selecting super => Selecting (CompositeInherit super) where+    select = mapInheritedEvent select -instance Reactive (Composite super user) where-    mouse    = mapEventPanel mouse-    keyboard = mapEventPanel keyboard-    closing  = mapEventPanel closing-    idle     = mapEventPanel idle-    resize   = mapEventPanel resize-    focus    = mapEventPanel focus-    activate = mapEventPanel activate+instance Commanding super => Commanding (CompositeInherit super) where+    command = mapInheritedEvent command +instance Reactive (Composite user) where+    mouse    = mapPanelEvent mouse+    keyboard = mapPanelEvent keyboard+    closing  = mapPanelEvent closing+    idle     = mapPanelEvent idle+    resize   = mapPanelEvent resize+    focus    = mapPanelEvent focus+    activate = mapPanelEvent activate+ -- We should also do Paint  -- Should properly rename ValuedWidget to Valued, but there is already -- a type class called Valued in WxHaskell. However, WxHaskell's -- definition do not really work for widgets. It only seems to work -- for Var-s.-class ValuedWidget x w | w -> x where+class ValuedWidget value widget | widget -> value where     -- |An attribute for the value of a widget. The value should have as precise     -- a type as possible. For example a slider should properly have type Attr Slider Int.-    widgetValue :: Attr w x+    widgetValue :: Attr widget value   -- GHC error message: @@ -263,14 +272,8 @@ -- Use pattern-matching instead -- -- Thus we avoid pattern matching here.-updateSuper :: (super -> super') -> Composite super user -> Composite super' user-updateSuper f (Composite panel' super user) = Composite panel' (f super) user---- GHC error message: --- Record update for the non-Haskell-98 data type `Composite' is not (yet) supported--- Use pattern-matching instead------ Thus we avoid pattern matching here.-updateUser :: (user -> user') -> Composite super user -> Composite super user'-updateUser f (Composite panel' super user) = Composite panel' super (f user)+updateUser :: (user -> user') -> Composite user -> Composite user'+updateUser f (Composite panel' user) = Composite panel' (f user) +updateInherited :: (super -> super') -> CompositeInherit super -> CompositeInherit super'+updateInherited f (Composite panel' super) = Composite panel' (Inherit $ f $ inherit super)
src/Graphics/UI/WxGeneric/GenericWidget.hs view
@@ -63,7 +63,7 @@ instance ValuedWidget a (ValuedCmds a) where     widgetValue = newAttr "valued" pickGetValue pickSetValue -newtype GenWid a = GenWid (Composite (ValuedCmds a) ())+newtype GenWid a = GenWid (CompositeInherit (ValuedCmds a))     deriving ( Widget, Able, Bordered, Child, Dimensions, Identity, Literate, Visible, Reactive              , Observable, ValuedWidget a              )@@ -73,7 +73,7 @@             Window w -> IO a -> (a -> IO ()) -> IO (IO ()) -> (IO() -> IO())          -> GenWid a mkGenWid w getVal setVal getChg setChg = -    GenWid $ singleComposite w (ValuedCmds getVal setVal getChg setChg) ()+    GenWid $ singleComposite w (Inherit (ValuedCmds getVal setVal getChg setChg))  -- |Creates a GenWid using an Observable widget, a get-value action -- and a set-value action.@@ -100,4 +100,4 @@                            , pickSetValue = \x -> do old <- pickGetValue valuedCmds                                                      pickSetValue valuedCmds (newToOld old x)                            }-        in GenWid $ updateSuper updateCmds composite+        in GenWid $ updateInherited updateCmds composite