-- This file is part of Goatee.
--
-- Copyright 2014-2018 Bryan Gardiner
--
-- Goatee is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Goatee is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with Goatee.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

-- | Implementation of the main window that contains the game board.
module Game.Goatee.Ui.Gtk.MainWindow (
  MainWindow,
  create,
  destroy,
  display,
  myWindow,
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (forM, forM_, join, liftM)
import Control.Monad.Trans (liftIO)
import qualified Data.Foldable as F
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List (intersperse)
import Data.Maybe (catMaybes, fromMaybe)
import Game.Goatee.Ui.Gtk.Common
import qualified Game.Goatee.Ui.Gtk.Actions as Actions
import Game.Goatee.Ui.Gtk.Actions (Actions)
import qualified Game.Goatee.Ui.Gtk.GamePropertiesPanel as GamePropertiesPanel
import Game.Goatee.Ui.Gtk.GamePropertiesPanel (GamePropertiesPanel)
import qualified Game.Goatee.Ui.Gtk.Goban as Goban
import Game.Goatee.Ui.Gtk.Goban (Goban)
import qualified Game.Goatee.Ui.Gtk.InfoLine as InfoLine
import Game.Goatee.Ui.Gtk.InfoLine (InfoLine)
import qualified Game.Goatee.Ui.Gtk.NodePropertiesPanel as NodePropertiesPanel
import Game.Goatee.Ui.Gtk.NodePropertiesPanel (NodePropertiesPanel)
import qualified Game.Goatee.Ui.Gtk.PlayPanel as PlayPanel
import Game.Goatee.Ui.Gtk.PlayPanel (PlayPanel)
import Graphics.UI.Gtk (
  Action,
  Menu,
  Packing (PackGrow, PackNatural),
  ToolbarStyle (ToolbarText),
  Window,
  actionCreateMenuItem, actionCreateToolItem, actionGroupGetAction,
  boxPackStart,
  containerAdd,
  deleteEvent,
  eventKeyName, eventModifier,
  hPanedNew,
  keyPressEvent,
  menuBarNew, menuItemNewWithMnemonic, menuItemSetSubmenu, menuNew, menuShellAppend,
  notebookAppendPage, notebookNew,
  on,
  panedPack1, panedPack2, panedSetPosition,
  separatorMenuItemNew, separatorToolItemNew,
  toAction,
  toolbarNew, toolbarSetStyle,
  vBoxNew,
  widgetDestroy, widgetGrabFocus, widgetShowAll,
  windowNew, windowSetDefaultSize, windowSetTitle,
  )
import System.Glib (glibToString)

data MainWindow ui = MainWindow
  { myUi :: ui
  , myWindow :: Window
  , myActions :: Actions ui
  , myInfoLine :: InfoLine ui
  , myGoban :: Goban ui
  , myPlayPanel :: PlayPanel ui
  , myGamePropertiesPanel :: GamePropertiesPanel ui
  , myNodePropertiesPanel :: NodePropertiesPanel ui
  , myDirtyChangedHandler :: IORef (Maybe Registration)
  , myFilePathChangedHandler :: IORef (Maybe Registration)
  }

create :: UiCtrl go ui => ui -> IO (MainWindow ui)
create ui = do
  window <- windowNew
  windowSetDefaultSize window 640 480

  actions <- Actions.create ui

  boardBox <- vBoxNew False 0
  containerAdd window boardBox

  menuBar <- menuBarNew
  boxPackStart boardBox menuBar PackNatural 0

  menuFile <- menuItemNewWithMnemonic "_File"
  menuFileMenu <- menuNew
  menuShellAppend menuBar menuFile
  menuItemSetSubmenu menuFile menuFileMenu

  menuFileNew <- menuItemNewWithMnemonic "_New file"
  menuFileNewMenu <- menuNew
  menuItemSetSubmenu menuFileNew menuFileNewMenu
  addActionsToMenu menuFileNewMenu actions
    [ Actions.myFileNew9Action
    , Actions.myFileNew13Action
    , Actions.myFileNew19Action
    , Actions.myFileNewCustomAction
    ]

  containerAdd menuFileMenu menuFileNew
  addActionsToMenu menuFileMenu actions
    [ Actions.myFileOpenAction
    , Actions.myFileSaveAction
    , Actions.myFileSaveAsAction
    ]
  containerAdd menuFileMenu =<< separatorMenuItemNew
  addActionsToMenu menuFileMenu actions
    [ Actions.myFileCloseAction
    , Actions.myFileQuitAction
    ]

  menuEdit <- menuItemNewWithMnemonic "_Edit"
  menuEditMenu <- menuNew
  menuShellAppend menuBar menuEdit
  menuItemSetSubmenu menuEdit menuEditMenu
  addActionsToMenu menuEditMenu actions
    [ Actions.myEditCutNodeAction
    , Actions.myEditCopyNodeAction
    , Actions.myEditPasteNodeAction
    ]

  menuGame <- menuItemNewWithMnemonic "_Game"
  menuGameMenu <- menuNew
  menuShellAppend menuBar menuGame
  menuItemSetSubmenu menuGame menuGameMenu
  addActionsToMenu menuGameMenu actions
    [ Actions.myGamePassAction
    ]

  menuGameVariations <- menuItemNewWithMnemonic "_Variations"
  menuGameVariationsMenu <- menuNew
  containerAdd menuGameMenu menuGameVariations
  menuItemSetSubmenu menuGameVariations menuGameVariationsMenu

  containerAdd menuGameVariationsMenu =<<
    actionCreateMenuItem (Actions.myGameVariationsChildAction actions)
  containerAdd menuGameVariationsMenu =<<
    actionCreateMenuItem (Actions.myGameVariationsCurrentAction actions)
  containerAdd menuGameVariationsMenu =<< separatorMenuItemNew
  containerAdd menuGameVariationsMenu =<<
    actionCreateMenuItem (Actions.myGameVariationsBoardMarkupOnAction actions)
  containerAdd menuGameVariationsMenu =<<
    actionCreateMenuItem (Actions.myGameVariationsBoardMarkupOffAction actions)

  menuTool <- menuItemNewWithMnemonic "_Tool"
  menuToolMenu <- menuNew
  menuShellAppend menuBar menuTool
  menuItemSetSubmenu menuTool menuToolMenu

  toolbar <- toolbarNew
  boxPackStart boardBox toolbar PackNatural 0
  toolbarSetStyle toolbar ToolbarText

  let addToolSeparator = do
        menuSep <- separatorMenuItemNew
        toolSep <- separatorToolItemNew
        containerAdd menuToolMenu menuSep
        containerAdd toolbar toolSep
      addTool (AnyTool tool) = do
        action <- fromMaybe (error $ "No action for tool with type: " ++ show (toolType tool)) <$>
                  actionGroupGetAction (Actions.myToolActions actions) (show (toolType tool))
        menuItem <- actionCreateMenuItem action
        toolItem <- actionCreateToolItem action
        containerAdd menuToolMenu menuItem
        containerAdd toolbar toolItem
    in join $ fmap (sequence_ . intersperse addToolSeparator . catMaybes) $
       forM toolOrdering $ \toolGroup -> do
         tools <- filter (\(AnyTool tool) -> toolIsImplemented tool) <$>
                  mapM (findTool ui) toolGroup
         return $ if null tools
                  then Nothing
                  else Just $ mapM_ addTool tools

  menuView <- menuItemNewWithMnemonic "_View"
  menuViewMenu <- menuNew
  menuShellAppend menuBar menuView
  menuItemSetSubmenu menuView menuViewMenu

  containerAdd menuViewMenu =<<
    actionCreateMenuItem (Actions.myViewHighlightCurrentMovesAction actions)

  menuViewStones <- menuItemNewWithMnemonic "_Stones"
  menuViewStonesMenu <- menuNew
  containerAdd menuViewMenu menuViewStones
  menuItemSetSubmenu menuViewStones menuViewStonesMenu

  addActionsToMenu menuViewStonesMenu actions
    [ toAction . Actions.myViewStonesRegularModeAction
    , toAction . Actions.myViewStonesOneColorModeAction
    , toAction . Actions.myViewStonesBlindModeAction
    ]

  menuHelp <- menuItemNewWithMnemonic "_Help"
  menuHelpMenu <- menuNew
  menuShellAppend menuBar menuHelp
  menuItemSetSubmenu menuHelp menuHelpMenu
  addActionsToMenu menuHelpMenu actions
    [ Actions.myHelpKeyBindingsAction
    , Actions.myHelpAboutAction
    ]

  infoLine <- InfoLine.create ui
  boxPackStart boardBox (InfoLine.myWidget infoLine) PackNatural 0

  hPaned <- hPanedNew
  boxPackStart boardBox hPaned PackGrow 0

  --hPanedMin <- get hPaned panedMinPosition
  --hPanedMax <- get hPaned panedMaxPosition
  --putStrLn $ "Paned position in [" ++ show hPanedMin ++ ", " ++ show hPanedMax ++ "]."
  -- TODO Don't hard-code the pane width.
  panedSetPosition hPaned 400 -- (truncate (fromIntegral hPanedMax * 0.8))

  goban <- Goban.create ui
  panedPack1 hPaned (Goban.myWidget goban) True True

  controlsBook <- notebookNew
  panedPack2 hPaned controlsBook False True

  playPanel <- PlayPanel.create ui
  gamePropertiesPanel <- GamePropertiesPanel.create ui
  nodePropertiesPanel <- NodePropertiesPanel.create ui
  notebookAppendPage controlsBook (PlayPanel.myWidget playPanel) "Play"
  notebookAppendPage controlsBook (GamePropertiesPanel.myWidget gamePropertiesPanel) "Game"
  notebookAppendPage controlsBook (NodePropertiesPanel.myWidget nodePropertiesPanel) "Properties"

  dirtyChangedHandler <- newIORef Nothing
  filePathChangedHandler <- newIORef Nothing

  let me = MainWindow { myUi = ui
                      , myWindow = window
                      , myActions = actions
                      , myInfoLine = infoLine
                      , myGoban = goban
                      , myPlayPanel = playPanel
                      , myGamePropertiesPanel = gamePropertiesPanel
                      , myNodePropertiesPanel = nodePropertiesPanel
                      , myDirtyChangedHandler = dirtyChangedHandler
                      , myFilePathChangedHandler = filePathChangedHandler
                      }

  initialize me

  on window keyPressEvent $ do
    key <- glibToString <$> eventKeyName
    mods <- eventModifier
    let km = (key, mods)
    case km of
      -- Escape focuses the goban.
      ("Escape", []) -> do
        liftIO $ widgetGrabFocus $ Goban.myWidget goban
        return True
      _ -> return False

  on window deleteEvent $ liftIO $ do
    fileClose ui
    return True

  widgetGrabFocus $ Goban.myWidget goban

  return me

-- | Initialization that must be done after the 'UiCtrl' is available.
initialize :: UiCtrl go ui => MainWindow ui -> IO ()
initialize me = do
  let ui = myUi me

  writeIORef (myDirtyChangedHandler me) =<<
    liftM Just (registerDirtyChangedHandler ui "MainWindow" False $ \_ -> updateWindowTitle me)
  writeIORef (myFilePathChangedHandler me) =<<
    liftM Just (registerFilePathChangedHandler ui "MainWindow" True $ \_ _ -> updateWindowTitle me)

destroy :: UiCtrl go ui => MainWindow ui -> IO ()
destroy me = do
  Actions.destroy $ myActions me
  InfoLine.destroy $ myInfoLine me
  Goban.destroy $ myGoban me
  PlayPanel.destroy $ myPlayPanel me
  GamePropertiesPanel.destroy $ myGamePropertiesPanel me
  NodePropertiesPanel.destroy $ myNodePropertiesPanel me

  let ui = myUi me
  F.mapM_ (unregisterDirtyChangedHandler ui) =<< readIORef (myDirtyChangedHandler me)
  F.mapM_ (unregisterFilePathChangedHandler ui) =<< readIORef (myFilePathChangedHandler me)

  widgetDestroy $ myWindow me

-- | Makes a 'MainWindow' visible.
display :: MainWindow ui -> IO ()
display = widgetShowAll . myWindow

-- | Takes a object of generic type, extracts a bunch of actions from it, and
-- adds those actions to a menu.
addActionsToMenu :: Menu -> a -> [a -> Action] -> IO ()
addActionsToMenu menu actions accessors =
  forM_ accessors $ \accessor ->
  containerAdd menu =<< actionCreateMenuItem (accessor actions)

updateWindowTitle :: UiCtrl go ui => MainWindow ui -> IO ()
updateWindowTitle me = do
  let ui = myUi me
  fileName <- getFileName ui
  dirty <- getDirty ui
  let title = fileName ++ " - Goatee"
      addDirty = if dirty then ('*':) else id
  windowSetTitle (myWindow me) $ addDirty title