Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv22412/src/examples/simple
Modified Files:
Progress.hs
Log Message:
Added RangedSelect class and his instances for ProgressBar and Slider controls
Index: Progress.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/Progress.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Progress.hs 2 Apr 2003 21:33:55 -0000 1.2
--- Progress.hs 30 May 2003 13:07:06 -0000 1.3
***************
*** 3,7 ****
import Graphics.UI.GIO
! main = start SDI [] demo
maxSpeed = 200 :: Int
--- 3,7 ----
import Graphics.UI.GIO
! main = start "Progress" "1.0" SDI [] demo
maxSpeed = 200 :: Int
***************
*** 9,21 ****
demo = do
! w <- window [title =: "Progress", view =: sz 800 100, domain =: sz 800 80]
tm <- timer [interval =: maxSpeed `div` 2]
! prg <- hProgressBar True [progressRange =: (0,maxProgress)] w
! lbl <- label [text =: "Speed"] w
! sld <- hslider [sliderRange =: (0,maxSpeed), sliderPos =: maxSpeed `div` 2] w
set w [layout =: (hfill prg ^^^ (lbl <<< hfill sld))]
! set tm [on command =: set prg [progressPos ~: next]]
set sld [on command =: changeSpeed tm sld]
! set w [on destroy =: destroyTimer tm]
return ()
where
--- 9,21 ----
demo = do
! w <- window [view =: sz 800 100, domain =: sz 800 80]
tm <- timer [interval =: maxSpeed `div` 2]
! prg <- hProgressBar True [range =: (0,maxProgress)] w
! lbl <- label [title =: "Speed"] w
! sld <- hslider [range =: (0,maxSpeed), selectedPos =: maxSpeed `div` 2] w
set w [layout =: (hfill prg ^^^ (lbl <<< hfill sld))]
! set tm [on command =: set prg [selectedPos ~: next]]
set sld [on command =: changeSpeed tm sld]
! set w [on destroy =: destroyWidget tm]
return ()
where
***************
*** 24,27 ****
changeSpeed tm sld = do
! pos <- get sld sliderPos
set tm [interval =: maxSpeed-pos+20]
--- 24,27 ----
changeSpeed tm sld = do
! pos <- get sld selectedPos
set tm [interval =: maxSpeed-pos+20]
|
