-- 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 . {-# LANGUAGE CPP #-} module Game.Goatee.Ui.Gtk.Tool.Play (PlayTool, create) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (when) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe (fromJust, isJust) import Game.Goatee.Common import qualified Game.Goatee.Lib.Board as Board import Game.Goatee.Lib.Types import Game.Goatee.Ui.Gtk.Common import Graphics.UI.Gtk ( Button, buttonActivated, buttonNewWithLabel, on, toWidget, ) -- | A 'UiTool' for entering moves to record a game. When this tool is active, -- clicking (not dragging) on a board point will make a move at the point if the -- move is valid. A pass button is shown in the panel. data PlayTool ui = PlayTool { myUi :: ui , myViewState :: ViewState , myToolState :: ToolState , myPassButton :: Button , myIsValidMoveCache :: IORef (Maybe (Coord, Bool)) } instance UiCtrl go ui => UiView go ui (PlayTool ui) where viewName = const "PlayTool" viewCtrl = myUi viewState = myViewState viewUpdate = const $ return () instance UiCtrl go ui => UiTool go ui (PlayTool ui) where toolState = myToolState toolPanelWidget = Just . toWidget . myPassButton toolGobanInvalidate = invalidateIsValidMoveCache toolGobanClickComplete me from to = do let ui = myUi me when (isJust from && from == to) $ do valid <- isValidMove ui $ fromJust from when valid $ playAt ui from toolGobanRenderModifyCoords me board coords = do state <- toolGetGobanState me let coordFromMouseState = case state of ToolGobanHovering maybeCoord -> maybeCoord ToolGobanDragging _ from current | from == current -> from _ -> Nothing coordIfValidMove <- case coordFromMouseState of Nothing -> return Nothing Just coord -> if' coordFromMouseState Nothing <$> getIsValidMove me coord return $ case coordIfValidMove of Just (x, y) -> listUpdate (flip listUpdate x $ \rendered -> let coord = renderedCoordState rendered coord' = coord { Board.coordStone = Just $ Board.boardPlayerTurn board } in rendered { renderedCoordState = coord' }) y coords _ -> coords create :: UiCtrl go ui => ui -> ToolState -> IO (PlayTool ui) create ui toolState = do viewState <- viewStateNew passButton <- buttonNewWithLabel "Pass" isValidMoveCache <- newIORef Nothing let me = PlayTool { myUi = ui , myViewState = viewState , myToolState = toolState , myPassButton = passButton , myIsValidMoveCache = isValidMoveCache } -- TODO Reuse Actions.myGamePassAction? on passButton buttonActivated $ playAt ui Nothing return me -- | Calculates whether it is valid for the current player to to play at a -- 'Coord'. Caches the result. getIsValidMove :: UiCtrl go ui => PlayTool ui -> Coord -> IO Bool getIsValidMove me coord = do let ui = myUi me cache = myIsValidMoveCache me cached <- readIORef cache case cached of Just (cachedCoord, cachedValue) | cachedCoord == coord -> return cachedValue _ -> do isValid <- isValidMove ui coord writeIORef cache $ Just (coord, isValid) return isValid -- | Invalidates the cache used by 'getIsValidMove'. invalidateIsValidMoveCache :: PlayTool ui -> IO () invalidateIsValidMoveCache me = writeIORef (myIsValidMoveCache me) Nothing