-- This file is part of Goatee.
--
-- Copyright 2014 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 .
-- | A text widget that displays information about the game, including some
-- overall information, as well as the current board position.
module Game.Goatee.Ui.Gtk.InfoLine (
InfoLine,
create,
destroy,
myLabel,
) where
import Data.Maybe (fromMaybe)
import Game.Goatee.Sgf.Board
import Game.Goatee.Sgf.Monad
import Game.Goatee.Ui.Gtk.Common
import Graphics.UI.Gtk (Label, labelNew, labelSetMarkup)
data InfoLine ui = InfoLine { myUi :: ui
, myRegistrations :: ViewRegistrations
, myLabel :: Label
}
instance UiCtrl ui => UiView (InfoLine ui) ui where
viewName = const "InfoLine"
viewCtrl = myUi
viewRegistrations = myRegistrations
create :: UiCtrl ui => ui -> IO (InfoLine ui)
create ui = do
label <- labelNew Nothing
registrations <- viewNewRegistrations
let me = InfoLine { myUi = ui
, myRegistrations = registrations
, myLabel = label
}
initialize me
return me
initialize :: UiCtrl ui => InfoLine ui -> IO ()
initialize me = do
let updateAfter = afterGo . updateWithCursor me =<< getCursor
viewRegister me childAddedEvent $ const $ const updateAfter
viewRegister me navigationEvent $ const updateAfter
viewRegister me propertiesModifiedEvent $ const $ const updateAfter
update me
destroy :: UiCtrl ui => InfoLine ui -> IO ()
destroy = viewUnregisterAll
update :: UiCtrl ui => InfoLine ui -> IO ()
update me = do
cursor <- readCursor $ myUi me
updateWithCursor me cursor
updateWithCursor :: UiCtrl ui => InfoLine ui -> Cursor -> IO ()
updateWithCursor me cursor =
labelSetMarkup (myLabel me) $ generateMarkup cursor
generateMarkup :: Cursor -> String
generateMarkup cursor =
let board = cursorBoard cursor
gameInfoMsg = fromMaybe "" $ do
let info = boardGameInfo board
black <- gameInfoBlackName info
white <- gameInfoWhiteName info
let renderRank = maybe "" (\x -> " (" ++ x ++ ")")
blackRank = renderRank $ gameInfoBlackRank info
whiteRank = renderRank $ gameInfoWhiteRank info
return $ white ++ whiteRank ++ " vs. " ++ black ++ blackRank ++ "\n"
siblingMsg = case cursorParent cursor of
Nothing -> "Start of game."
Just parent ->
let parentChildCount = cursorChildCount parent
in if parentChildCount > 1
then "Variation " ++ show (cursorChildIndex cursor + 1) ++
"/" ++ show parentChildCount ++ "."
else ""
childrenMsg = let childCount = cursorChildCount cursor
in case childCount of
0 -> "End of variation."
1 -> ""
_ -> "" ++ show childCount ++ " variations from here."
in gameInfoMsg ++ "Move " ++ show (boardMoveNumber board) ++ ", " ++
show (boardPlayerTurn board) ++ " to play. Captures: B+" ++
show (boardBlackCaptures board) ++ ", W+" ++ show (boardWhiteCaptures board)
++ ".\n" ++ siblingMsg ++
(if siblingMsg /= [] && childrenMsg /= [] then " " else "") ++ childrenMsg