-- 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