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
|
module tut10_4_1
// ********************************************************************************
// Clean tutorial example program.
//
// This program creates two windows that communicate with each other using message
// passing. Text that has been typed in one window is being sent to the other, and
// vice versa.
// ********************************************************************************
import StdEnv, StdIO
Start :: *World -> *World
Start world = startIO MDI Void initialise [ProcessClose closeProcess] world
where
initialise :: (PSt .l) -> PSt .l
initialise pst
# menu = Menu "&Talk" (MenuItem "&Quit" [MenuShortKey 'q', MenuFunction (noLS closeProcess)]) []
# (error, pst) = openMenu undef menu pst
| error <> NoError = abort "Talk could not open the menu."
# (a, pst) = accPIO openRId pst
# (b, pst) = accPIO openRId pst
# pst = openTalkWindow "A" a b pst
# pst = openTalkWindow "B" b a pst
= pst
openTalkWindow :: String (RId String) (RId String) (PSt .l) -> PSt .l
openTalkWindow name me you pst
# (inId, pst) = accPIO openId pst
# (outId, pst) = accPIO openId pst
# input = EditControl "" (PixelWidth (hmm 50.0)) 5 [ControlId inId, ControlResize resizeHalfHeight, ControlKeyboard inputfilter Able (noLS1 (input inId you))]
# output = EditControl "" (PixelWidth (hmm 50.0)) 5 [ControlId outId, ControlResize resizeHalfHeight, ControlPos (BelowPrev, zero), ControlSelectState Unable]
# (size, pst) = controlSize (input :+: output) True Nothing Nothing Nothing pst
# receiver = Receiver me (noLS1 (receive outId)) []
# wdef = Window ("Talk " +++ name) (input :+: output :+: receiver) [WindowViewSize size]
# (error, pst) = openWindow undef wdef pst
| error <> NoError = abort ("Talk could not open window " +++ name)
| otherwise = pst
where
inputfilter :: KeyboardState -> Bool
inputfilter keystate = getKeyboardStateKeyState keystate <> KeyUp
input :: Id (RId String) KeyboardState (PSt .l) -> PSt .l
input inId you _ pst
# (Just wst, pst) = accPIO (getParentWindow inId) pst
# text = fromJust (snd (getControlText inId wst))
= snd (asyncSend you text pst)
receive :: Id String (PSt .l) -> PSt .l
receive outId text pst=:{io}
# io = setControlText outId text io
# io = setEditControlCursor outId (size text) io
= {pst & io=io}
resizeHalfHeight :: Size Size Size -> Size
resizeHalfHeight _ _ {w,h} = {w=w,h=h/2}
|
