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
|
module tut11_3_1
// ********************************************************************************
// Clean tutorial example program.
//
// This program creates two interactive processes that communicate via message
// passing.
// In a future distributed version this program can be used as a graphical talk
// application.
//
// ********************************************************************************
import StdEnv, StdIO
:: Message = NewLine String | Quit
Start :: *World -> *World
Start world
# (a, world) = openRId world
# (b, world) = openRId world
# (talkA, world) = talk "A" a b world
# (talkB, world) = talk "B" b a world
= startProcesses [talkA, talkB] world
talk :: String (RId Message) (RId Message) *env -> (Process, *env) | Ids env
talk name me you env
# (outId, env) = openId env
# (inId, env) = openId env
# 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]
# receiver = Receiver me (noLS1 (receive outId)) []
# talkwindow = Window ("Talk " +++ name) (input :+: output :+: receiver) [WindowViewSize {w=hmm 50.0,h=120}]
# menu = Menu ("&Talk " +++ name) (MenuItem "&Quit" [MenuShortKey 'q', MenuFunction (noLS (quit you))]) []
= (Process SDI Void (snd o seqList [openWindow Void talkwindow, openMenu Void menu]) [ProcessClose (quit you)], env)
where
inputfilter :: KeyboardState -> Bool
inputfilter keystate = getKeyboardStateKeyState keystate <> KeyUp
input :: Id (RId Message) 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 (NewLine text) pst)
receive :: Id Message (PSt .l) -> PSt .l
receive _ Quit pst = closeProcess pst
receive outId (NewLine text) pst=:{io}
# io = setControlText outId text io
# io = setEditControlCursor outId (size text) io
= {pst & io=io}
quit :: (RId Message) (PSt .l) -> PSt .l
quit you pst = closeProcess (snd (syncSend you Quit pst))
resizeHalfHeight :: Size Size Size -> Size
resizeHalfHeight _ _ {w,h} = {w=w,h=h/2}
|
