[htoolkit-cvs] port/src/Port Controls.hs,1.12,1.13

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

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv10752/port/src/Port

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


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Controls.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Controls.hs	26 Mar 2003 22:09:53 -0000	1.12
--- Controls.hs	27 Mar 2003 13:36:21 -0000	1.13
***************
*** 24,27 ****
--- 24,31 ----
      
      * Radio item
+     
+     * Slider
+     
+     * ProgressBar
  -}
  -----------------------------------------------------------------------------------------
***************
*** 66,73 ****
             , getListBoxSingleSelection, setListBoxSingleSelection
             , getListBoxItemSelectState, setListBoxItemSelectState
             ) where
  
  import Foreign.C
- import Foreign.Ptr
  import Graphics.UI.Port.Types
  import Graphics.UI.Port.Handlers  -- just for haddock
--- 70,84 ----
             , getListBoxSingleSelection, setListBoxSingleSelection
             , getListBoxItemSelectState, setListBoxItemSelectState
+            -- * Slider
+            , createHorzSlider, createVertSlider, getSliderRequestSize
+            , getSliderRange,    setSliderRange
+            , getSliderPosition, setSliderPosition
+            -- * ProgressBar
+ 	   , createHorzProgressBar, createVertProgressBar, getProgressBarRequestSize
+ 	   , setProgressBarFraction, getProgressBarFraction
             ) where
  
+ import Foreign
  import Foreign.C
  import Graphics.UI.Port.Types
  import Graphics.UI.Port.Handlers  -- just for haddock
***************
*** 112,128 ****
  -- | The minimal size that the label needs.
  getLabelRequestSize :: WindowHandle -> IO Size
! getLabelRequestSize hwnd
!   = withCSizeResult $ \psize ->
!     osGetLabelReqSize hwnd psize
  foreign import ccall osGetLabelReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
  getLabelText :: WindowHandle -> IO String
! getLabelText hwnd
!   = resultCString (osGetLabelText hwnd)
  foreign import ccall osGetLabelText :: WindowHandle -> IO CString
  
  setLabelText :: WindowHandle -> String -> IO ()
! setLabelText hwnd txt
!   = withCString txt $ \ctxt -> osSetLabelText hwnd ctxt
  foreign import ccall osSetLabelText :: WindowHandle -> CString -> IO ()
  
--- 123,135 ----
  -- | The minimal size that the label needs.
  getLabelRequestSize :: WindowHandle -> IO Size
! getLabelRequestSize hwnd = withCSizeResult (osGetLabelReqSize hwnd)
  foreign import ccall osGetLabelReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
  getLabelText :: WindowHandle -> IO String
! getLabelText hwnd = resultCString (osGetLabelText hwnd)
  foreign import ccall osGetLabelText :: WindowHandle -> IO CString
  
  setLabelText :: WindowHandle -> String -> IO ()
! setLabelText hwnd txt = withCString txt (osSetLabelText hwnd)
  foreign import ccall osSetLabelText :: WindowHandle -> CString -> IO ()
  
***************
*** 140,156 ****
  -- | The minimal size that the button needs.
  getButtonRequestSize :: WindowHandle -> IO Size
! getButtonRequestSize hwnd
!   = withCSizeResult $ \psize ->
!     osGetButtonReqSize hwnd psize
  foreign import ccall osGetButtonReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
  getButtonText :: WindowHandle -> IO String
! getButtonText hwnd
!   = resultCString (osGetButtonText hwnd)
  foreign import ccall osGetButtonText :: WindowHandle -> IO CString
  
  setButtonText :: WindowHandle -> String -> IO ()
! setButtonText hwnd txt
!   = withCString txt $ \ctxt -> osSetButtonText hwnd ctxt
  foreign import ccall osSetButtonText :: WindowHandle -> CString -> IO ()
  
--- 147,159 ----
  -- | The minimal size that the button needs.
  getButtonRequestSize :: WindowHandle -> IO Size
! getButtonRequestSize hwnd = withCSizeResult (osGetButtonReqSize hwnd)
  foreign import ccall osGetButtonReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
  getButtonText :: WindowHandle -> IO String
! getButtonText hwnd = resultCString (osGetButtonText hwnd)
  foreign import ccall osGetButtonText :: WindowHandle -> IO CString
  
  setButtonText :: WindowHandle -> String -> IO ()
! setButtonText hwnd txt = withCString txt (osSetButtonText hwnd)
  foreign import ccall osSetButtonText :: WindowHandle -> CString -> IO ()
  
***************
*** 166,176 ****
  -- installed with 'registerCheckBoxClick'.
  createCheckBox :: WindowHandle -> String -> IO WindowHandle
! createCheckBox hwnd label
!   = withCString label $ \clabel -> osCreateCheckBox hwnd clabel
  foreign import ccall osCreateCheckBox :: WindowHandle -> CString -> IO WindowHandle
  
  getCheckBoxRequestSize :: WindowHandle -> IO Size
! getCheckBoxRequestSize hwnd
!   = withCSizeResult $ \psize -> osGetCheckBoxReqSize hwnd psize
  foreign import ccall osGetCheckBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 169,177 ----
  -- installed with 'registerCheckBoxClick'.
  createCheckBox :: WindowHandle -> String -> IO WindowHandle
! createCheckBox hwnd label = withCString label (osCreateCheckBox hwnd)
  foreign import ccall osCreateCheckBox :: WindowHandle -> CString -> IO WindowHandle
  
  getCheckBoxRequestSize :: WindowHandle -> IO Size
! getCheckBoxRequestSize hwnd = withCSizeResult (osGetCheckBoxReqSize hwnd)
  foreign import ccall osGetCheckBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 193,198 ****
  
  getEditRequestSize :: WindowHandle -> IO Size
! getEditRequestSize hwnd
!   = withCSizeResult $ \psize -> osGetEditReqSize hwnd psize
  foreign import ccall osGetEditReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 194,198 ----
  
  getEditRequestSize :: WindowHandle -> IO Size
! getEditRequestSize hwnd = withCSizeResult (osGetEditReqSize hwnd)
  foreign import ccall osGetEditReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 225,236 ****
  -- installed with 'registerRadioBoxClick'. 
  createRadioBox :: WindowHandle -> Bool -> String -> IO WindowHandle
! createRadioBox hwnd selected label
!   = withCString label $ \clabel ->
!     osCreateRadioBox hwnd (toCBool selected) clabel
! foreign import ccall osCreateRadioBox :: WindowHandle -> CBool -> CString -> IO WindowHandle
  
  getRadioBoxRequestSize :: WindowHandle -> IO Size
! getRadioBoxRequestSize hwnd
!   = withCSizeResult $ \psize -> osGetRadioBoxReqSize hwnd psize
  foreign import ccall osGetRadioBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 225,233 ----
  -- installed with 'registerRadioBoxClick'. 
  createRadioBox :: WindowHandle -> Bool -> String -> IO WindowHandle
! createRadioBox hwnd selected label = withCString label (osCreateRadioBox hwnd selected)
! foreign import ccall osCreateRadioBox :: WindowHandle -> Bool -> CString -> IO WindowHandle
  
  getRadioBoxRequestSize :: WindowHandle -> IO Size
! getRadioBoxRequestSize hwnd = withCSizeResult (osGetRadioBoxReqSize hwnd)
  foreign import ccall osGetRadioBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 253,260 ****
  -- An event handler for list box clicks can be
  -- installed with 'registerListBoxClick'.
! createListBox :: WindowHandle -> Bool -> IO WindowHandle
! createListBox hwnd multi
!   = osCreateListBox hwnd (toCBool multi)
! foreign import ccall osCreateListBox :: WindowHandle -> CBool -> IO WindowHandle
  
  appendListBoxItem :: WindowHandle -> String -> IO ()
--- 250,254 ----
  -- An event handler for list box clicks can be
  -- installed with 'registerListBoxClick'.
! foreign import ccall "osCreateListBox" createListBox :: WindowHandle -> Bool -> IO WindowHandle
  
  appendListBoxItem :: WindowHandle -> String -> IO ()
***************
*** 277,282 ****
  
  getListBoxRequestSize :: WindowHandle -> IO Size
! getListBoxRequestSize hwnd
!   = withCSizeResult $ \psize -> osGetListBoxReqSize hwnd psize
  foreign import ccall osGetListBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 271,275 ----
  
  getListBoxRequestSize :: WindowHandle -> IO Size
! getListBoxRequestSize hwnd = withCSizeResult (osGetListBoxReqSize hwnd)
  foreign import ccall osGetListBoxReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 309,316 ****
  -- An event handler for pop up clicks can be
  -- installed with 'registerPopUpClick'.
! createPopUp :: WindowHandle -> IO WindowHandle
! createPopUp hwnd 
!   = osCreatePopUp hwnd 
! foreign import ccall osCreatePopUp :: WindowHandle -> IO WindowHandle
  
  appendPopUpItem :: WindowHandle -> String -> IO ()
--- 302,306 ----
  -- An event handler for pop up clicks can be
  -- installed with 'registerPopUpClick'.
! foreign import ccall "osCreatePopUp" createPopUp :: WindowHandle -> IO WindowHandle
  
  appendPopUpItem :: WindowHandle -> String -> IO ()
***************
*** 333,338 ****
  
  getPopUpRequestSize :: WindowHandle -> IO Size
! getPopUpRequestSize hwnd
!   = withCSizeResult $ \psize -> osGetPopUpReqSize hwnd psize
  foreign import ccall osGetPopUpReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 323,327 ----
  
  getPopUpRequestSize :: WindowHandle -> IO Size
! getPopUpRequestSize hwnd = withCSizeResult (osGetPopUpReqSize hwnd)
  foreign import ccall osGetPopUpReqSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 347,348 ****
--- 336,400 ----
    = osSetPopUpSelection hwnd (toCInt i)
  foreign import ccall osSetPopUpSelection :: WindowHandle -> CInt -> IO ()
+ 
+ -----------------------------------------------------------------------------------------
+ -- Slider
+ -----------------------------------------------------------------------------------------
+ 
+ -- | Create a new horizontal slider control.
+ foreign import ccall "osCreateHorzSlider" createHorzSlider :: WindowHandle -> IO WindowHandle
+ 
+ -- | Create a new vertical slider control.
+ foreign import ccall "osCreateVertSlider" createVertSlider :: WindowHandle -> IO WindowHandle
+ 
+ getSliderRequestSize :: WindowHandle -> IO Size
+ getSliderRequestSize hwnd = withCSizeResult (osGetSliderReqSize hwnd)
+ foreign import ccall osGetSliderReqSize :: WindowHandle -> Ptr CInt -> IO ()
+ 
+ setSliderRange :: WindowHandle -> Int -> Int -> IO ()
+ setSliderRange hwnd min max = osSetSliderRange hwnd (toCInt min) (toCInt max)
+ foreign import ccall osSetSliderRange :: WindowHandle -> CInt -> CInt -> IO ()
+ 
+ getSliderRange :: WindowHandle -> IO (Int, Int)
+ getSliderRange hwnd = do
+ 	ptr <- mallocArray 2
+ 	pos <- osGetSliderRange hwnd ptr (ptr `advancePtr` 1)
+ 	min <- peekElemOff ptr 0
+ 	max <- peekElemOff ptr 1
+ 	return (fromCInt min, fromCInt max)
+ foreign import ccall osGetSliderRange :: WindowHandle -> Ptr CInt -> Ptr CInt -> IO ()
+ 
+ setSliderPosition :: WindowHandle -> Int -> IO ()
+ setSliderPosition hwnd pos = osSetSliderPosition hwnd (toCInt pos)
+ foreign import ccall osSetSliderPosition :: WindowHandle -> CInt -> IO ()
+ 
+ getSliderPosition :: WindowHandle -> IO Int
+ getSliderPosition hwnd
+   = do pos <- osGetSliderPosition hwnd
+        return (fromCInt pos)
+ foreign import ccall osGetSliderPosition :: WindowHandle -> IO CInt
+ 
+ -----------------------------------------------------------------------------------------
+ -- ProgressBar
+ -----------------------------------------------------------------------------------------
+ 
+ -- | Create a new horizontal progress bar.
+ -- The boolean parameter specify whether the bar shows continuous or discrete values.
+ foreign import ccall "osCreateHorzProgressBar" createHorzProgressBar :: WindowHandle -> Bool -> IO WindowHandle
+ 
+ -- | Create a new vertical progress bar.
+ -- The boolean parameter specify whether the bar shows continuous or discrete values.
+ foreign import ccall "osCreateVertProgressBar" createVertProgressBar :: WindowHandle -> Bool -> IO WindowHandle
+ 
+ getProgressBarRequestSize :: WindowHandle -> IO Size
+ getProgressBarRequestSize hwnd = withCSizeResult (osGetProgressBarReqSize hwnd)
+ foreign import ccall osGetProgressBarReqSize :: WindowHandle -> Ptr CInt -> IO ()
+ 
+ setProgressBarFraction :: WindowHandle -> Int -> Int -> Int -> IO ()
+ setProgressBarFraction hwnd min max pos = osSetProgressBarFraction hwnd (toCInt min) (toCInt max) (toCInt pos)
+ foreign import ccall osSetProgressBarFraction :: WindowHandle -> CInt -> CInt -> CInt -> IO ()
+ 
+ getProgressBarFraction :: WindowHandle -> Int -> Int -> IO Int
+ getProgressBarFraction hwnd min max = do
+ 	pos <- osGetProgressBarFraction hwnd (toCInt min) (toCInt max)
+ 	return (fromCInt pos)
+ foreign import ccall osGetProgressBarFraction :: WindowHandle -> CInt -> CInt -> IO CInt