Tut 11.3.1 Talk revisited

1 files changed, 58 insertions, 0 deletions

diff --git a/tut11_3_1.icl b/tut11_3_1.icl
new file mode 100644
index 0000000..921e0bc
--- /dev/null
+++ b/tut11_3_1.icl
@@ -0,0 +1,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}
+    
+