[htoolkit-cvs] gio/src/Graphics/UI/GIO Controls.hs,1.8,1.9

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

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

Modified Files:
	Controls.hs 
Log Message:
Added implementation for ProgressBar and Slider controls


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Controls.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Controls.hs	26 Mar 2003 22:10:04 -0000	1.8
--- Controls.hs	27 Mar 2003 13:36:20 -0000	1.9
***************
*** 17,20 ****
--- 17,22 ----
                                 , Entry, entry, readOnly, visible
                                 , Popup, popup
+                                , Slider, hslider, vslider, sliderRange, sliderPos
+                                , ProgressBar, hProgressBar, vProgressBar, progressRange, progressPos
                                 , CheckGroup, checkGroup, checkLayout
                                 , RadioGroup, radioGroup, radioLayout
***************
*** 368,374 ****
    pack w  = stdPack (cparent w) (Port.getCheckBoxRequestSize (chandle w)) (Port.moveResizeControl (chandle w))
  
! {--------------------------------------------------------------------
!   Radio box
! --------------------------------------------------------------------}
  -- | A single radio control.
  data Radio    = Radio{ rhandle :: !WindowHandle
--- 370,376 ----
    pack w  = stdPack (cparent w) (Port.getCheckBoxRequestSize (chandle w)) (Port.moveResizeControl (chandle w))
  
! --------------------------------------------------------------------
! -- Radio box
! --------------------------------------------------------------------
  -- | A single radio control.
  data Radio    = Radio{ rhandle :: !WindowHandle
***************
*** 422,424 ****
      uncheck r  = set r [checked =: False]
  
!     minus xs i = take i rs ++ drop (i+1) rs
\ No newline at end of file
--- 424,525 ----
      uncheck r  = set r [checked =: False]
  
!     minus xs i = take i rs ++ drop (i+1) rs
!     
! --------------------------------------------------------------------
! -- Slider
! --------------------------------------------------------------------
! 
! -- | A slider control.
! data Slider = Slider{ shandle :: !WindowHandle
!                     , sparent :: !WindowHandle
!                     }
!                       
! -- | Create a horizontal slider control.
! hslider :: [Prop Slider] -> Window -> IO Slider
! hslider props w
!   = do r <- do hwnd    <- get w windowHandle
!                shandle <- Port.createHorzSlider hwnd
!                return (Slider shandle hwnd)
!        set r props
!        return r
!        
! -- | Create a vertical slider control.
! vslider :: [Prop Slider] -> Window -> IO Slider
! vslider props w
!   = do r <- do hwnd    <- get w windowHandle
!                shandle <- Port.createVertSlider hwnd
!                return (Slider shandle hwnd)
!        set r props
!        return r
! 
! sliderRange :: Attr Slider (Int,Int)
! sliderRange
!   = newAttr (\w   -> Port.getSliderRange (shandle w))
!             (\w (min,max) -> Port.setSliderRange (shandle w) min max)
!             
! sliderPos :: Attr Slider Int
! sliderPos
!   = newAttr (Port.getSliderPosition . shandle)
!             (Port.setSliderPosition . shandle)
! 
! instance Commanding Slider where
!   command = newControlCommandEvent shandle
! 
! instance Control Slider where
!   pack w  = stdPack (sparent w) (Port.getSliderRequestSize (shandle w)) (Port.moveResizeControl (shandle w))
! 
! 
! --------------------------------------------------------------------
! -- ProgressBar
! --------------------------------------------------------------------
! 
! -- | A progress bar.
! data ProgressBar = ProgressBar
!                     { pbhandle :: !WindowHandle
!                     , pbparent :: !WindowHandle
!                     , pbrange  :: Var (Int,Int)
!                     }
!                       
! -- | Create a horizontal progress bar.
! -- The boolean parameter specify whether the bar shows continuous or discrete values.
! hProgressBar :: Bool -> [Prop ProgressBar] -> Window -> IO ProgressBar
! hProgressBar smooth props w
!   = do r <- do hwnd     <- get w windowHandle
!                pbhandle <- Port.createHorzProgressBar hwnd smooth
!                pbrange  <- newVar (0,100)
!                Port.setProgressBarFraction pbhandle 0 100 0
!                return (ProgressBar pbhandle hwnd pbrange)
!        set r props
!        return r
!        
! -- | Create a vertical progress bar.
! -- The boolean parameter specify whether the bar shows continuous or discrete values.
! vProgressBar :: Bool -> [Prop ProgressBar] -> Window -> IO ProgressBar
! vProgressBar smooth props w
!   = do r <- do hwnd     <- get w windowHandle
!                pbhandle <- Port.createVertProgressBar hwnd smooth
!                pbrange  <- newVar (0,100)
!                Port.setProgressBarFraction pbhandle 0 100 0
!                return (ProgressBar pbhandle hwnd pbrange)
!        set r props
!        return r
! 
! progressRange :: Attr ProgressBar (Int,Int)
! progressRange
!   = newAttr (\w   -> getVar (pbrange w))
!             (\w r@(min,max) -> do
!             	pos <- Port.getProgressBarFraction (pbhandle w) min max
!             	Port.setProgressBarFraction (pbhandle w) min max pos
!             	setVar (pbrange w) r)
! 
! progressPos :: Attr ProgressBar Int
! progressPos
!   = newAttr (\w -> do
!                  (min,max) <- getVar (pbrange w)
!                  Port.getProgressBarFraction (pbhandle w) min max)
!             (\w pos -> do
!                  (min,max) <- getVar (pbrange w)
!                  Port.setProgressBarFraction (pbhandle w) min max pos)
! 
! instance Control ProgressBar where
!   pack w  = stdPack (pbparent w) (Port.getProgressBarRequestSize (pbhandle w)) (Port.moveResizeControl (pbhandle w))