module tut8_5

// ********************************************************************************
// Clean tutorial example program.
//
// This program creates a Multiple Document Interface process with a Window menu.
// ********************************************************************************

import StdEnv, StdIO, Notice

Start :: *World -> *World
Start world 
# (id, world) = openId world
= startIO MDI Void (initialise id) [ProcessClose quit] world

quit :: (PSt .l) -> PSt .l
quit pst = openNotice notice pst
where
    notice = Notice ["Do you really want to quit?"]
            (NoticeButton "&Ok" (noLS closeProcess))
            [NoticeButton "&Cancel" id]

initialise :: Id (PSt .l) -> PSt .l
initialise closeid pst
    # (err, pst)        = openMenu 0 menu pst
    | err <> NoError    = abort "MDI could not open File Menu"
    | otherwise = pst
where
    menu = Menu "&File"
            ({newLS=1, newDef=MenuItem "&New" [MenuShortKey 'n', MenuFunction new]} :+:
             MenuItem "&Close" [MenuShortKey 'w', MenuFunction (noLS close), MenuId closeid, MenuSelectState Unable] :+:
             MenuSeparator [] :+:
             MenuItem "&Quit" [MenuShortKey 'q', MenuFunction (noLS quit)]) []

    close :: (PSt .l) -> PSt .l
    close pst
        # pst           = closeActiveWindow pst
        # (rest, pst)   = accPIO getWindowsStack pst
        | isEmpty rest  = appPIO (disableMenuElements [closeid]) pst
        | otherwise     = pst

    new :: (Int, PSt .l) -> (Int, PSt .l)
    new (i,pst)
        # (err, pst)        = openWindow Void window pst
        | err <> NoError
            # notice = Notice ["MDI could not open new window"] (NoticeButton "&Ok" id) []
            = (i, openNotice notice pst)
        | otherwise = (i+1, appPIO (enableMenuElements [closeid]) pst)
    where
        window = Window ("Window " +++ toString i) NilLS [
                WindowClose (noLS close),
                WindowViewSize {w=300, h=300},
                WindowLook True look ]

        look :: SelectState UpdateState *Picture -> *Picture
        look _ {newFrame=frame=:{corner1,corner2}} picture
            # picture = unfill frame picture
            # picture = draw frame picture
            # picture = drawLine corner1 corner2 picture
            = drawLine {corner1 & x=corner2.x} {corner2 & x=corner1.x} picture