htoolkit-cvs

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

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

Modified Files:
	Controls.hs 
Log Message:
Simplified API for RadioBox. The new API is much like the API for ToolGroup and MenuGroup


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Controls.hs,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** Controls.hs	20 Aug 2003 22:22:30 -0000	1.20
--- Controls.hs	21 Aug 2003 17:34:02 -0000	1.21
***************
*** 61,76 ****
                                 , ProgressBar, hProgressBar, vProgressBar
                                 
!                                -- ** CheckGroup
!                                , CheckGroup, checkGroup, checkLayout
                                 
!                                -- ** RadioGroup
!                                , RadioGroup, radioGroup, radioLayout
                                 
                                 -- ** CompoundControl
                                 , CompoundControl, compoundControl 
-                                
-                                -- * Primitive
-                                , Check, check
-                                , Radio, radio, radioSingleSelect
                                 ) where
  
--- 61,72 ----
                                 , ProgressBar, hProgressBar, vProgressBar
                                 
!                                -- ** CheckBox
!                                , CheckBox, checkBox
                                 
!                                -- ** RadioBox
!                                , RadioBox, radioBox, setRadioBoxGroup
                                 
                                 -- ** CompoundControl
                                 , CompoundControl, compoundControl 
                                 ) where
  
***************
*** 392,525 ****
      = newControlCommandEvent lbhandle
  
! {--------------------------------------------------------------------
!   Check group
! --------------------------------------------------------------------}
! -- | A check control group.
! data CheckGroup = CheckGroup{ checks   :: [Check]
!                             , cgparent :: !WindowHandle
!                             , cglayout :: Var ([Check] -> Layout)
!                             }
!                            
! -- | Create a new check control group that is initially layed out vertically.
! -- The items are specified by their label, their initial check state and their
! -- event handlers (that receive the current check state as an argument).
! checkGroup :: Container w => [(String,Bool,Bool -> IO ())] -> [Prop CheckGroup] -> w -> IO CheckGroup
! checkGroup items props w
!   = do cg <- do cs   <- mapM (\(txt,c,cmd) -> check txt [checked =: c, on command =:: checkCommand cmd] w) items
!                 cglayout <- newVar vertical
!                 return (CheckGroup cs (hwindow w) cglayout)
!        set cg props
!        cs <- get cg selection
!        set cg [selection =: cs]  -- invoke all handlers once
!        return cg
!   where
!     checkCommand cmd c
!       = do ischecked <- get c checked
!            cmd ischecked
! 
! -- | Change the layout of the check controls. For example:
! -- 
! -- > do w  <- window [] 
! -- >    cg <- checkGroup [...] [checkLayout =: horizontal] w
! --
! checkLayout :: Attr CheckGroup ([Check] -> Layout)
! checkLayout 
!   = newAttr (\w   -> getVar (cglayout w))
!             (\w f -> do setVar (cglayout w) f; Port.fireWindowReLayout (cgparent w))
! 
! instance MultiSelect CheckGroup where
!   selection
!     = newAttr getter setter
!     where
!       getter w
!         = do cs <- mapM (\c -> get c checked) (checks w)
!              return (map fst (filter snd (zip [0..] cs)))
! 
!       setter w xs
!         = mapM_ select (zip [0..] (checks w))
!         where
!           select (idx,c) = set c [checked =: (elem idx xs)]
! 
! instance Control CheckGroup where
!   pack w  = stdPackChangingLayout (cgparent w) (do f <- getVar (cglayout w); return (f (checks w)))
!        
! 
! {--------------------------------------------------------------------
!   Radio group
! --------------------------------------------------------------------}
! -- | A radio control group. Only
! -- one control can be selected at any time. 
! data RadioGroup = RadioGroup{ radios  :: [Radio]
!                             , commands:: [IO ()]
!                             , gparent :: !WindowHandle
!                             , gselect :: Var Int
!                             , glayout :: Var ([Radio] -> Layout)
!                             }
!                            
! -- | Create a new radio control group that is initially layed out vertically.
! radioGroup :: Container w => [(String,IO ())] -> [Prop RadioGroup] -> w -> IO RadioGroup
! radioGroup items props w
!   = do rg <- do rs <- mapM (\(first,(txt,cmd)) -> radioEx first txt [] w) (zip (True:repeat False) items)
!                 glayout <- newVar vertical
!                 gselect <- newVar 0
!                 return (RadioGroup rs (map snd items) (hwindow w) gselect glayout)
!        mapM_ (select rg) (zip [0..] (radios rg))
!        set rg [selected =: 0]
!        set rg props
!        return rg
!   where
!     select rg (i,r)
!       = set r [on command =: set rg [selected =: i]]
! 
! 
! -- | Change the layout of the radio controls. For example:
! -- 
! -- > do w  <- window [] 
! -- >    rg <- radioGroup [("red",set w [color =: red]),("blue",set w [color =: blue])] 
! -- >                     [radioLayout =: horizontal] w
! --
! radioLayout :: Attr RadioGroup ([Radio] -> Layout)
! radioLayout 
!   = newAttr (\w   -> getVar (glayout w))
!             (\w f -> do setVar (glayout w) f; Port.fireWindowReLayout (gparent w))
! 
! instance SingleSelect RadioGroup where
!   selected  
!     = newAttr (\w  -> getVar (gselect w)) setter
!     where
!       setter w i
!         = do setVar (gselect w) idx
!              mapM_ (select idx) (zip [0..] (radios w))
!              (commands w) !! idx
!         where
!           idx = bounded 0 (length (radios w)) i
! 
!       select idx (i,r)
!         = set r [checked =: (i==idx)]
!         
! 
! instance Control RadioGroup where
!   pack w  = stdPackChangingLayout (gparent w) (do f <- getVar (glayout w); return (f (radios w)))
!        
! 
! 
! {--------------------------------------------------------------------
!   Check box
! --------------------------------------------------------------------}
  -- | A single check control.
! data Check    = Check{ chandle :: !WindowHandle
!                      , cparent :: !WindowHandle
!                      }
  
  -- | Create a check control with a certain label.
! check :: Container w => String -> [Prop Check] -> w -> IO Check
! check txt props w
!   = do c <- do hcheck <- Port.createCheckBox (hwindow w) txt
!                return (Check hcheck (hwindow w))
         set c props
         return c
  
  
! instance Checked Check where
    checked = newAttr (\w   -> Port.getCheckBoxSelectState (chandle w))
                      (\w b -> do Port.setCheckBoxSelectState (chandle w) b
--- 388,412 ----
      = newControlCommandEvent lbhandle
  
! --------------------------------------------------------------------
! --  Check box
! --------------------------------------------------------------------
  -- | A single check control.
! data CheckBox = CheckBox
! 	{ chandle :: !WindowHandle
! 	, cparent :: !WindowHandle
! 	}
  
  -- | Create a check control with a certain label.
! checkBox :: Container w => [Prop CheckBox] -> w -> IO CheckBox
! checkBox props w
!   = do c <- do hcheck <- Port.createCheckBox (hwindow w)
!                return (CheckBox hcheck (hwindow w))
         set c props
         return c
  
+ instance Titled CheckBox where
+   title = newAttr (Port.getCheckBoxText . chandle) (Port.setCheckBoxText . chandle)
  
! instance Checked CheckBox where
    checked = newAttr (\w   -> Port.getCheckBoxSelectState (chandle w))
                      (\w b -> do Port.setCheckBoxSelectState (chandle w) b
***************
*** 527,540 ****
                                  cmd)
     
! instance Commanding Check where
    command = newControlCommandEvent chandle
    
! instance Able Check where
    enabled = newAttr (Port.getControlEnabled . chandle) (Port.setControlEnabled . chandle)
    
! instance ToolTip Check where
    tooltip = newAttr (Port.getControlTip . chandle) (Port.setControlTip . chandle)
  
! instance Control Check where
    pack w  = stdPack (cparent w) (Port.getCheckBoxRequestSize (chandle w)) (Port.moveResizeControl (chandle w))
  
--- 414,427 ----
                                  cmd)
     
! instance Commanding CheckBox where
    command = newControlCommandEvent chandle
    
! instance Able CheckBox where
    enabled = newAttr (Port.getControlEnabled . chandle) (Port.setControlEnabled . chandle)
    
! instance ToolTip CheckBox where
    tooltip = newAttr (Port.getControlTip . chandle) (Port.setControlTip . chandle)
  
! instance Control CheckBox where
    pack w  = stdPack (cparent w) (Port.getCheckBoxRequestSize (chandle w)) (Port.moveResizeControl (chandle w))
  
***************
*** 543,597 ****
  --------------------------------------------------------------------
  -- | A single radio control.
! data Radio    = Radio{ rhandle :: !WindowHandle
!                      , rparent :: !WindowHandle
!                      }
! 
! -- | Create a radio control with a certain label.
! radio :: Container w => String -> [Prop Radio] -> w -> IO Radio
! radio txt props w
!   = radioEx True txt props w
  
! -- | Create a radio control. Takes an extra argument that specifies
! -- that this is the first control in a group.
! radioEx :: Container w => Bool -> String -> [Prop Radio] -> w -> IO Radio
! radioEx first txt props w
!   = do r <- do hradio <- Port.createRadioBox (hwindow w) first txt
!                return (Radio hradio (hwindow w))
         set r props
         return r
  
  
! instance Checked Radio where
    checked = newAttr (\w   -> Port.getRadioBoxSelectState (rhandle w))
                      (\w b -> Port.setRadioBoxSelectState (rhandle w) b)
     
! instance Commanding Radio where
    command = newControlCommandEvent rhandle
  
! instance Able Radio where
    enabled = newAttr (Port.getControlEnabled . rhandle) (Port.setControlEnabled . rhandle)
    
! instance ToolTip Radio where
    tooltip = newAttr (Port.getControlTip . rhandle) (Port.setControlTip . rhandle)
  
! instance Control Radio where
    pack w  = stdPack (rparent w) (Port.getRadioBoxRequestSize (rhandle w)) (Port.moveResizeControl (rhandle w))
  
  
  -- | Connect a list of radio controls such that only one of them is selected
! -- at any time. Installs a new command handler on each of the controls, so the
! -- behaviour is undefined when a  command handler for a control is updated after
! -- calling 'radioSingleSelect'.
! radioSingleSelect :: [Radio] -> IO ()
! radioSingleSelect  rs
!   = mapM_ cmd (zip [0..] rs)
!   where
!     cmd (i,r)  = do io <- get r (on command)
!                     set r [on command =: do mapM_ uncheck (minus rs i); io]
! 
!     uncheck r  = set r [checked =: False]
  
-     minus xs i = take i rs ++ drop (i+1) rs
-     
  --------------------------------------------------------------------
  -- Slider
--- 430,471 ----
  --------------------------------------------------------------------
  -- | A single radio control.
! data RadioBox = RadioBox
! 	{ rhandle :: !WindowHandle
! 	, rparent :: !WindowHandle
! 	}
  
! -- | Create a radio control.
! radioBox :: Container w => [Prop RadioBox] -> w -> IO RadioBox
! radioBox props w
!   = do r <- do hradio <- Port.createRadioBox (hwindow w)
!                return (RadioBox hradio (hwindow w))
         set r props
         return r
  
+ instance Titled RadioBox where
+   title = newAttr (Port.getRadioBoxText . rhandle) (Port.setRadioBoxText . rhandle)
  
! instance Checked RadioBox where
    checked = newAttr (\w   -> Port.getRadioBoxSelectState (rhandle w))
                      (\w b -> Port.setRadioBoxSelectState (rhandle w) b)
     
! instance Commanding RadioBox where
    command = newControlCommandEvent rhandle
  
! instance Able RadioBox where
    enabled = newAttr (Port.getControlEnabled . rhandle) (Port.setControlEnabled . rhandle)
    
! instance ToolTip RadioBox where
    tooltip = newAttr (Port.getControlTip . rhandle) (Port.setControlTip . rhandle)
  
! instance Control RadioBox where
    pack w  = stdPack (rparent w) (Port.getRadioBoxRequestSize (rhandle w)) (Port.moveResizeControl (rhandle w))
  
  
  -- | Connect a list of radio controls such that only one of them is selected
! -- at any time.
! setRadioBoxGroup :: [RadioBox] -> IO ()
! setRadioBoxGroup items = Port.setRadioBoxGroup (map rhandle items)
  
  --------------------------------------------------------------------
  -- Slider