mainnewfiledialog.hs

来自「HTK系列的」· HS 代码 · 共 45 行

-- -----------------------------------------------------------------------
--
-- $Source: /repository/uni/htk/examples/toolkit/Mainnewfiledialog.hs,v $
--
-- HTk - a GUI toolkit for Haskell  -  (c) Universitaet Bremen
--
-- $Revision: 1.1 $ from $Date: 2003/02/27 17:49:39 $  
-- Last modification by $Author: ger $
--
-- -----------------------------------------------------------------------

module Main (main) where

import HTk
import FileDialog
import System

main :: IO ()
main =
  do
    args <- getArgs
    homedir <- getEnv "HOME"
    let dir = case args of a:_ -> a; [] -> homedir
    main <- initHTk [text "file dialog example"]
    open <- newButton main [text ("Open file dialog ("++ dir++ ")"),
		            width 60]
    pack open [PadX 10, PadY 5]
    msg <- newLabel main [text "Welcome", font (Lucida, 12::Int),
                          height 2, relief Sunken, bg "white"]
    pack msg [PadX 10, PadY 5, Fill X, Expand On]
    quit <- newButton main [text "Quit"]
    pack quit [PadX 10, PadY 5, Fill X, Expand On]
    clickedquit <- clicked quit
    clickedopen <- clicked open
    spawnEvent (forever ((clickedquit >> always (destroy main)) +>
                         (clickedopen >>>
                            do selev <- newFileDialog "Open file" dir
			       file  <- sync selev
			       case file of
                                 Just fp ->
                                   msg # text ("selected " ++ fp) >> done
                                 _ -> msg #
                                        text "dialog canceled" >> done)))
    finishHTk