1 files changed, 57 insertions, 0 deletions
diff --git a/tut10_4_1.icl b/tut10_4_1.icl
new file mode 100644
index 0000000..9feba9d
--- /dev/null
+++ b/tut10_4_1.icl
@@ -0,0 +1,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}
+