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
|
module support_slider
// ********************************************************************************
// Clean tutorial example program.
//
// This program can be used to test the different ControlAttributes for a
// SliderControl in a Dialog.
// ********************************************************************************
import StdEnv, StdIO
Start :: *World -> *World
Start world
# (sliderid, world) = openId world
# (textid, world) = openId world
# sliders = let w = PixelWidth 300
s = {sliderMin=0, sliderMax=100, sliderThumb=30} in [
SliderControl Horizontal w s (updateSlider textid) [ControlPos (Left, zero), ControlHide],
SliderControl Horizontal (PixelWidth 500) s (updateSlider textid) [ControlPos (Left, zero), ControlId sliderid],
SliderControl Horizontal w s (updateSlider textid) [ControlPos (RightTo sliderid, zero)],
SliderControl Horizontal w s (updateSlider textid) [ControlPos (Left, zero)], //todo
SliderControl Horizontal w s (updateSlider textid) [ControlPos (Left, zero), ControlSelectState Able],
SliderControl Vertical w s (updateSlider textid) [ControlPos (Left, zero), ControlSelectState Unable],
SliderControl Vertical (PixelWidth 500) s (updateSlider textid) [ControlPos (Left, zero), ControlTip "Some tip"]
]
# controls = TextControl "TextControl for callbacks" [ControlId textid] :+: ListLS sliders
# dialog = Dialog "Support - SliderControl" controls [WindowClose (noLS closeProcess)]
= startIO NDI Void (initialise dialog) [] world
where
initialise dialog pst
# (error,pst) = openDialog 0 dialog pst
| error <> NoError = closeProcess pst
| otherwise = pst
updateSlider :: Id SliderMove (Int, PSt .l) -> (Int, PSt .l)
updateSlider id move (n, pst) = (n, appPIO (setControlText id (toString move)) pst)
|
