この章では、wxHaskellのダイアログを説明します。
モードレスダイアログは、ダイアログを開いている間も、そのアプリケーションで、他の作業ができるダイアログです。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "ウィンドウ"]
d <- window f []
b <- button f [text := "Show dialog", on command := showDialog d]
set f [layout := floatCenter (widget b), clientSize := sz 250 150]
return ()
where
showDialog d= do
dial <- dialog d [visible := True
,text := "ダイアログ"
,layout := floatCentre (label
"Modeless dialog")
,clientSize := sz 200 100]
return ()
ダイアログをずらして、ウィンドウの「Show dialog」ボタンを押してください。何個もダイアログを表示できます。
モーダルダイアログは、ダイアログを開いている間は、そのアプリケーションで、他の作業ができないダイアログです。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "ウィンドウ"]
d <- window f []
b <- button f [text := "Show dialog", on command := showDialog d]
set f [layout := floatCenter (widget b), clientSize := sz 250 150]
return ()
where
showDialog d = do
dial <- dialog d [text := "ダイアログ"]
ok <- button dial [text := "OK"]
set dial [layout := floatCentre $ column 10
[(label "Modal dialog")
,(widget ok)]
,clientSize := sz 200 100
,defaultButton := ok]
result <- showModal dial (\stop -> set ok [on command := stop (Just 0)])
return ()
ダイアログをずらして、ウィンドウの「Show dialog」ボタンを押してください。警告が出てウィンドウを線選択できないか、ボタンを押しても反応しません。
macでは、デフォルトボタンは機能しません。
wxHaskellには、メッセージと呼ばれる、便利なダイアログがいくつか用意されています。
module Main where
import Graphics.UI.WX
import Graphics.UI.WX.Dialogs
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "メッセージ"]
error <- button f [text := "Error"
,on command := errorDialog f "失敗"
"ファイルの読み込みに失敗しました。"]
warning <- button f [text := "Warning"
,on command := warningDialog f "警告"
"許可されていない操作です。"]
info <- button f [text := "Info"
,on command := infoDialog f "情報"
"ダウンロードが完了しました。"]
confirm <- button f [text := "Confirm"
,on command := selectConfirm f]
proceed <- button f [text := "Proceed"
,on command := selectProceed f]
set f [layout := fill $ boxed "Messages" (grid 5 5
[
[floatCenter (widget error), floatCenter (widget warning)],
[floatCenter (widget info), floatCenter (widget confirm)],
[floatCenter (widget proceed)]
])
,clientSize := sz 250 150
]
return ()
where
selectConfirm f = do
confirmDialog f "確認" "本当に終了しますか?" False
return ()
selectProceed f = do
proceedDialog f "削除してもよろしいですか?" "この操作は取り消せません。"
return ()
module Main where
import Graphics.UI.WX
import Graphics.UI.WXCore
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "カラーダイアログ"]
p <- panel f [bgcolor := green]
b <- button f [text := "Choose color", on command := chooseColor f p]
set f [layout := margin 5 $ column 0
[row 0 [widget b, hfill(label "")]
,fill (boxed "color" (fill(widget p)))
]
,clientSize := sz 250 150
]
return ()
where
chooseColor f p = do
curCol <- get p (bgcolor)
newCol <- colorDialog f curCol
if newCol /= Nothing
then do
set p [bgcolor := col newCol]
else do
set p [bgcolor := curCol]
refresh p
where
col :: (Maybe Color) -> Color
col c =
case c of
Just x -> x
macでは、正常に動作します。
winでは、wxHaskellのフォントダイアログでは、すべてのフォントに下線がついてしまいます。
Linuxでは、文字化けしているフォントが多いです。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "フォントダイアログ"]
p <- panel f []
s <- staticText p [text := "app Design"]
b <- button p [text := "Choose font", on command := chooseFont f s]
set f [layout := margin 5 $ container p $ column 0
[widget b
,floatLeft (widget s)
]
,clientSize := sz 250 150
]
return ()
where
chooseFont f s = do
curFont <- get s (font)
newFont <- fontDialog f curFont
if newFont /= Nothing
then do
set s [font := unwrap newFont]
else do
set s [font := curFont]
where
unwrap :: (Maybe FontStyle) -> FontStyle
unwrap wrapVal =
case wrapVal of
Just x -> x
ファイルオープンダイアログの例として、Haskellファイルだけを開ける、「hsViewer」を作ってみました。実際にはすべてのテキストファイルを表示できますが、拡張子が「.hs」のファイルだけを表示するようにしました。なぜなら、画像ファイルとその他のファイルの区別はできるのですが、テキストファイルと実行ファイルの区別ができないのです。実行ファイルをテキストコントロールで開くと、アプリケーションがクラッシュしてしまします。そこで思い切って、「.hs」のファイルだけを表示できるようにしました。
Haskellファイル以外を選択した場合は、そのファイルのパスが表示されます。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "hsViewer"]
p <- panel f []
t <- textCtrl p []
m <- menuPane [text := "File"]
about <- menuAbout m [on command := infoDialog f "hsViewer"
"Version 1.0\n© appdesign.jp"]
open <- menuItem m [text := "Open", on command := openFile f t]
clear <- menuItem m [text := "Clear", on command := clearText t]
sep <- menuLine m
quit <- menuQuit m [on command := close f]
set f [layout := margin 5 $ container p $ fill (widget t)
,menuBar := [m]
,clientSize := sz 400 200
]
return ()
where
openFile f t = do
file <- fileOpenDialog f True True "Open file"
[("Haskell files",["*.hs"]),("Any file",["*.*"])] "" ""
if file /= Nothing
then do
let path = unwrap file
let len = length path
let suf = drop (len -3 ) path
if suf == ".hs"
then do
str <- readFile path
set t [text := str]
else do
set t [text := path]
else do
return ()
where
unwrap :: (Maybe FilePath) -> FilePath
unwrap wrapVal =
case wrapVal of
Just x -> x
clearText t = do
set t [text := ""]