part of timer

gistfile1.hs

module Main where

import Graphics.UI.WX
import Graphics.UI.WXCore.WxcClassesAL(getApplicationDir,getApplicationPath)
import Data.Time(getZonedTime,formatTime)
import System.Locale(defaultTimeLocale)
import System.FilePath((</>))
import Data.Char
import TimeCalc(timeUp,reduceTime)



alarm = sound "alarm.wav"
defaultPause = 45

main::IO()
main = start gui

gui :: IO ()
gui =  do
        f <- frame [text := "timer",clientSize := sz 200 100]
        panel <- panel f [clientSize := sz 200 100]

        -- static text for displaying current time
        strCurrTime <- getStrCurrTime
        currTimeLbl <- staticText panel [text := strCurrTime]
        currTimeWatch <- timer currTimeLbl [on command := reshowCurrTime currTimeLbl]

        -- the spin controls for setting alarm interval
        hrCtrl  <- spinCtrl panel 0 99 [clientSize := sz 20 35]
        minCtrl <- spinCtrl panel 0 59 [clientSize := sz 20 35,text := show defaultPause]
        secCtrl <- spinCtrl panel 0 59 [clientSize := sz 20 35]
        -- media player
        appDir <- getApplicationDir
        -- start/cancel button
        startBtn  <- button panel [text := "Start"]
        cdTimer <- timer startBtn [enabled := False]
        set startBtn [on command := startBtnAction startBtn hrCtrl minCtrl secCtrl cdTimer]

        -- layout
        set panel [layout := margin 10 $ 
                        column 2 [centre $ widget currTimeLbl,boxed "choose time" $ 
                                row 1 [boxed "hour" $ minsize (sz 60 20) $ widget hrCtrl,boxed "minute" $ minsize (sz 60 20) $
                                        widget minCtrl,boxed "second" $ minsize (sz 60 20) $ widget secCtrl],widget startBtn]
                  ]
        set f [layout := widget panel]
        
reshowCurrTime :: Textual a => a -> IO ()
reshowCurrTime a = do
                        stime <- getStrCurrTime
                        set a [text := stime]

getStrCurrTime :: IO String
getStrCurrTime = do
                   ztime <- getZonedTime
                   let stime = formatTime defaultTimeLocale "%T" ztime
                   return stime

startBtnAction :: Button b -> SpinCtrl s -> SpinCtrl s -> SpinCtrl s-> Timer -> IO ()
startBtnAction startBtn hrCtrl minCtrl secCtrl cdTimer = do
                                              set startBtn [enabled := False]
                                              caption <- get startBtn text
                                              if caption == "Start" 
                                                 then do
                                                        set startBtn [text := "Stop"]
                                                        set cdTimer [enabled := True , on command := countDown startBtn hrCtrl minCtrl secCtrl cdTimer]
                                                 else   stopCount startBtn hrCtrl minCtrl secCtrl cdTimer
                                              set startBtn [enabled := True]

stopCount :: Button b -> SpinCtrl h -> SpinCtrl m -> SpinCtrl s -> Timer -> IO ()
stopCount b h m s t = do
        set b [text := "Start"]
        set t [enabled := False]
        hour <- get h selection
        min  <- get m selection
        sec  <- get s selection
        if (hour==0 && min==0 && sec==0) then set m [selection := defaultPause]
                                         else return ()
        stop alarm

countDown :: Button b -> SpinCtrl h -> SpinCtrl m -> SpinCtrl s-> Timer -> IO ()
countDown b h m s t     = do
        iHour <- get h selection
        iMin  <- get m selection
        iSec  <- get s selection
        let hour = show iHour
            min = show iMin
            sec = show iSec
        caption <- get b text
        if timeUp hour min sec then do
                                        set t [enabled := False]
                                        soundAlarm
                               else do 
                                        let rt = map read $ reduceTime hour min sec
                                        print rt
                                        set h [selection := head rt]
                                        set m [selection := (rt !! 1)]
                                        set s [selection := (rt !! 2)]

soundAlarm :: IO ()
soundAlarm = playLoop alarm