htoolkit-cvs

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

Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv15400/src/Graphics/UI/GIO

Modified Files:
	Attributes.hs Menu.hs Types.hs 
Added Files:
	ToolBar.hs 
Log Message:
Implementation for ToolBar


--- NEW FILE: ToolBar.hs ---
-----------------------------------------------------------------------------------------
{-| Module      :  ToolBar
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    ToolBar.
-}
-----------------------------------------------------------------------------------------
module Graphics.UI.GIO.ToolBar
		(
		-- * Creation
		  ToolBar,    toolBar
		, ToolButton, toolButtonAt, toolButton
		, ToolCheckButton, toolCheckButtonAt, toolCheckButton
		, ToolLine,   toolLineAt,   toolLine
		, DockPlace(..)
             	) where

import Graphics.UI.GIO.Attributes
import Graphics.UI.GIO.Events
import Graphics.UI.GIO.Types
import qualified Graphics.UI.Port as Lib
import Graphics.UI.Port(DockPlace(..))

--------------------------------------------------------------------
--  ToolBar
--------------------------------------------------------------------

data ToolBar = ToolBar {htoolbar :: WindowHandle}

toolBar :: String -> DockPlace -> Int -> Int -> Int -> [Prop ToolBar] -> IO ToolBar
toolBar name place band_num band_position offset props = do
	bar <- do hwnd <- Lib.createToolBar name place band_num band_position offset
	          return (ToolBar hwnd)
	set bar props
	return bar

instance Deadly ToolBar where
  destroyWidget t = Lib.destroyToolBar (htoolbar t)
  destroy            = newEvent (Lib.getWindowDestroyHandler . htoolbar) (Lib.setWindowDestroyHandler . htoolbar) (Lib.setWindowDestroyDefHandler . htoolbar)


--------------------------------------------------------------------
--  ToolButton
--------------------------------------------------------------------

data ToolButton = ToolButton {hbutton :: ToolHandle}

toolButtonAt :: Maybe Int -> [Prop ToolButton] -> ToolBar -> IO ToolButton
toolButtonAt pos props (ToolBar hwnd) = do
	btn <- do hbtn <- Lib.insertToolButton hwnd pos
	          return (ToolButton hbtn)
	set btn props
	return btn

toolButton :: [Prop ToolButton] -> ToolBar -> IO ToolButton
toolButton = toolButtonAt Nothing

instance Able ToolButton where
  enabled = newAttr (Lib.getToolButtonEnabled . hbutton) (Lib.setToolButtonEnabled . hbutton)

instance Commanding ToolButton where
  command =
    newEvent (Lib.getToolCommandHandler . hbutton) (Lib.setToolCommandHandler . hbutton) (Lib.setToolCommandDefHandler . hbutton)

instance HasIcon ToolButton where
  icon  = newAttr (Lib.getToolButtonBitmap . hbutton) (Lib.setToolButtonBitmap . hbutton)

instance Positioned ToolButton where
  pos = readAttr "pos" (Lib.getToolItemPos . hbutton)

instance ToolTip ToolButton where
  tooltip = newAttr (Lib.getToolButtonTip . hbutton) (Lib.setToolButtonTip . hbutton)

instance Titled ToolButton where
  title = newAttr (Lib.getToolButtonText . hbutton) (Lib.setToolButtonText . hbutton)

instance Deadly ToolButton where
  destroyWidget t = Lib.destroyToolItem (hbutton t)
  destroy            = newEvent (Lib.getToolDestroyHandler . hbutton) (Lib.setToolDestroyHandler . hbutton) (Lib.setToolDestroyDefHandler . hbutton)

--------------------------------------------------------------------
--  ToolCheckButton
--------------------------------------------------------------------

data ToolCheckButton = ToolCheckButton {hcheck :: ToolHandle}

toolCheckButtonAt :: Maybe Int -> [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton
toolCheckButtonAt pos props (ToolBar hwnd) = do
	btn <- do hbtn <- Lib.insertToolCheckButton hwnd pos
	          return (ToolCheckButton hbtn)
	set btn props
	return btn

toolCheckButton :: [Prop ToolCheckButton] -> ToolBar -> IO ToolCheckButton
toolCheckButton = toolCheckButtonAt Nothing

instance Able ToolCheckButton where
  enabled = newAttr (Lib.getToolButtonEnabled . hcheck) (Lib.setToolButtonEnabled . hcheck)

instance Commanding ToolCheckButton where
  command =
    newEvent (Lib.getToolCommandHandler . hcheck) (Lib.setToolCommandHandler . hcheck) (Lib.setToolCommandDefHandler . hcheck)

instance HasIcon ToolCheckButton where
  icon  = newAttr (Lib.getToolButtonBitmap . hcheck) (Lib.setToolButtonBitmap . hcheck)

instance Positioned ToolCheckButton where
  pos = readAttr "pos" (Lib.getToolItemPos . hcheck)

instance ToolTip ToolCheckButton where
  tooltip = newAttr (Lib.getToolButtonTip . hcheck) (Lib.setToolButtonTip . hcheck)

instance Titled ToolCheckButton where
  title = newAttr (Lib.getToolButtonText . hcheck) (Lib.setToolButtonText . hcheck)

instance Checked ToolCheckButton where
  checked = newAttr (Lib.getToolButtonChecked . hcheck) (Lib.setToolButtonChecked . hcheck)

instance Deadly ToolCheckButton where
  destroyWidget t = Lib.destroyToolItem (hcheck t)
  destroy            = newEvent (Lib.getToolDestroyHandler . hcheck) (Lib.setToolDestroyHandler . hcheck) (Lib.setToolDestroyDefHandler . hcheck)

--------------------------------------------------------------------
--  ToolLine
--------------------------------------------------------------------

data ToolLine = ToolLine {hline :: ToolHandle}

toolLineAt :: Maybe Int -> [Prop ToolLine] -> ToolBar -> IO ToolLine
toolLineAt pos props (ToolBar hwnd) = do
	line <- do hline <- Lib.insertToolLine hwnd pos
	           return (ToolLine hline)
	set line props
	return line

toolLine :: [Prop ToolLine] -> ToolBar -> IO ToolLine
toolLine = toolLineAt Nothing

instance Positioned ToolLine where
  pos = readAttr "pos" (Lib.getToolItemPos . hline)

instance Deadly ToolLine where
  destroyWidget t = Lib.destroyToolItem (hline t)
  destroy            = newEvent (Lib.getToolDestroyHandler . hline) (Lib.setToolDestroyHandler . hline) (Lib.setToolDestroyDefHandler . hline)

Index: Attributes.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Attributes.hs,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** Attributes.hs	8 Jun 2003 11:18:00 -0000	1.13
--- Attributes.hs	8 Jul 2003 20:36:26 -0000	1.14
***************
*** 78,81 ****
--- 78,84 ----
               , MultiSelect, selection
               , RangedSelect, range, selectedPos
+              
+              -- ** Icon
+              , HasIcon, icon
  
               -- * Internal
***************
*** 316,317 ****
--- 319,324 ----
    -- | The selected position
    selectedPos :: Attr w Int
+ 
+ -- | Widgets which displays an icon.
+ class HasIcon w where
+   icon :: Attr w (Maybe Bitmap)

Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Menu.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Menu.hs	8 Jun 2003 11:27:42 -0000	1.7
--- Menu.hs	8 Jul 2003 20:36:26 -0000	1.8
***************
*** 17,21 ****
                -- ** Menu item
              , MenuItem, menuitem, menuitemAt
-             , menuicon
  	      -- ** Checked menu items
              , MenuCheck, menucheck, menucheckAt
--- 17,20 ----
***************
*** 109,115 ****
    accel = newAttr (Lib.getMenuItemAccel . hitem) (Lib.setMenuItemAccel . hitem)
  
! menuicon :: Attr MenuItem (Maybe Bitmap)
! menuicon = newAttr (Lib.getMenuItemBitmap . hitem) 
!                    (Lib.setMenuItemBitmap . hitem)
  
  instance Positioned MenuItem where
--- 108,113 ----
    accel = newAttr (Lib.getMenuItemAccel . hitem) (Lib.setMenuItemAccel . hitem)
  
! instance HasIcon MenuItem where
!   icon  = newAttr (Lib.getMenuItemBitmap . hitem) (Lib.setMenuItemBitmap . hitem)
  
  instance Positioned MenuItem where

Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Types.hs,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** Types.hs	2 Jul 2003 17:50:47 -0000	1.13
--- Types.hs	8 Jul 2003 20:36:26 -0000	1.14
***************
*** 104,107 ****
--- 104,108 ----
              , CanvasHandle
              , MenuHandle
+             , ToolHandle
              , FontHandle
              , BitmapHandle