module Graphics.UI.WX.Frame
(
Frame, frame, frameFixed, frameTool, frameEx
, frameLoadRes, frameLoadChildRes
, initialFrame
, MDIParentFrame, MDIChildFrame
, mdiParentFrame, mdiChildFrame
, mdiParentFrameEx, mdiChildFrameEx
, activeChild, activateNext, activatePrevious, arrangeIcons
, cascade, tile
) where
import Graphics.UI.WXCore
import Graphics.UI.WX.Types
import Graphics.UI.WX.Attributes
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
= frameDefaultStyle
frame :: [Prop (Frame ())] -> IO (Frame ())
frame props
= frameEx defaultStyle props objectNull
frameFixed :: [Prop (Frame ())] -> IO (Frame ())
frameFixed props
= frameEx (defaultStyle .-. wxMAXIMIZE_BOX .-. wxRESIZE_BORDER) props objectNull
frameTool :: [Prop (Frame ())] -> Window a -> IO (Frame ())
frameTool props parent
= frameEx (defaultStyle .-. wxFRAME_TOOL_WINDOW .-. wxFRAME_FLOAT_ON_PARENT) props parent
frameEx :: Style -> [Prop (Frame ())] -> Window a -> IO (Frame ())
frameEx style props parent
= 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
frameLoadRes :: FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())
frameLoadRes rc name props =
frameLoadChildRes objectNull rc name props
frameLoadChildRes :: Window a -> FilePath -> String -> [Prop (Frame ())] -> IO (Frame ())
frameLoadChildRes parent rc name props =
do res <- xmlResourceCreateFromFile rc wxXRC_USE_LOCALE
f <- xmlResourceLoadFrame res parent name
set f props
return f
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
mdiParentFrame :: [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())
mdiParentFrame props
= mdiParentFrameEx objectNull defaultStyle props
mdiParentFrameEx :: Window a -> Style -> [Prop (MDIParentFrame ())] -> IO (MDIParentFrame ())
mdiParentFrameEx parent stl props
= 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
mdiChildFrame :: MDIParentFrame a -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
mdiChildFrame parent props
= mdiChildFrameEx parent defaultStyle props
mdiChildFrameEx :: MDIParentFrame a -> Style -> [Prop (MDIChildFrame ())] -> IO (MDIChildFrame ())
mdiChildFrameEx parent stl props
= 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
activeChild :: ReadAttr (MDIParentFrame a) (MDIChildFrame ())
activeChild = readAttr "activeChild" mdiParentFrameGetActiveChild
activateNext :: MDIParentFrame a -> IO ()
activateNext = mdiParentFrameActivateNext
activatePrevious :: MDIParentFrame a -> IO ()
activatePrevious = mdiParentFrameActivatePrevious
arrangeIcons :: MDIParentFrame a -> IO ()
arrangeIcons = mdiParentFrameArrangeIcons
cascade :: MDIParentFrame a -> IO ()
cascade = mdiParentFrameCascade
tile :: MDIParentFrame a -> IO ()
tile = mdiParentFrameTile