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}