{-# OPTIONS -cpp -fglasgow-exts #-} 
module NetworkUI
    ( create
    , getConfig, Config
    ) where

import SafetyNet
import State
import StateUtil
import Network
import Document
import INRule
import Common
import CommonIO
import qualified PersistentDocument as PD
import qualified PDDefaults as PD
import InfoKind
import DisplayOptions
import Constants
import Text.XML.HaXml.XmlContent (XmlContent)
import Text.Parse as Parse
import Operations
import INReduction
import INChecksUI
import CommonUI

import Graphics.UI.WX hiding (Child, upKey, downKey, swap)
import Graphics.UI.WXCore
import Functional.UI

data Config = NFC
    { nfcWinDimensions  :: (Int, Int, Int, Int) -- x, y, width, height
    , nfcFileName       :: Maybe String
    , nfcSelection      :: Document.Selection
    }
    deriving (Read, Show)

getConfig :: State g n e -> IO Config
getConfig state =
  do{ theFrame      <- getNetworkFrame state
    ; (x, y)        <- safeGetPosition theFrame
    ; winSize       <- get theFrame clientSize
    ; pDoc          <- getDocument state
    ; maybeFileName <- PD.getFileName pDoc
    ; doc <- PD.getDocument pDoc
    ; return (NFC
        { nfcWinDimensions  = (x, y, sizeW winSize, sizeH winSize)
        , nfcFileName       = maybeFileName
        , nfcSelection      = getSelection doc
        })
    }


create :: (InfoKind n g, InfoKind e g, XmlContent g, Parse g, Show g) =>
          State g n e -> g -> n -> e -> GraphOps g n e -> IO ()
create state g n e ops =

{- Containment structure of widgets:  

	* theFrame :: Frame ()
		** mainPan :: Panel ()
			*** sp :: SplitterWindow ()
 				**** sp1 :: SplitterWindow ()
					***** sp2 :: SplitterWindow ()
						****** palettePan :: Panel ()
                                                        ******* palPan :: Panel ()
                                                        ******* addAgent :: Button ()
						****** rulesTreePan :: Panel ()
							******* tree :: TreeCtrl ()
                                                        ******* buttonNewRule :: Button ()
                                                        ******* buttonNewIRule :: Button ()
					***** sp3 :: SplitterWindow ()
						****** sp4 :: SplitterWindow ()
							******* ruleLHSPan :: Panel ()
								****** canvas
							******* ruleRHSPan :: Panel ()
                                                                ****** lhs2rhsB :: Button ()
								****** canvas
						****** netPan :: Panel ()
                                                        ******* canvas
                                                        ******* strategies :: RadioBox ()
                                                        ******* steps :: RadioBox ()
                                                        ******* reduceB :: Button ()
                                                        ******* reduceStopB :: Button ()
				**** textlog :: TextCtrl ()
-}  

 do{ theFrame <- frame [ text := "Interaction Nets editor"
                        , position      := pt 200 20
                        , clientSize    := sz 300 240 ]
    ; setNetworkFrame theFrame state

    -- Panels and SplitterWindows
    ; mainPan      <- panel theFrame []
    ; sp           <- splitterWindow mainPan []
    ; sp1          <- splitterWindow sp  []
    ; sp2          <- splitterWindow sp1 []
    ; sp3          <- splitterWindow sp1 []
    
    -- create a panel and put the Visible Palette with buttons on it 
    ; palettePan   <- panel sp2 [] 
    ; palPan <- panel palettePan [] 
    ; setPalettePanel palPan state

    ; rulesTreePan <- panel sp2 [] 
    ; sp4          <- splitterWindow sp3 []
#if !defined(__APPLE__)
    ; ruleLHSPan   <- panel sp4 []
#endif 
    ; ruleRHSPan   <- panel sp4 []

    ; netPan <- panel sp3 []
    -- Create page setup dialog and save in state
    ; pageSetupData  <- pageSetupDialogDataCreate
    ; initialPageSetupDialog <- pageSetupDialogCreate theFrame pageSetupData
    ; objectDelete pageSetupData
    ; setPageSetupDialog initialPageSetupDialog state

    -- Drawing area for net
    ; let (width, height) = getCanvasSize (Network.empty g n e)
    ; ppi <- getScreenPPI
    ; canvas <- scrolledWindow netPan
        [ virtualSize   := sz (logicalToScreenX ppi width)
                              (logicalToScreenY ppi height)
        , scrollRate    := sz 10 10
        , bgcolor       := wxcolor paneBackgroundColor
        , fullRepaintOnResize := False
        ]
    ; State.setCanvas canvas state

    -- Dummy persistent document to pass around
    ; pDoc <- getDocument state

    -- Attach handlers to drawing area
    ; set canvas
        [ on paint :=    \dc _ -> safetyNet theFrame $ paintHandler state dc Net
        , on mouse :=    \p    -> safetyNet theFrame $
                                      do setActiveCanvas Net state
                                         mouseEvent p canvas theFrame state
                                     --; focusOn canvas
        , on keyboard := \k    -> safetyNet theFrame $
                                      do setActiveCanvas Net state
                                         keyboardEvent theFrame state k
                                     --; focusOn canvas
        ]

    -- Drawing area for LHS
    ; let (width, height) = (100, 100) -- getCanvasSize (Network.empty g n e)
    ; ppi <- getScreenPPI
#if !defined(__APPLE__)
    ; canvasLHS <- scrolledWindow ruleLHSPan
#else
    ; canvasLHS <- scrolledWindow sp4
#endif
        [ virtualSize   := sz (logicalToScreenX ppi width)
                              (logicalToScreenY ppi height)
        , scrollRate    := sz 10 10
        , bgcolor       := wxcolor paneBackgroundColor
        , fullRepaintOnResize := False
        ]
    ; State.setLHSCanvas canvasLHS state

    -- Attach handlers to drawing area
    ; set canvasLHS
        [ on paint :=    \dc _ -> safetyNet theFrame 
                                    $ do rule <- getActiveRule state
                                         paintHandler state dc $ LHS rule 
        , on mouse :=    \p    -> safetyNet theFrame $
                                      do setActiveCanvas (LHS "") state
                                         mouseEvent p canvasLHS theFrame state
                                     --; focusOn canvasLHS
        , on keyboard := \k    -> safetyNet theFrame $
                                      do setActiveCanvas (LHS "") state
                                         keyboardEvent theFrame state k
                                     --; focusOn canvasLHS
        ]

    -- buttons to copy LHS to RHS
    ; lhs2rhsB <- button ruleRHSPan [ text := "==>"
                                    , tooltip := "Copy the LHS network to the RHS."
                                    , on command := safetyNet theFrame 
                                                      $ lhs2rhsItem True state
                                    ]
    -- only copies the interface
    ; lhsInt2rhsB <- button ruleRHSPan [ text := "=->"
                                       , tooltip := "Copy the LHS interface to the RHS."
                                       , on command := safetyNet theFrame 
                                                         $ lhs2rhsItem False state
                                       ]

    -- Drawing area for RHS
    ; let (width, height) = (100, 100) -- getCanvasSize (Network.empty g n e)
    ; ppi <- getScreenPPI
    ; canvasRHS <- scrolledWindow ruleRHSPan
        [ virtualSize   := sz (logicalToScreenX ppi width)
                              (logicalToScreenY ppi height)
        , scrollRate    := sz 10 10
        , bgcolor       := wxcolor paneBackgroundColor
        , fullRepaintOnResize := False
        ]
    ; State.setRHSCanvas canvasRHS state

    -- Attach handlers to drawing area
    ; set canvasRHS
        [ on paint :=    \dc _ -> safetyNet theFrame  
                                    $ do rule <- getActiveRule state
                                         paintHandler state dc $ RHS rule 
        , on mouse :=    \p    -> safetyNet theFrame $
                                      do setActiveCanvas (RHS "") state
                                         mouseEvent p canvasRHS theFrame state
                                     --; focusOn canvasLHS
        , on keyboard := \k    -> safetyNet theFrame $
                                      do setActiveCanvas (RHS "") state
                                         keyboardEvent theFrame state k
                                     --; focusOn canvasLHS
        ]

    -- to debug purposes
    ; textlog <- textCtrlRich sp [enabled := False, wrap := WrapNone]
    -- use text control as logger
    ; textCtrlMakeLogActiveTarget textlog

    -- File menu
    ; fileMenu   <- menuPane [ text := "&File" ]
    ; menuItem fileMenu
        [ text := "New\tCtrl+N"
        , on command := safetyNet theFrame $ newItem state g n e
        ]
    ; menuItem fileMenu
        [ text := "Open...\tCtrl+O"
        , on command := safetyNet theFrame $ openItem theFrame state
					      >> singleCheckOverIN iNCheck state
        ]
    ; saveItem <- menuItem fileMenu
        [ text := "Save\tCtrl+S"
        , on command := safetyNet theFrame $ checkValidINOnSave state $ PD.save pDoc
        ]
    ; menuItem fileMenu
        [ text := "Save as..."
        , on command := safetyNet theFrame $ checkValidINOnSave state $ PD.saveAs pDoc
        ]

    ; menuLine fileMenu

    ; menuItem fileMenu
        [ text := "Page setup..."
        , on command := safetyNet theFrame $
              do{ psd <- getPageSetupDialog state
                ; dialogShowModal psd
                ; return ()
                }
        ]

    ; menuItem fileMenu
        [ text := "Print..."
        , on command := safetyNet theFrame $
                let printFun _ printInfo _ dc _ =
                        do { dcSetUserScale dc
                                (fromIntegral (sizeW (printerPPI printInfo))
                                    / fromIntegral (sizeW (screenPPI printInfo)))
                                (fromIntegral (sizeH (printerPPI printInfo))
                                    / fromIntegral (sizeH (screenPPI printInfo)))
                           ; paintHandler state dc Net
                           }
                    pageFun _ _ _ = (1, 1)
                in
              do{ psd <- getPageSetupDialog state
                ; printDialog psd (toolName ++ " print") pageFun printFun
                }
        ]

    ; menuItem fileMenu
        [ text := "Print preview"
        , on command := safetyNet theFrame $
                let printFun _ _ _ dc _ = paintHandler state dc Net
                    pageFun _ _ _ = (1, 1)
                in
              do{ psd <- getPageSetupDialog state
                ; printPreview psd (toolName ++ " preview") pageFun printFun
                }
        ]

    ; menuLine fileMenu

    ; menuItem fileMenu
        [ text := "E&xit"
        , on command := close theFrame
        ]

    -- Edit menu
    ; editMenu   <- menuPane [ text := "&Edit" ]
    ; undoItem <- menuItem editMenu
        [ on command := safetyNet theFrame $ do PD.undo pDoc; repaintAll state ]
    ; redoItem <- menuItem editMenu
        [ on command := safetyNet theFrame $ do PD.redo pDoc; repaintAll state ]
{-
    ; menuLine editMenu
    ; menuItem editMenu
        [ text := "Edit global info..."
        , on command := safetyNet theFrame $ changeGlobalInfo theFrame state
        ]
-}

    -- View menu
    ; viewMenu   <- menuPane [ text := "&View" ]
    ; (DP opts)  <- getDisplayOptions state
    ; menuItem viewMenu
        [ text := "Node Label"
        , checkable := True
        , checked := NodeLabel `elem` opts
        , on command := safetyNet theFrame $ do
                            { changeDisplayOptions (toggle NodeLabel) state
                            ; repaintAll state } ]
{-
    ; menuItem viewMenu
        [ text := "Node Info"
        , checkable := True
        , checked := NodeInfo `elem` opts
        , on command := safetyNet theFrame $ do
                            { changeDisplayOptions (toggle NodeInfo) state
                            ; repaintAll state } ]
-}
    ; menuItem viewMenu
        [ text := "Edge Label"
        , checkable := True
        , checked := EdgeLabel `elem` opts
        , on command := safetyNet theFrame $ do
                            { changeDisplayOptions (toggle EdgeLabel) state
                            ; repaintAll state } ]
{-
    ; menuItem viewMenu
        [ text := "Edge Info"
        , checkable := True
        , checked := EdgeInfo `elem` opts
        , on command := safetyNet theFrame $ do
                            { changeDisplayOptions (toggle EdgeInfo) state
                            ; repaintAll state } ]
-}

    -- Operations menu
    ; opsMenu  <- menuPane [ text := "&Operations" ]
    ; mapM_ (\ (name,_)->
               menuItem opsMenu
                   [ text := name 
                   , on command := safetyNet theFrame $ do
                                       { callPureGraphOp name ops state
                                       ; repaintAll state }
                   ]
            ) (pureOps ops)
    ; when (not . null $ pureOps ops)
	$ menuLine opsMenu

    ; mapM_ (\ (name,_)->
               menuItem opsMenu
                   [ text := name 
                   , on command := safetyNet theFrame $ do
                                       { callIOGraphOp name ops state
                                       ; repaintAll state }
                   ]
            ) (ioOps ops)
    ; when (not . null $ ioOps ops)
	$ menuLine opsMenu

    ; menuItem opsMenu
	[ text := "Functional term to IN system"
	, on command := safetyNet theFrame $ compileUI state g n e
	]

    -- Palette menu
    ; palMenu <- menuPane [ text := "&Symbols" ]
    ; menuItem palMenu 
         [ text := "Save palette as ..."
         , on command := safetyNet theFrame $ savePalette theFrame state
         ]
    ; menuItem palMenu
        [ text := "Change shape palette..."
        , on command := safetyNet theFrame $ 
                          do yes <- confirmDialog theFrame "Dangerous operation!!" "Changing the palette can lead to severe errors.\nUnless you know what you are doing, don't proceed.\nDo you really want to proceed ?" False
                             when yes $ openPalette theFrame state
        ]

    -- Checks menu
    ; chksMenu <- menuPane [text := "&Checks"]
    ; mapM_ (\ chk@(name, desc,_,_,_) ->
		menuItem chksMenu [ text := name
				  , on command := safeAndClear theFrame textlog $ singleCheckOverIN chk state
				  ]
            ) checksList
    ; menuLine chksMenu
    ; menuItem chksMenu [ text := "Multiple checks at once"
			, on command := safeAndClear theFrame textlog $ multipleChecksOverIN_UI theFrame state
			]
    ; menuItem chksMenu [ text := "Checks over multiple files"
			, on command := safeAndClear theFrame textlog $ multipleChecksOverINs_UI state
			]

    -- Help menu
    ; helpMenu <- menuPane [ text := "&Help" ]
    ; menuItem helpMenu 
         [ text := "How to use?"
         , on command := createHelpWindow 
         ]
    ; menuItem helpMenu 
         [ text := "About"
         , on command := createAboutWindow theFrame
         ]

    ; PD.initialise pDoc (PD.PD
        { PD.document           = Document.empty g n e
        , PD.history            = []
        , PD.future             = []
        , PD.limit              = Nothing
        , PD.fileName           = Nothing
        , PD.dirty              = False
        , PD.saveToDisk         = saveToDisk theFrame
        , PD.updateUndo         = PD.defaultUpdateUndo undoItem
        , PD.updateRedo         = PD.defaultUpdateRedo redoItem
        , PD.updateSave         = PD.defaultUpdateSave saveItem
        , PD.updateTitleBar     = PD.defaultUpdateTitlebar theFrame toolName
        , PD.saveChangesDialog  = PD.defaultSaveChangesDialog theFrame toolName
        , PD.saveAsDialog       = PD.defaultSaveAsDialog theFrame extensions
        })

    ; setInterfacePalette n state

    ; initializeRules state g n e
    -- Rules Panel
    ; tree <- treeCtrl rulesTreePan [style :~ (wxTR_EDIT_LABELS .+.)]
    ; setTree tree state
    ; top  <- treeCtrlAddRoot tree "Rules" noImage noImage objectNull
    -- ; treeCtrlSetItemClientData tree top (return ()) ""
    ; addRules2Tree tree top state
    ; treeCtrlExpand tree top
    ; set tree [ on treeEvent := onTreeEvent tree state g n e]

    ; buttonNewRule <- button rulesTreePan 
                         [ text := "Add new rule" 
                         , on command := safetyNet theFrame $ addNewRuleItem True state $ initial g n e
                         ]
    ; buttonNewIRule <- button rulesTreePan 
                         [ text := "Rule creation wizard" 
                         , on command := safetyNet theFrame $ createRuleItem theFrame state g n e
                         ]


    ; addAgent <- button palettePan [ text := "Create new symbol"
                                    , on command := createNewAgentItem state
                                    ]

    ; set palettePan [ layout := column 5 [ widget addAgent
                                          , hfloatCentre $ widget palPan ] ] 


    -- reduction
    ; reduceB <- button netPan 
                  [ text := "Reduce" 
                  , enabled := True 
                  ]
    ; setReduceButton reduceB state

    ; reduceStopB <- button netPan 
                      [ text := "Stop" 
                      , enabled := False
                      ]
    ; let (stratsS, _) = unzip strategiesList

    ; strategies <- radioBox netPan Vertical stratsS  
                      [ text := "Strategy"
                      , selection := 1 ] 

    ; steps <- radioBox netPan Vertical ["one", "many"]   
                      [ text := "Steps"
                      , selection := 0 ] 

    ; set reduceB [on command := do
				    set reduceB [enabled := False]
				    set reduceStopB [enabled := True]
				    set strategies [enabled := False]
				    set steps [enabled := False]
                                    setContinueReduction True state
                                    s <- get steps selection
				    i <- get strategies selection
                                    globalReduce (stratsS !! i) (s==1) state
				    set reduceStopB [enabled := False]
				    set strategies [enabled := True]
				    set steps [enabled := (stratsS !! i /= "Manual selection")]
				    set reduceB [enabled := True]
                  ]
 
    ; set reduceStopB [ on command := do stopReduction state
                                         set reduceStopB [enabled := False]
                                         set reduceB [enabled := True]
                      ]

    ; set strategies [ on select := 
			do i <- get strategies selection
			   if stratsS !! i == "Manual selection"
			     then set steps [ enabled   := False
					    , selection := 0
					    ]
			     else do set steps [ enabled := True]
				     set reduceB [ enabled := True]

		     ] 


    -- Layout the main window
    ; set theFrame
        [ menuBar       := [ fileMenu, editMenu, viewMenu, opsMenu, palMenu, chksMenu, helpMenu ]
        , layout        := container mainPan $ margin 5 $ fill $
		           hsplit sp 5 500	( -- to remove. just for debug  
                           vsplit sp1 5 200 
                                  (hsplit sp2 5 200 
                                          (widget palettePan) 
					  (container rulesTreePan $ 
                                             column 5 [ fill $ widget tree
                                                      , hfloatCentre $ widget buttonNewRule
                                                      , hfloatCentre $ widget buttonNewIRule

                                                      ]
                                           ) 
                                  )
				  (hsplit sp3 5 250
                                          (vsplit sp4 5 300
                                                  ( 
#if !defined(__APPLE__)
                                                   container ruleLHSPan $ boxed "LHS" $ 
#endif 
                                                     fill $ widget canvasLHS)
                                                  (container ruleRHSPan $ row 5 [ vstretch $ valignCenter $ column 5 [ widget lhs2rhsB
                                                                                                                     , widget lhsInt2rhsB ]
                                                                                , 
#if !defined(__APPLE__)
                                                                                  boxed "RHS" $
#endif 
                                                                                                fill $ widget canvasRHS 
                                                                                ] ) )
                                          (container netPan $ 
                                             column 5 [ fill $ widget canvas
                                                      , 
#if !defined(__APPLE__)
                                                       boxed "Reduction" $
#endif
                                                       hfloatLeft $ row 5 [ widget strategies
                                                                           , widget steps
                                                                           , column 5 [ widget reduceB
                                                                                      , widget reduceStopB]
                                                                          ]
                                                      ]
					  ) 
				  ) 
                           )(widget textlog) -- to remove. just for debug 


	, clientSize := sz 900 600
	, statusBar     := []
        , on closing    := safetyNet theFrame $ checkValidINOnSave state $ exit state
        ]

 -- ; set theFrame
 --     [ position      := pt 200 20
 --     , clientSize    := sz 300 240
 --     ]
    }