|
From: <kr_...@us...> - 2003-04-26 20:03:39
|
Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv15534/gio/src/Graphics/UI/GIO
Modified Files:
Window.hs
Log Message:
Complete implementation for modal and modeless dialogs
Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Window.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Window.hs 14 Apr 2003 17:57:33 -0000 1.12
--- Window.hs 26 Apr 2003 20:03:05 -0000 1.13
***************
*** 13,17 ****
module Graphics.UI.GIO.Window
( Window, window, domain, resizeable, view, layout, autosize
! , dialog, modalDialog
-- * Internal
, windowHandle
--- 13,17 ----
module Graphics.UI.GIO.Window
( Window, window, domain, resizeable, view, layout, autosize
! , dialog, runDialog
-- * Internal
, windowHandle
***************
*** 30,36 ****
--------------------------------------------------------------------}
-- | A main window widget.
! data Window = Window{ hwindow :: WindowHandle
! , hparent :: WindowHandle
! , vdomain :: Var Size
, vresizeable :: Var Bool
, vautosize :: Var Bool
--- 30,35 ----
--------------------------------------------------------------------}
-- | A main window widget.
! data Window = Window{ hwindow :: WindowHandle
! , vdomain :: Var Size
, vresizeable :: Var Bool
, vautosize :: Var Bool
***************
*** 38,43 ****
, vbgcolor :: Var Color
, vhatch :: Var HatchStyle
! , vpaint :: Var PaintFunction
! , vlayout :: Var Layout
}
--- 37,42 ----
, vbgcolor :: Var Color
, vhatch :: Var HatchStyle
! , vpaint :: Var PaintFunction
! , vlayout :: Var Layout
}
***************
*** 45,50 ****
window :: [Prop Window] -> IO Window
window props
! = do hwnd <- Lib.createWindow
! w <- form hwnd nullHandle props
set w [bgcolor =: white]
set w props
--- 44,48 ----
window :: [Prop Window] -> IO Window
window props
! = do w <- Lib.createWindow >>= form
set w [bgcolor =: white]
set w props
***************
*** 52,77 ****
return w
!
! dialog :: [Prop Window] -> Window -> IO Window
! dialog props parent
! = do hwnd <- Lib.createDialog (hwindow parent)
! w <- form hwnd (hwindow parent) props
set w props
Lib.showWindow (hwindow w)
return w
! modalDialog :: [Prop Window] -> Window -> (Window -> IO ()) -> IO ()
! modalDialog props parent f
! = do hwnd <- Lib.createDialog (hwindow parent)
! w <- form hwnd (hwindow parent) props
! set w props
! f w
! Lib.runWindow (hwindow w)
! -- ugly technique to bring the parent in focus again
! f <- Lib.getWindowFrame (hwindow parent)
! Lib.setWindowFrame (hwindow parent) f
! form :: WindowHandle -> WindowHandle -> [Prop Window] -> IO Window
! form hwindow hparent props
= do w <- do vpaint <- newVar (\_ _ _ -> return ())
vautosize <- newVar True
--- 50,74 ----
return w
! -- | Create a modeless dialog box. If you want to make the dialog modal use 'runDialog' function.
! dialog :: [Prop Window]
! -> Maybe Window -- ^ The owner window of the dialog being created.
! -- If this parameter is Nothing or is a @Just handle@ of a window instead of dialog
! -- then the dialog owner is the process window. A dialog is always above its owner
! -- in the z-order and the system automatically destroys a dialog when its owner is
! -- destroyed. The dialog is automatically hidded when its owner is minimized.
! -> IO Window
! dialog props mb_parent
! = do let hparent = maybe Lib.nullHandle hwindow mb_parent
! w <- Lib.createDialog hparent >>= form
set w props
Lib.showWindow (hwindow w)
return w
! -- | Blocks in a recursive main loop until the dialog is destroyed.
! runDialog :: Window -> IO ()
! runDialog w = Lib.runDialog (hwindow w)
! form :: WindowHandle -> IO Window
! form hwindow
= do w <- do vpaint <- newVar (\_ _ _ -> return ())
vautosize <- newVar True
***************
*** 82,86 ****
vbgcolor <- newVar dialoggray
vhatch <- newVar HatchSolid
! return (Window hwindow hparent vdomain vresizeable vautosize
vcolor vbgcolor vhatch
vpaint vlayout
--- 79,83 ----
vbgcolor <- newVar dialoggray
vhatch <- newVar HatchSolid
! return (Window hwindow vdomain vresizeable vautosize
vcolor vbgcolor vhatch
vpaint vlayout
|