|
From: <kr_...@us...> - 2003-03-30 18:49:11
|
Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv19641/gio/src/Graphics/UI/GIO
Modified Files:
Attributes.hs Events.hs Window.hs
Added Files:
Process.hs
Log Message:
The process related features are extracted into newly created module "Process". Added new process attribute "title" instead of title as parameter.
--- NEW FILE: Process.hs ---
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------------------
{-| Module : Process
Copyright : (c) Krasimir Angelov 2003
License : BSD-style
Maintainer : ka2...@ya...
Stability : provisional
Portability : portable
The process object is an abstraction which provides access to
attributes which are global for entire application.
-}
-------------------------------------------------------------------------------
module Graphics.UI.GIO.Process
( Process, pc
, start, quit, halt
) where
import System.Directory
import Graphics.UI.GIO.Types
import Graphics.UI.GIO.Attributes
import Graphics.UI.GIO.Events
import qualified Graphics.UI.Port as Lib
data Process
pc :: Process
pc = error "The Process is an abstract object and cannot be evaluated"
instance Deadly Process where
dismissWidget p = quit
dismiss = newEvent (const Lib.getProcessDismissHandler) (const Lib.setProcessDismissHandler) (const Lib.setProcessDismissDefHandler)
destroyWidget p = halt
destroy = newEvent (const Lib.getProcessDestroyHandler) (const Lib.setProcessDestroyHandler) (const Lib.setProcessDestroyDefHandler)
instance Titled Process where
title = newAttr (const Lib.getProcessTitle) (const Lib.setProcessTitle)
-- | Start the event loop.
start :: DocumentInterface -> [Prop Process] -> IO a -> IO ()
start di props io
= do curdir <- getCurrentDirectory
Lib.start di ((set pc props >> io) `catch` \err -> quit >> ioError err)
setCurrentDirectory curdir
-- | Force the event loop to terminate.
quit :: IO Bool
quit = Lib.quit
-- | Force the event loop to terminate.
halt :: IO ()
halt = Lib.halt
Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Attributes.hs 26 Mar 2003 19:20:23 -0000 1.7
--- Attributes.hs 30 Mar 2003 18:49:07 -0000 1.8
***************
*** 28,32 ****
The function 'get', 'set' and '(=:)' are polymorphic and work for all widgets, but
the @title@ attribute just works for windows. Many attributes are defined for multiple
! widgets and are organised in type classes, for example 'Widget' and 'Dimensions'.
The ('~:') operator is used to transform an attribute with an update function.
--- 28,32 ----
The function 'get', 'set' and '(=:)' are polymorphic and work for all widgets, but
the @title@ attribute just works for windows. Many attributes are defined for multiple
! widgets and are organised in type classes, for example 'Deadly' and 'Dimensions'.
The ('~:') operator is used to transform an attribute with an update function.
***************
*** 43,51 ****
-- * Common widget classes
! -- ** Widget
! , Widget
! , dismissWidget
! , destroyWidget
!
-- ** Dimensions
, Dimensions
--- 43,47 ----
-- * Common widget classes
!
-- ** Dimensions
, Dimensions
***************
*** 61,64 ****
--- 57,63 ----
-- ** Literate
, Literate, text, font
+
+ -- ** Titled
+ , Titled, title
-- ** Drawn
***************
*** 192,202 ****
Classes
--------------------------------------------------------------------}
! -- | Every window item is part of the 'Widget' class. The operations
! -- on widgets are 'dismissWidget' and 'destroyWidget'.
! class Widget w where
! -- | Close a widget
! dismissWidget :: w -> IO Bool
! destroyWidget :: w -> IO ()
!
-- | Widgets with dimensions have a width, height and position. Only the
-- 'frame' method is not defaulted.
--- 191,195 ----
Classes
--------------------------------------------------------------------}
!
-- | Widgets with dimensions have a width, height and position. Only the
-- 'frame' method is not defaulted.
***************
*** 255,258 ****
--- 248,256 ----
-- | The font.
font :: Attr w Font
+
+ -- | Widgets with a title.
+ class Titled w where
+ -- | The title.
+ title :: Attr w String
-- | Widgets that can be enabled or disabled.
Index: Events.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Events.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Events.hs 26 Mar 2003 08:54:55 -0000 1.6
--- Events.hs 30 Mar 2003 18:49:07 -0000 1.7
***************
*** 62,75 ****
-- * Basic events
-- ** Commanding
, Commanding, command
-- ** Reactive
, Reactive
, mouse, keyboard
-- ** Form
, Form, activate, deactivate, scroll, resize
-- ** Deadly
! , Deadly
! , destroy, dismiss
-- ** Paint
, Paint, paint, repaint
--- 62,81 ----
-- * Basic events
+
-- ** Commanding
, Commanding, command
+
-- ** Reactive
, Reactive
, mouse, keyboard
+
-- ** Form
, Form, activate, deactivate, scroll, resize
+
-- ** Deadly
! , Deadly
! , dismissWidget, dismiss
! , destroyWidget, destroy
!
-- ** Paint
, Paint, paint, repaint
***************
*** 155,163 ****
scroll :: Event w (Point -> IO ())
resize :: Event w (Size -> IO ())
!
-- | The Deadly widgets can be destroyed and dissmissed
class Deadly w where
-- | The 'dismiss' event is called when the user tries to close the form.
dismiss :: Event w (IO ())
-- | The destroy event is triggered when a widget is destroied.
destroy :: Event w (IO ())
--- 161,175 ----
scroll :: Event w (Point -> IO ())
resize :: Event w (Size -> IO ())
!
-- | The Deadly widgets can be destroyed and dissmissed
class Deadly w where
+ -- | Close a widget
+ dismissWidget :: w -> IO Bool
+
-- | The 'dismiss' event is called when the user tries to close the form.
dismiss :: Event w (IO ())
+
+ destroyWidget :: w -> IO ()
+
-- | The destroy event is triggered when a widget is destroied.
destroy :: Event w (IO ())
Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Window.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Window.hs 26 Mar 2003 15:39:46 -0000 1.8
--- Window.hs 30 Mar 2003 18:49:07 -0000 1.9
***************
*** 12,16 ****
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.Window
! ( Window, window, title, domain, resizeable, view, layout, autosize
, dialog, modalDialog
-- * Internal
--- 12,16 ----
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.Window
! ( Window, window, domain, resizeable, view, layout, autosize
, dialog, modalDialog
-- * Internal
***************
*** 118,126 ****
= varAttr vautosize
! -- | The title of the window.
! title :: Attr Window String
! title
! = newAttr (\w -> Lib.getWindowTitle (hwindow w))
! (\w x -> Lib.setWindowTitle (hwindow w) x)
-- | The window handle
--- 118,124 ----
= varAttr vautosize
! instance Titled Window where
! title = newAttr (\w -> Lib.getWindowTitle (hwindow w))
! (\w x -> Lib.setWindowTitle (hwindow w) x)
-- | The window handle
***************
*** 151,157 ****
(\w sz-> Lib.setWindowViewSize (hwindow w) sz)
! instance Widget Window where
dismissWidget w = Lib.dismissWindow (hwindow w)
! destroyWidget w = Lib.destroyWindow (hwindow w)
instance Dimensions Window where
--- 149,157 ----
(\w sz-> Lib.setWindowViewSize (hwindow w) sz)
! instance Deadly Window where
dismissWidget w = Lib.dismissWindow (hwindow w)
! dismiss = newDismissEvent hwindow
! destroyWidget w = Lib.destroyWindow (hwindow w)
! destroy = newDestroyEvent hwindow
instance Dimensions Window where
***************
*** 182,189 ****
resize = newResizeEvent hwindow
- instance Deadly Window where
- dismiss = newDismissEvent hwindow
- destroy = newDestroyEvent hwindow
-
instance Paint Window where
repaint w = do Lib.invalidateWindow (hwindow w)
--- 182,185 ----
|