/
Controls.hs
119 lines (104 loc) · 5.03 KB
/
Controls.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
{--------------------------------------------------------------------------------
Copyright (c) Daan Leijen 2003
wxWindows License.
Demonstrates:
- many different kind of controls
- message logging.
--------------------------------------------------------------------------------}
module Main where
import Graphics.UI.WX
import Graphics.UI.WXCore
main :: IO ()
main
= start gui
gui :: IO ()
gui
= do -- main gui elements: frame, panel, text control, and the notebook
f <- frame [text := "Controls"]
p <- panel f []
nb <- notebook p []
textlog <- textCtrl p [enabled := False, wrap := WrapNone]
-- use text control as logger
textCtrlMakeLogActiveTarget textlog
logMessage "logging enabled"
-- set f [on closing :~ \prev -> do logSetActiveTarget oldlog; logDelete log; prev]
-- button page
p1 <- panel nb []
ok <- button p1 [text := "Ok", on command := logMessage "ok button pressed"]
quit <- button p1 [text := "Quit", on command := close f]
-- radio box page
p2 <- panel nb []
let rlabels = ["first", "second", "third"]
r1 <- radioBox p2 Vertical rlabels [text := "radio box", on select ::= logSelect]
r2 <- radioBox p2 Horizontal rlabels [tooltip := "radio group two", on select ::= logSelect]
rb1 <- button p2 [text := "disable", on command ::= onEnable r1]
-- choice
p3 <- panel nb []
let clabels = ["mies","noot","aap"]
c1 <- choice p3 [tooltip := "unsorted choices", on select ::= logSelect, sorted := False, items := clabels]
c2 <- choice p3 [tooltip := "sorted choices", on select ::= logSelect, sorted := True, items := clabels]
cb1 <- button p3 [text := "disable", on command ::= onEnable c1]
-- list box page
p4 <- panel nb []
sl1 <- singleListBox p4
[items := clabels
,tooltip := "unsorted single-selection listbox"
,on select ::= logSelect]
sl2 <- singleListBox p4
[items := clabels
,tooltip := "sorted listbox"
,on select ::= logSelect, sorted := True]
sc1 <- checkBox p4 [text := "enable the listbox", checked := True, on command := set sl1 [enabled :~ not]]
-- slider/gauge page
p5 <- panel nb []
s <- hslider p5 True {- show labels -} 1 100 [selection := 50]
g <- hgauge p5 100 [selection := 50]
set s [on command := do{ i <- get s selection; set g [selection := i]} ]
-- specify layout
set f [layout :=
container p $
column 0
[ tabs nb
[tab "buttons" $
container p1 $ margin 10 $ floatCentre $ row 5 [widget ok, widget quit]
,tab "radio box" $
container p2 $ margin 10 $ column 5 [ hstretch $ widget rb1
, row 0 [floatLeft $ widget r1
,floatRight $ widget r2]]
,tab "choice" $
container p3 $ margin 10 $ column 5 [ hstretch $ widget cb1
, row 0 [floatLeft $ widget c1
,floatRight $ row 5 [label "sorted: ", widget c2]]]
,tab "listbox" $
container p4 $ margin 10 $ column 5 [ hstretch $ dynamic $ widget sc1
, floatLeft $
row 0 [widget sl1, widget sl2]]
,tab "slider" $
container p5 $ margin 10 $ column 5 [ hfill $ widget s
, hfill $ widget g
, glue
]
]
, hfill $ minsize (sz 20 80) $ widget textlog
]
, clientSize := sz 400 300 ]
return ()
where
-- logSelect :: (Selection w, Items w String) => w -> IO ()
logSelect w
= do i <- get w selection
s <- get w (item i)
logMessage ("selected index: " ++ show i ++ ": " ++ s)
onEnable w b
= do set w [enabled :~ not]
enable <- get w enabled
set b [text := (if enable then "disable" else "enable")]
-- kindof :: Object a -> String -> IO ()
kindof obj className
= do classInfo <- classInfoFindClass className
if (objectIsNull classInfo)
then logMessage ("kindof " ++ className ++ ": no such class")
else if (objectIsNull obj)
then logMessage ("kindof " ++ className ++ ": null object")
else do haskind <- objectIsKindOf obj classInfo
logMessage ("kindof " ++ className ++ ": " ++ show haskind)