{-# 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,
)
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
}
on passButton buttonActivated $ playAt ui Nothing
return me
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
invalidateIsValidMoveCache :: PlayTool ui -> IO ()
invalidateIsValidMoveCache me = writeIORef (myIsValidMoveCache me) Nothing