diff --git a/src/Graphics/UI/WX/Classes.hs b/src/Graphics/UI/WX/Classes.hs --- a/src/Graphics/UI/WX/Classes.hs +++ b/src/Graphics/UI/WX/Classes.hs @@ -55,6 +55,7 @@ , Pictured( picture ) , Valued( value ) , Sized( size ) + , HasDefault( unsafeDefaultItem, defaultButton ) ) where import Data.Dynamic @@ -370,3 +371,17 @@ -- | The size of an object. (is 'outerSize' for 'Dimensions' widgets). size :: Attr w Size +{-------------------------------------------------------------------------- + HasDefault +--------------------------------------------------------------------------} +-- | Objects which activate a 'Window' by default keypress +class HasDefault w where + -- | Define a default item as any type deriving from 'Window'. Great care + -- is required when using this option as you will have to cast the item + -- to/from Window() using 'objectCast'. + -- For the common use case where the window in question is a 'Button', + -- please use 'defaultButton' as it is typesafe. + unsafeDefaultItem :: Attr w (Window ()) + -- | Define the default button for a 'TopLevelWindow'. This is recommended + -- for most use cases as the most common default control is a 'Button'. + defaultButton :: Attr w (Button ()) diff --git a/src/Graphics/UI/WX/Controls.hs b/src/Graphics/UI/WX/Controls.hs --- a/src/Graphics/UI/WX/Controls.hs +++ b/src/Graphics/UI/WX/Controls.hs @@ -25,7 +25,7 @@ , Wrap(..), Wrapped, wrap , Sorted, sorted -- * Containers - , Panel, panel, panelEx, defaultButton + , Panel, panel, panelEx , Notebook, notebook , focusOn -- * Controls @@ -87,8 +87,12 @@ -- controls. It has a standard background and maintains standard keyboard -- navigation (ie. /Tab/ moves through the controls). -- --- * Attributes: 'defaultButton', 'focusOn' +-- Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent +-- 'Frame' or 'Dialog' instead of this control now. This is an incompatible +-- change to support wxWidgets 2.8.x. -- +-- * Attributes: 'focusOn' +-- -- * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child', -- 'Able', 'Tipped', 'Identity', 'Styled', -- 'Textual', 'Literate' @@ -99,8 +103,12 @@ -- | Create a 'Panel' with a specific style. -- --- * Attributes: 'defaultButton', 'focusOn' +-- Note: 'defaultButton' attibute is removed. Set 'defaultButton' to parent +-- 'Frame' or 'Dialog' instead of this control now. This is an incompatible +-- change to support wxWidgets 2.8.x. -- +-- * Attributes: 'focusOn' +-- -- * Instances: 'Form' -- 'Dimensions', 'Colored', 'Visible', 'Child', -- 'Able', 'Tipped', 'Identity', 'Styled', -- 'Textual', 'Literate', 'Reactive', 'Paint' @@ -116,18 +124,6 @@ instance Form (Panel a) where layout = writeAttr "layout" windowSetLayout - -defaultButton :: Attr (Panel p) (Button ()) -defaultButton - = newAttr "defaultButton" getter setter - where - getter panel - = panelGetDefaultItem panel - - setter panel button - = do panelSetDefaultItem panel button - -- buttonSetDefault button -- note: seems to enlarge the button on GTK? - focusOn button -- | Set the initial focus on this control. focusOn :: Window a -> IO () diff --git a/src/Graphics/UI/WX/Events.hs b/src/Graphics/UI/WX/Events.hs --- a/src/Graphics/UI/WX/Events.hs +++ b/src/Graphics/UI/WX/Events.hs @@ -277,8 +277,8 @@ delKey = key KeyDelete homeKey = key KeyHome endKey = key KeyEnd -pgupKey = key KeyPrior -pgdownKey = key KeyNext +pgupKey = key KeyPageUp +pgdownKey = key KeyPageDown downKey = key KeyDown upKey = key KeyUp leftKey = key KeyLeft diff --git a/src/Graphics/UI/WX/Frame.hs b/src/Graphics/UI/WX/Frame.hs --- a/src/Graphics/UI/WX/Frame.hs +++ b/src/Graphics/UI/WX/Frame.hs @@ -2,6 +2,7 @@ -------------------------------------------------------------------------------- {-| Module : Frame Copyright : (c) Daan Leijen 2003 + Copyright : (c) Jeremy O'Donoghue 2007 License : wxWindows Maintainer : daan@cs.uu.nl @@ -12,7 +13,8 @@ * Instances: 'HasImage', 'Form', 'Closeable', 'Framed' -- 'Textual', 'Literate', 'Dimensions', 'Colored', 'Visible', 'Child', - 'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint'. + 'Able', 'Tipped', 'Identity', 'Styled', 'Reactive', 'Paint', + 'HasDefault'. -} @@ -20,6 +22,7 @@ module Graphics.UI.WX.Frame ( -- * Frames Frame, frame, frameFixed, frameTool, frameEx + , initialFrame -- * MDI Frames , MDIParentFrame, MDIChildFrame , mdiParentFrame, mdiChildFrame @@ -28,7 +31,6 @@ , activeChild, activateNext, activatePrevious, arrangeIcons , cascade, tile -- * Internal - , initialFrame, initialResizeable, initialMaximizeable, initialMinimizeable, initialCloseable ) where import Graphics.UI.WXCore @@ -38,6 +40,7 @@ import Graphics.UI.WX.Layout import Graphics.UI.WX.Classes import Graphics.UI.WX.Window +import Graphics.UI.WX.TopLevelWindow import Graphics.UI.WX.Events defaultStyle @@ -73,7 +76,6 @@ set f props return f - -- | initial Frame flags initialFrame :: (Id -> Rect -> String -> [Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a initialFrame cont @@ -88,50 +90,6 @@ cont id rect txt --- The icon of a frame. -instance Pictured (Frame a) where - picture - = writeAttr "picture" frameSetIconFromFile - - -instance Form (Frame a) where - layout - = writeAttr "layout" windowSetLayout - -instance Closeable (Frame a) where - close f - = unitIO (windowClose f True {- force? -}) - - -instance Framed (Frame a) where - resizeable - = windowResizeable - - maximizeable - = windowMaximizeable - - minimizeable - = windowMinimizeable - - closeable - = windowCloseable - - -instance Framed (Dialog a) where - resizeable - = windowResizeable - - maximizeable - = windowMaximizeable - - minimizeable - = windowMinimizeable - - closeable - = windowCloseable - - - {-------------------------------------------------------------------------- MDI frames --------------------------------------------------------------------------} @@ -202,83 +160,4 @@ tile = mdiParentFrameTile -{-------------------------------------------------------------------------- - Framed instances ---------------------------------------------------------------------------} --- | 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 :: CreateAttr (Window a) Bool -windowResizeable - = reflectiveAttr "resizeable" getFlag setFlag - where - getFlag w - = do s <- get w style - return (bitsSet wxRESIZE_BORDER s) - setFlag w resize - = set w [style :~ \stl -> if resize - then stl .+. wxRESIZE_BORDER .+. wxMAXIMIZE_BOX - else stl .-. wxRESIZE_BORDER .-. wxMAXIMIZE_BOX] - --- | Helper function that transforms the style accordding --- 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 :: CreateAttr (Window a) Bool -windowMaximizeable - = reflectiveAttr "maximizeable" getFlag setFlag - where - getFlag w - = do s <- get w style - return (bitsSet wxMAXIMIZE_BOX s) - setFlag w max - = set w [style :~ \stl -> if max then stl .+. wxMAXIMIZE_BOX else stl .-. wxMAXIMIZE_BOX] - --- | Helper function that transforms the style accordding --- 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 :: CreateAttr (Window a) Bool -windowMinimizeable - = reflectiveAttr "minimizeable" getFlag setFlag - where - getFlag w - = do s <- get w style - return (bitsSet wxMINIMIZE_BOX s) - setFlag w min - = set w [style :~ \stl -> if min then stl .+. wxMINIMIZE_BOX else stl .-. wxMINIMIZE_BOX] - --- | Helper function that transforms the style accordding --- 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 :: CreateAttr (Window a) Bool -windowCloseable - = reflectiveAttr "closeable" getFlag setFlag - where - getFlag w - = do s <- get w style - return (bitsSet wxCLOSE_BOX s) - setFlag w min - = set w [style :~ \stl -> if min then stl .+. wxCLOSE_BOX else stl .-. wxCLOSE_BOX] - --- | Helper function that transforms the style accordding --- to the 'windowMinimizable' flag in of the properties -initialCloseable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a -initialCloseable - = withStyleProperty windowCloseable wxCLOSE_BOX + diff --git a/src/Graphics/UI/WX/Media.hs b/src/Graphics/UI/WX/Media.hs --- a/src/Graphics/UI/WX/Media.hs +++ b/src/Graphics/UI/WX/Media.hs @@ -17,7 +17,7 @@ Media(..) -- * Sound - , Wave, sound, playLoop, playWait + , sound, playLoop, playWait -- * Images , image, imageCreateFromFile, imageCreateFromPixels, imageGetPixels , imageCreateFromPixelArray, imageGetPixelArray @@ -90,29 +90,17 @@ sound fname = unsafePerformIO $ soundCreate fname False -{-# DEPRECATED Wave "Use Sound instead" #-} --- | Define Wave type synonym for people who are familiar with --- wxWidgets 2.4.x or lower name. -type Wave a = Sound a - instance Media (Sound a) where - play sound = - if (div wxVersion 100) == 24 - then unitIO (soundPlayCompatible sound True False) - else unitIO (soundPlay sound wxSOUND_ASYNC) + play sound = unitIO (soundPlay sound wxSOUND_ASYNC) stop = soundStop -- | Play a sound fragment repeatedly (and asynchronously). playLoop :: Sound a -> IO () playLoop sound - = if (div wxVersion 100) == 24 - then unitIO (soundPlayCompatible sound True True) - else unitIO (soundPlay sound $ wxSOUND_ASYNC .+. wxSOUND_LOOP) + = unitIO (soundPlay sound $ wxSOUND_ASYNC .+. wxSOUND_LOOP) -- | Play a sound fragment synchronously (i.e. wait till completion). playWait :: Sound a -> IO () playWait sound - = if (div wxVersion 100) == 24 - then unitIO (soundPlayCompatible sound False False) - else unitIO (soundPlay sound wxSOUND_SYNC) + = unitIO (soundPlay sound wxSOUND_SYNC) diff --git a/src/Graphics/UI/WX/TopLevelWindow.hs b/src/Graphics/UI/WX/TopLevelWindow.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/WX/TopLevelWindow.hs @@ -0,0 +1,152 @@ +{-# OPTIONS -fglasgow-exts #-} +-------------------------------------------------------------------------------- +{-| Module : TopLevelWindow + Copyright : (c) Jeremy O'Donoghue, 2007 + License : wxWindows + + Maintainer : jeremy.odonoghue@gamil.com + Stability : provisional + Portability : portable + + wxTopLevelwindow (wxWidgets >= 2.8.0) defines an (abstract) common base class + for wxFrame and wxDialog. + + In the wxHaskell implementation, TopLevel has been added to encapsulate + some of the common functionality between the 'Dialog' and 'Frame' modules. + + * Instances: 'HasDefault' + * Instances inherited from 'Window': 'Textual', 'Literate', 'Dimensions', + 'Colored', 'Visible', 'Child', 'Able', 'Tipped', 'Identity', + 'Styled', 'Reactive', 'Paint'. + +-} +-------------------------------------------------------------------------------- +module Graphics.UI.WX.TopLevelWindow + ( initialResizeable + , initialMaximizeable + , initialMinimizeable + , initialCloseable + ) where + +import Graphics.UI.WXCore + +import Graphics.UI.WX.Types +import Graphics.UI.WX.Attributes +import Graphics.UI.WX.Classes +import Graphics.UI.WX.Layout +import Graphics.UI.WX.Window +import Graphics.UI.WX.Events + +-- The default control activated by return key +instance HasDefault (TopLevelWindow a) where + unsafeDefaultItem = newAttr "unsafeDefaultItem" getter setter + where + getter :: (TopLevelWindow a) -> IO (Window ()) + getter tlw = topLevelWindowGetDefaultItem tlw + setter tlw win = topLevelWindowSetDefaultItem tlw win + defaultButton = newAttr "defaultButton" getter setter + where + getter :: (TopLevelWindow a) -> IO (Button ()) + getter tlw = topLevelWindowGetDefaultButton tlw + setter tlw win = topLevelWindowSetDefaultButton tlw win + +-- The icon of a frame. +instance Pictured (TopLevelWindow a) where + picture = writeAttr "picture" topLevelWindowSetIconFromFile + +-- Defaults for framed TopLevel windows +instance Framed (TopLevelWindow a) where + resizeable = windowResizeable + maximizeable = windowMaximizeable + minimizeable = windowMinimizeable + closeable = windowCloseable + +-- Default layout implementation +instance Form (Frame a) where + layout = writeAttr "layout" windowSetLayout + +-- Default window close +instance Closeable (Frame a) where + close f + = unitIO (windowClose f True {- force? -}) + +{-------------------------------------------------------------------------- + Framed instances +--------------------------------------------------------------------------} +-- | 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 :: CreateAttr (Window a) Bool +windowResizeable + = reflectiveAttr "resizeable" getFlag setFlag + where + getFlag w + = do s <- get w style + return (bitsSet wxRESIZE_BORDER s) + setFlag w resize + = set w [style :~ \stl -> if resize + then stl .+. wxRESIZE_BORDER .+. wxMAXIMIZE_BOX + else stl .-. wxRESIZE_BORDER .-. wxMAXIMIZE_BOX] + +-- | Helper function that transforms the style accordding +-- 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 :: CreateAttr (Window a) Bool +windowMaximizeable + = reflectiveAttr "maximizeable" getFlag setFlag + where + getFlag w + = do s <- get w style + return (bitsSet wxMAXIMIZE_BOX s) + setFlag w max + = set w [style :~ \stl -> if max then stl .+. wxMAXIMIZE_BOX else stl .-. wxMAXIMIZE_BOX] + +-- | Helper function that transforms the style accordding +-- 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 :: CreateAttr (Window a) Bool +windowMinimizeable + = reflectiveAttr "minimizeable" getFlag setFlag + where + getFlag w + = do s <- get w style + return (bitsSet wxMINIMIZE_BOX s) + setFlag w min + = set w [style :~ \stl -> if min then stl .+. wxMINIMIZE_BOX else stl .-. wxMINIMIZE_BOX] + +-- | Helper function that transforms the style accordding +-- 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 :: CreateAttr (Window a) Bool +windowCloseable + = reflectiveAttr "closeable" getFlag setFlag + where + getFlag w + = do s <- get w style + return (bitsSet wxCLOSE_BOX s) + setFlag w min + = set w [style :~ \stl -> if min then stl .+. wxCLOSE_BOX else stl .-. wxCLOSE_BOX] + +-- | Helper function that transforms the style accordding +-- to the 'windowMinimizable' flag in of the properties +initialCloseable :: ([Prop (Window w)] -> Style -> a) -> [Prop (Window w)] -> Style -> a +initialCloseable + = withStyleProperty windowCloseable wxCLOSE_BOX diff --git a/src/Graphics/UI/WX/Types.hs b/src/Graphics/UI/WX/Types.hs --- a/src/Graphics/UI/WX/Types.hs +++ b/src/Graphics/UI/WX/Types.hs @@ -68,22 +68,24 @@ -- * Geometrical types -- ** Points - , Point(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull + , Point, Point2(Point,pointX,pointY), point, pt, pointFromVec, pointFromSize, pointZero, pointNull , pointMove, pointMoveBySize, pointAdd, pointSub, pointScale -- ** Sizes - , Size(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull, sizeEncloses + , Size, Size2D(Size,sizeW,sizeH), sz, sizeFromPoint, sizeFromVec, sizeZero, sizeNull, sizeEncloses , sizeMin, sizeMax -- ** Vectors - , Vector(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull + , Vector, Vector2(Vector,vecX,vecY), vector, vec, vecFromPoint, vecFromSize, vecZero, vecNull , vecNegate, vecOrtogonal, vecAdd, vecSub, vecScale, vecBetween, vecLength + , vecLengthDouble -- ** Rectangles - , Rect(Rect,rectLeft,rectTop,rectWidth,rectHeight) + , Rect, Rect2D(Rect,rectLeft,rectTop,rectWidth,rectHeight) , rectTopLeft, rectTopRight, rectBottomLeft, rectBottomRight, rectBottom, rectRight , rect, rectBetween, rectFromSize, rectZero, rectNull, rectSize, rectIsEmpty , rectContains, rectMoveTo, rectFromPoint, rectCentralPoint, rectCentralRect, rectStretchTo + , rectCentralPointDouble, rectCentralRectDouble , rectMove, rectOverlaps, rectsDiff, rectUnion, rectOverlap, rectUnions -- * IO Control diff --git a/src/Graphics/UI/WX/Variable.hs b/src/Graphics/UI/WX/Variable.hs --- a/src/Graphics/UI/WX/Variable.hs +++ b/src/Graphics/UI/WX/Variable.hs @@ -14,7 +14,7 @@ ( variable ) where -import Data.IORef +import Control.Concurrent.STM.TVar import Graphics.UI.WX.Types( Var, varGet, varSet, varCreate, varUpdate ) import Graphics.UI.WX.Attributes import Graphics.UI.WX.Classes @@ -22,7 +22,7 @@ {-------------------------------------------------------------------- --------------------------------------------------------------------} -instance Valued IORef where +instance Valued TVar where value = makeAttr "value" varGet varSet varUpdate -- | Create a mutable variable. Change the value using the |value| attribute. diff --git a/src/Graphics/UI/WX/Window.hs b/src/Graphics/UI/WX/Window.hs --- a/src/Graphics/UI/WX/Window.hs +++ b/src/Graphics/UI/WX/Window.hs @@ -162,7 +162,7 @@ = windowSetSize w rect wxSIZE_USE_EXISTING bestSize - = readAttr "bestSize" windowGetAdjustedBestSize + = readAttr "bestSize" windowGetEffectiveMinSize position = newAttr "position" windowGetPosition windowMove diff --git a/wx.cabal b/wx.cabal --- a/wx.cabal +++ b/wx.cabal @@ -1,12 +1,12 @@ Name: wx -Version: 0.10.3 +Version: 0.10.4 License: LGPL License-file: license.txt Author: Daan Leijen Build-Type: Simple Category: GUI, User interfaces Cabal-Version: >= 1.2 -Description: wxHaskell is a portable and native GUI library for Haskell. It is built on top of wxWidgets - a comprehensive C++ library that is portable across all major GUI platforms; including GTK, Windows, X11, and MacOS X. At present, it works with wxWidgets 2.6 (and sadly, not with with wxWidgets 2.8) +Description: wxHaskell is a portable and native GUI library for Haskell. It is built on top of wxWidgets - a comprehensive C++ library that is portable across all major GUI platforms; including GTK, Windows, X11, and MacOS X. This version works with wxWidgets 2.8 only. Maintainer: wxhaskell-devel@lists.sourceforge.net Synopsis: wxHaskell Data-Files: wx.cabal @@ -16,13 +16,14 @@ Library if flag(splitBase) - build-depends: base >= 3, wxcore >= 0.10.1 + build-depends: base >= 3, wxcore >= 0.10.4, stm else - build-depends: base < 3, wxcore >= 0.10.1 + build-depends: base < 3, wxcore >= 0.10.4, stm Exposed-Modules: Graphics.UI.WX.Draw Graphics.UI.WX.Media + Graphics.UI.WX.TopLevelWindow Graphics.UI.WX.Attributes Graphics.UI.WX.Window Graphics.UI.WX.Variable