-- | User interface for playing Chu Shogi
-- Copyright 2009 Colin Adams
--
-- This file is part of chu-shogi.
--
--  Chu-shogi is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.

--  Chu-shogi 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 General Public License for more details.

--  You should have received a copy of the GNU General Public License
--  along with chu-shogi.  If not, see <http://www.gnu.org/licenses/>.

module UI 
    (
     -- * Event handlers
     update_canvas, 
     handle_mouse_press,
     handle_key_press,
     handle_mouse_release,
     update_canvas_second_move, 
     handle_mouse_press_second_move, 
     handle_mouse_release_second_move
    ) where

import Char (ord, chr)
import Control.Concurrent
import Data.Map
import Data.IORef
import Data.Time
import Graphics.UI.Gtk hiding (function)
import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.SVG
import Graphics.UI.Gtk.Gdk.EventM
import SVG
import Game_state hiding (pieces)
import Coordinate
import Piece
import Board
import AI
import Move (Move)

-- | Handler for keyboard interaction by user
handle_key_press ::  DrawingArea      -- ^ Image of the board
                 -> IORef Game_state -- ^ Mutable reference to current game state
                 -> EventM EKey Bool
handle_key_press canvas game_state_ior = do
  key <- eventKeyName
  case key of
    "Left" -> liftIO $ modifyIORef game_state_ior previous_move >> widgetQueueDraw canvas >> return True
    "Right" -> liftIO $ modifyIORef game_state_ior next_move >> widgetQueueDraw canvas >> return True
    _ -> return False

-- | Handler for mouse press events in situations other than the second stage of a double move
handle_mouse_press ::  DrawingArea         -- ^ Image of the board
                   -> Pixbuf              -- ^ Image of the board (background only)
                   -> IORef Game_state    -- ^ Mutable reference to current game state
                   -> IORef Bool          -- ^ Mutable reference - should the board be displayed with White at the bottom?
                   -> EventM EButton Bool
handle_mouse_press canvas pixbuf game_state_ior rotate_ior  = do
  liftIO $ widgetGrabFocus canvas
  button <- eventButton
  (x, y) <- eventCoordinates
  modifiers <- eventModifier
  window <- eventWindow
  is_rotating <- liftIO $ readIORef rotate_ior
  liftIO $ do
    pixbuf_width  <- pixbufGetWidth pixbuf
    pixbuf_height <- pixbufGetHeight pixbuf
    (canvas_width, canvas_height) <- drawableGetSize window
    let x_square = (square_size * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y_square = (square_size * fromIntegral canvas_height) / fromIntegral pixbuf_height
        x0 = (x_offset * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y0 = (y_offset * fromIntegral canvas_height) / fromIntegral pixbuf_height
        coords = square_from_coordinates is_rotating x y x_square y_square x0 y0
    case coords of
      Nothing ->           return True
      Just coord -> do
                  press_on_square canvas game_state_ior coord button modifiers
                  return True
  
-- | Clear all lighting when the mouse is released
handle_mouse_release :: DrawingArea          -- ^ Image of the board
                     -> IORef Game_state    -- ^ Mutable reference to current game state
                     -> EventM EButton Bool
handle_mouse_release canvas game_state_ior = do
  liftIO $ clear_lighting game_state_ior >> widgetQueueDraw canvas >> return True

-- | Redraw the board in situations other than the second stage of a double move
update_canvas :: Map Piece SVG         -- ^ Map of pieces to their SVG images
              -> Pixbuf               -- ^ Image of the board (background only)
              -> IORef Game_state     -- ^ Mutable reference to current game state
              -> PangoLayout          -- ^ Instructions for laying out text
              -> IORef Bool           -- ^ Mutable reference - should the board be displayed with White at the bottom?
              -> EventM EExpose Bool
update_canvas pieces pixbuf game_state_ior text_layout rotate_ior = do
  window <- eventWindow
  liftIO $ do
    graphics_context <- gcNew window
    pixbuf_width  <- pixbufGetWidth pixbuf
    pixbuf_height <- pixbufGetHeight pixbuf
    (canvas_width, canvas_height) <- drawableGetSize window
    let x_square = (square_size * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y_square = (square_size * fromIntegral canvas_height) / fromIntegral pixbuf_height
        x = (x_offset * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y = (y_offset * fromIntegral canvas_height) / fromIntegral pixbuf_height
    scaled_pixbuf <- pixbufScaleSimple pixbuf canvas_width canvas_height InterpHyper
    drawPixbuf window graphics_context scaled_pixbuf 0 0 0 0 (-1) (-1) RgbDitherNone 0 0
    game_state@(_, ni_state, _)  <- readIORef game_state_ior
    is_rotating <- readIORef rotate_ior
    let board' = board ni_state
    draw_highlighting is_rotating game_state window x_square y_square x y
    mapM_ (render_piece is_rotating pieces board' window x_square y_square x y) [(rank', file') | rank' <- [0..11], file' <- [0..11]]
    renderWithDrawable window $ do
             let x_margin = margin_scale * x_offset * (fromIntegral canvas_width) / (fromIntegral pixbuf_width)
                 y_margin = 0.0
                 font_size = unscaled_coordinate_font_size * (fromIntegral canvas_width) / (fromIntegral pixbuf_width)
             setSourceRGB 1 1 1
             font <- liftIO fontDescriptionNew
             liftIO $ fontDescriptionSetSize font font_size
             liftIO $ layoutSetFontDescription text_layout (Just font)
             setLineWidth 20
             setLineCap LineCapRound
             setLineJoin LineJoinRound
             mapM (render_rank_coordinate is_rotating x_margin y y_square text_layout) [0..11]
             mapM (render_file_coordinate is_rotating y_margin x x_square text_layout) [0..11]
    highlight_selected_square is_rotating game_state window graphics_context x_square y_square x y
-- TODO highlight influence square with yellow square and influences with non-filled circles

-- | Redraw the board during the second stage of a double move
update_canvas_second_move :: Map Piece SVG         -- ^ Map of pieces to their SVG images
                          -> Pixbuf               -- ^ Image of the board (background only)
                          -> IORef Game_state     -- ^ Mutable reference to current game state
                          -> PangoLayout          -- ^ Instructions for laying out text 
                          -> IORef Bool           -- ^ Mutable reference - should the board be displayed with White at the bottom?
                          -> EventM EExpose Bool
update_canvas_second_move pieces pixbuf game_state_ior text_layout rotate_ior = do
  window <- eventWindow
  liftIO $ do
    graphics_context <- gcNew window
    pixbuf_width  <- pixbufGetWidth pixbuf
    pixbuf_height <- pixbufGetHeight pixbuf
    (canvas_width, canvas_height) <- drawableGetSize window
    let x_square = (square_size * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y_square = (square_size * fromIntegral canvas_height) / fromIntegral pixbuf_height
        x = (x_offset * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y = (y_offset * fromIntegral canvas_height) / fromIntegral pixbuf_height
    scaled_pixbuf <- pixbufScaleSimple pixbuf canvas_width canvas_height InterpHyper
    drawPixbuf window graphics_context scaled_pixbuf 0 0 0 0 (-1) (-1) RgbDitherNone 0 0
    game_state@(_, ni_state, _)  <- readIORef game_state_ior
    is_rotating <- readIORef rotate_ior
    draw_highlighting is_rotating game_state window x_square y_square x y
    let board' = board ni_state
    mapM_ (render_piece is_rotating pieces board' window x_square y_square x y) [(rank', file') | rank' <- [0..11], file' <- [0..11]]
    renderWithDrawable window $ do
             let x_margin = margin_scale * x_offset * (fromIntegral canvas_width) / (fromIntegral pixbuf_width)
                 y_margin = 0.0
                 font_size = unscaled_coordinate_font_size * (fromIntegral canvas_width) / (fromIntegral pixbuf_width)
             setSourceRGB 1 1 1
             font <- liftIO fontDescriptionNew
             liftIO $ fontDescriptionSetSize font font_size
             liftIO $ layoutSetFontDescription text_layout (Just font)
             setLineWidth 20
             setLineCap LineCapRound
             setLineJoin LineJoinRound
             mapM (render_rank_coordinate is_rotating x_margin y y_square text_layout) [0..11]
             mapM (render_file_coordinate is_rotating y_margin x x_square text_layout) [0..11]
  return True
-- TODO highlight influence square with yellow square and influences with non-filled circles

-- | Handler for mouse press events during the second stage of a double move
handle_mouse_press_second_move ::  DrawingArea         -- ^ Image of the board
                               -> Pixbuf              -- ^ Image of the board (background only)
                               -> IORef Game_state    -- ^ Mutable reference to current game state
                               -> IORef Bool          -- ^ Mutable reference - should the board be displayed with White at the bottom?
                               -> EventM EButton Bool
handle_mouse_press_second_move canvas pixbuf game_state_ior rotate_ior  = do
  liftIO $ widgetGrabFocus canvas
  button <- eventButton
  (x, y) <- eventCoordinates
  modifiers <- eventModifier
  window <- eventWindow
  is_rotating <- liftIO $ readIORef rotate_ior
  liftIO $ do
    pixbuf_width  <- pixbufGetWidth pixbuf
    pixbuf_height <- pixbufGetHeight pixbuf
    (canvas_width, canvas_height) <- drawableGetSize window
    let x_square = (square_size * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y_square = (square_size * fromIntegral canvas_height) / fromIntegral pixbuf_height
        x0 = (x_offset * fromIntegral canvas_width) / fromIntegral pixbuf_width
        y0 = (y_offset * fromIntegral canvas_height) / fromIntegral pixbuf_height
        coords = square_from_coordinates is_rotating x y x_square y_square x0 y0
    case coords of
      Nothing ->           return True
      Just coord -> do
                  press_on_square_two canvas game_state_ior coord button modifiers
                  return True

-- | Do nothing when the mouse is released during the second stage of a double move
handle_mouse_release_second_move ::  EventM EButton Bool
handle_mouse_release_second_move = return True

-- Implementation follows
                            
-- Unscaled offset in pixels from left edge of board image to first square
x_offset :: Double
x_offset = 12

-- Unscaled offset in pixels from top edge of board image to first square
y_offset :: Double
y_offset = 11

-- Size of squares on unscaled board
square_size :: Double
square_size = 35

-- Factor for scaling position of margins on board image
margin_scale :: Double
margin_scale = 0.25

-- Font size for rendering coordinates at un-zoomed scale
unscaled_coordinate_font_size :: Double
unscaled_coordinate_font_size = 6.0

press_on_square :: DrawingArea -> IORef Game_state -> Coordinate -> MouseButton -> [Modifier] -> IO ()
press_on_square canvas game_state_ior coord button modifiers = do
  case button of
    LeftButton   -> case elem Control modifiers of
                      True  -> return () -- TODO - edit position
                      False -> case elem Shift modifiers of
                                 True -> show_influence canvas game_state_ior coord
                                 False -> do
                                   select_piece canvas game_state_ior coord
                                   game_state <- readIORef game_state_ior
                                   case is_piece_selected game_state of
                                     True  ->  set_lighting game_state_ior True (selected_square game_state)
                                     False -> return ()
                                   widgetQueueDraw canvas
    MiddleButton -> show_influence canvas game_state_ior coord
    RightButton  -> case elem Control modifiers of
                      True  -> show_influence canvas game_state_ior coord
                      False -> return ()

select_piece :: DrawingArea ->  IORef Game_state -> Coordinate -> IO ()
select_piece canvas game_state_ior coord = do
  game_state <- readIORef game_state_ior
  case is_piece_selected game_state of
    True  -> 
        case same_selected_square game_state coord of
          True -> deselect_piece game_state_ior
          False -> UI.interactive_move canvas game_state_ior coord
    False -> 
        case has_piece game_state coord && correct_colour_to_move game_state coord of
          True -> select_piece_at game_state_ior coord
          False -> return ()

show_influence :: DrawingArea -> IORef Game_state -> Coordinate -> IO ()
show_influence canvas game_state_ior coord = do
  modifyIORef game_state_ior $ influence_on coord
  widgetQueueDraw canvas

-- Zero-based rank and file
square_from_coordinates :: Bool -> Double -> Double -> Double -> Double -> Double -> Double -> Maybe Coordinate
square_from_coordinates is_rotating x y x_square y_square x0 y0 = 
    if x < x0 
    then 
        Nothing
    else
        if y < y0 
        then
            Nothing
        else
            let c1 = case is_rotating of
                       False -> truncate ((y - y0) / y_square)
                       True  -> 11 - truncate ((y - y0) / y_square)
                c2 = case is_rotating of
                       False -> truncate ((x - x0) / x_square)
                       True  -> 11 - truncate ((x - x0) / x_square)
            in Just (new_coordinate c1 c2)

draw_highlighting :: Bool -> Game_state -> DrawWindow -> Double -> Double -> Double -> Double -> IO Bool
draw_highlighting is_rotating game_state window x_square y_square x  y =
    mapM_ (render_circle is_rotating window x_square y_square x  y) (lighting game_state) >> return True

render_circle :: Bool -> DrawWindow -> Double -> Double -> Double -> Double -> (Coordinate, Lighting_colour) -> IO ()
render_circle is_rotating window x_square y_square x y light = do
  renderWithDrawable window $ do
    case light of
      (c, l) -> let r = case is_rotating of
                          False -> rank c 
                          True  -> 11 - rank c
                    f = case is_rotating of
                          False -> file c
                          True  -> 11 - file c
                    xc = x + (fromIntegral f + 0.5)  * x_square 
                    yc = y + (fromIntegral r + 0.5) * y_square
                    rad = (min x_square y_square) / 2
                    (colour, solid) = case l of
                          Step_lighting   -> (white, False)
                          Step_capture    -> (white, True)
                          Jump_lighting   -> (red, False)
                          Jump_capture    -> (red, True)
                          Lion_b_lighting -> (dark_blue, False)
                          Lion_b_capture  -> (dark_blue, True)
                          Lion_a_lighting -> (light_blue, False)
                          Lion_a_capture   -> (light_blue, True)
                in colour_circle colour xc yc rad >> case solid of
                                                       False -> stroke
                                                       True  -> Graphics.Rendering.Cairo.fill
  return ()

highlight_selected_square :: Bool -> Game_state -> DrawWindow -> GC -> Double -> Double -> Double -> Double -> IO Bool
highlight_selected_square is_rotating game_state window graphics_context x_square y_square x  y =
  if is_piece_selected game_state
  then
      let c = selected_square game_state
          r = case is_rotating of
                False -> rank c
                True  -> 11 - (rank c)
          f =  case is_rotating of
                False -> file c
                True  -> 11 - (file c)
      in render_square window graphics_context red x_square y_square x y r f
  else
      return True
 
render_square :: DrawWindow -> GC -> Color -> Double -> Double -> Double -> Double -> Int -> Int -> IO Bool
render_square window graphics_context colour x_square y_square x y rank' file' = do
  renderWithDrawable window $ do
    let x0 = truncate (x + (fromIntegral file' * x_square))
        y0 = truncate (y + (fromIntegral rank' * y_square))
        x1 = truncate x_square
        y1 = truncate y_square
    liftIO $ colour_rectangle colour window graphics_context x0 y0 x1 y1
  return True


colour_rectangle :: DrawableClass d => Color -> d -> GC -> Int -> Int -> Int -> Int -> IO()
colour_rectangle  c d gc x0 y0 x1 y1 =
    do (fg, gc') <- new_colour gc c
       drawRectangle d gc' False x0 y0 x1 y1
       reset_colour gc' fg

colour_circle :: Color -> Double -> Double  -> Double -> Render ()
colour_circle  c xc yc rad =
    do let (r, g, b) = case c of
                         Color r' g' b' -> (fromIntegral r' / 65535, fromIntegral g' / 65535, fromIntegral b' / 65535)
       setSourceRGB r g b
       arc xc yc rad 0 (2 * pi)

new_colour :: GC -> Color -> IO (Color, GC)
new_colour gc clr
    = do gcvals <- gcGetValues gc
         let fg = foreground gcvals
         gc `gcSetValues` newGCValues { foreground=clr}
         return (fg, gc)

reset_colour :: GC -> Color -> IO ()
reset_colour gc clr
    = do new_colour gc clr
         return ()

render_piece :: Bool -> Map Piece SVG -> Board -> DrawWindow -> Double -> Double -> Double -> Double -> (Int, Int) -> IO Bool
render_piece is_rotating pieces board' window x_square y_square x y (rank', file') = do
  maybe_svg <- svg_for_cell pieces board' rank' file'
  case maybe_svg of
    Nothing -> return False
    Just svg ->  renderWithDrawable window $ do
                   let (width, height) = svgGetSize svg
                       (rank_offset, file_offset, angle) = case is_rotating of
                                                             -- 11 - rank + 1 due to the way rotation is a pivot about a point
                                                             True -> (12 - rank', 12 - file', pi)
                                                             False -> (rank', file', 0)
                   translate (x + x_square * fromIntegral (file_offset)) (y + y_square * fromIntegral (rank_offset))
                   scale (x_square / fromIntegral width) (y_square / fromIntegral height)
                   rotate angle
                   svgRender svg

-- Adjustment factor for positioning coordinates on board image
coordinate_offset_scale:: Double
coordinate_offset_scale = 1.5

render_rank_coordinate :: Bool -> Double -> Double -> Double -> PangoLayout -> Int -> Render ()
render_rank_coordinate is_rotating x_margin y y_square text_layout rank' = do
  let r = case is_rotating of
            True ->  11 - rank'
            False -> rank'
  moveTo x_margin (coordinate_offset_scale * y + y_square * fromIntegral r)
  liftIO $ text_layout `layoutSetText` [chr (rank' + (ord 'a'))]
  showLayout text_layout

render_file_coordinate :: Bool -> Double -> Double -> Double -> PangoLayout -> Int -> Render ()
render_file_coordinate is_rotating y_margin x x_square text_layout file' = do
  let f = case is_rotating of
            True ->  11 - file'
            False -> file'
  moveTo (coordinate_offset_scale * x + x_square * fromIntegral f) y_margin
  liftIO $ text_layout `layoutSetText` (show (file' + 1))
  showLayout text_layout

red :: Color
red = Color 65535 0 0

white :: Color
white = Color 65535 65535 65535

dark_blue :: Color
dark_blue = Color 1000 1000 65535

light_blue :: Color
light_blue = Color 40000 40000 65535


-- Require is_piece_selected game_state
--         not . same_selected_square game_state coord
interactive_move :: DrawingArea -> IORef Game_state -> Coordinate -> IO ()
interactive_move canvas game_state_ior coord = do
  game_state@(_, ni_state, _) <- readIORef game_state_ior
  let b = board ni_state
      p' = piece_at b (rank coord) (file coord)
  case p' of
    Just (p, _) | piece_colour p == piece_colour (fst $ selected_piece game_state) -> return ()
    _ -> do
      set_lighting game_state_ior True (selected_square game_state)
      game_state' <- readIORef game_state_ior
      case is_clear_lighting game_state' coord of
         True -> return ()
         False -> do
            first_move game_state_ior coord
            case is_lion_a game_state' coord of
              True  -> second_move canvas game_state_ior coord
              False -> finalize_move canvas game_state_ior

-- Require is_piece_selected game_state
--         target = Nothing or else differs in colour
first_move :: IORef Game_state -> Coordinate -> IO ()
first_move game_state_ior coord = do
  move_to_first_square game_state_ior coord
  
-- Require
--  piece has lion moves
--  is_first_target_selected
--  not is_second_target_selected
second_move :: DrawingArea -> IORef Game_state -> Coordinate -> IO ()
second_move canvas game_state_ior coord = do
  -- request if a second move is wanted
  game_state <- readIORef game_state_ior
  set_signals_for_second_move game_state
  set_lighting_second_move game_state_ior coord                  
  widgetQueueDraw canvas
  dialog <- dialogNew
  dialogAddButton dialog stockYes ResponseYes
  dialogAddButton dialog stockNo ResponseNo
  container <- dialogGetUpper dialog
  message <- labelNew (Just "Do you wish to make a second move?")
  boxPackStartDefaults container message
  widgetShowAll dialog
  response <- dialogRun dialog
  widgetHide dialog
  case response of
    -- if so, set lighting for second moves and wait for a selection
    ResponseYes -> return ()
    _ -> do
      set_signals_for_first_move game_state
      finalize_move canvas game_state_ior

press_on_square_two :: DrawingArea -> IORef Game_state -> Coordinate -> MouseButton -> [Modifier] -> IO ()
press_on_square_two canvas game_state_ior coord button modifiers = do
  case button of
    LeftButton   -> case elem Control modifiers of
                      True  -> return ()
                      False -> do
                        make_second_move canvas game_state_ior coord
                        widgetQueueDraw canvas
    MiddleButton -> show_influence canvas game_state_ior coord
    RightButton  -> case elem Control modifiers of
                      True  -> show_influence canvas game_state_ior coord
                      False -> return ()

make_second_move :: DrawingArea -> IORef Game_state -> Coordinate -> IO ()
make_second_move canvas game_state_ior coord = do
    game_state <- readIORef game_state_ior
    case is_clear_lighting game_state coord of
      True  -> return ()
      False -> do
        game_state' <- readIORef game_state_ior
        set_signals_for_first_move game_state'
        set_second_destination game_state_ior coord
        finalize_move canvas game_state_ior

-- Require readIORef game_state_ior >>= has_moved
finalize_move :: DrawingArea -> IORef Game_state -> IO ()
finalize_move canvas game_state_ior = do
  game_state <- readIORef game_state_ior
  moved <- case is_double_move game_state of
             True -> complete_second_move game_state_ior
             False -> complete_move game_state_ior
  if moved 
   then
       do
         --putStrLn (print_move move)
         (_, ni_state, _) <- readIORef game_state_ior
         case black_kings ni_state == 0 of
           True -> announce_win True
           _ -> case white_kings ni_state == 0 of
                  True -> announce_win False
                  _ -> case is_bare_king ni_state of
                         False -> switch_player canvas game_state_ior
                         True -> announce_win (is_white_bare_gold ni_state)
   else do
     dialog <- messageDialogNew Nothing [] MessageInfo ButtonsClose ("Move disallowed - repetition rule")
     _response <- dialogRun dialog
     widgetHide dialog
     modifyIORef game_state_ior reset_move

announce_win :: Bool -> IO ()
announce_win is_white = do
  let colour = case is_white of
                 True -> "White"
                 False -> "Black"
  dialog <- messageDialogNew Nothing [] MessageInfo ButtonsClose (colour ++ " has won the game")
  _response <- dialogRun dialog
  widgetHide dialog

-- | TODO - for now a poor-man's AI launcher
switch_player :: DrawingArea -> IORef Game_state -> IO ()
switch_player canvas game_state_ior = do
  (_, state, _) <- readIORef game_state_ior
  case is_black_to_play state of
    True -> return ()
    False -> play_move canvas game_state_ior

play_move :: DrawingArea -> IORef Game_state -> IO ()
play_move canvas game_state_ior = do
 (_, state, _) <- readIORef game_state_ior
 putStr "Playing AI: "
 start_time <- getCurrentTime
 forkIO (run_ai canvas state game_state_ior start_time)
 return ()

run_ai :: DrawingArea -> Non_interactive_state -> IORef Game_state -> UTCTime -> IO ()
run_ai canvas state game_state_ior start_time = do
  let move = recommended_move state
  make_move move game_state_ior start_time
  postGUIAsync $ widgetQueueDraw canvas

make_move :: Move -> IORef Game_state -> UTCTime -> IO ()
make_move move game_state_ior start_time = do
    end_time <- move `seq` (modifyIORef game_state_ior $! update_interactive_from_move move) >> getCurrentTime
    putStrLn $ show $ (diffUTCTime end_time start_time)