[htoolkit-cvs] gio/src/Graphics/UI/GIO Process.hs,NONE,1.1 Attributes.hs,1.7,1.8 Events.hs,1.6,1.7 Window.hs,1.8,1.9

[<kr_...@us...>]

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 ----