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}