{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} module Nomyx.Web.Game.Infos where import Prelude hiding (div) import Control.Monad import Control.Monad.State import Control.Concurrent.STM import Control.Applicative import Data.Monoid import Data.Maybe import Data.String import Data.List import Data.List.Split import Data.Text (Text) import Language.Nomyx import Text.Blaze.Html5 (Html, div, (!), p, table, td, tr, h2, h3, h4, pre, toValue, br, a) import Text.Blaze.Html5.Attributes as A (id, class_, href, title) import Text.Reform.Blaze.String (inputHidden) import Text.Reform (viewForm, eitherForm) import Text.Reform.Happstack (environment) import Happstack.Server (Response, Method(..), seeOther, toResponse, methodM, ok) import Web.Routes.RouteT (showURL, liftRouteT) import Nomyx.Web.Common as NWC import Nomyx.Web.Help as Help import Nomyx.Core.Types as T import Nomyx.Core.Engine import Nomyx.Core.Session as S import Nomyx.Core.Profile as Profile default (Integer, Double, Data.Text.Text) viewGameDesc :: Game -> Maybe PlayerNumber -> Maybe PlayerNumber -> Bool -> RoutedNomyxServer Html viewGameDesc g mpn playAs gameAdmin = do let gn = _gameName g let logged = isJust mpn vp <- viewPlayers (_players g) gn gameAdmin modJoin <- modalJoin gn logged modLeave <- modalLeave gn logged modDel <- modalDel gn logged let isInGame = maybe False (\pn -> pn `elem` (_playerNumber <$> _players g)) mpn ok $ do h3 $ fromString $ _gameName g when (isJust playAs) $ h4 $ fromString $ "You are playing as player " ++ (show $ fromJust playAs) p $ pre $ fromString (_desc $ _gameDesc g) p $ h4 $ "This game is discussed in the " >> a "Forum" ! (A.href $ toValue (_forumURL $ _gameDesc g)) >> "." p $ h4 "Players in game:" when gameAdmin "(click on a player name to \"play as\" this player)" vp p $ viewVictory g if isInGame then a "Leave" ! (href $ toValue $ "#openModalLeave" ++ gn) ! A.class_ "button" else a "Join" ! (href $ toValue $ "#openModalJoin" ++ gn) ! A.class_ "button" ! (title $ toValue Help.joinGame) when gameAdmin $ a "Del" ! (href $ toValue $ "#openModalDel" ++ gn) ! A.class_ "button" modJoin >> modLeave >> modDel modalWindow :: Text -> String -> String -> String -> RoutedNomyxServer Html modalWindow link buttonTitle question modelRef = do main <- showURL NWC.MainPage ok $ do div ! A.id (toValue $ modelRef) ! A.class_ "modalWindow" $ do div $ do h2 (fromString question) a "Cancel" ! (href $ toValue main) ! A.class_ "modalButton" a (fromString buttonTitle) ! (href $ toValue link) ! A.class_ "modalButton" modalLeave :: GameName -> Bool -> RoutedNomyxServer Html modalLeave gn logged = do leave <- defLink (NWC.LeaveGame gn) logged modalWindow leave "Leave" "Do you really want to leave? You will loose your assets in the game (for example, your bank account)." ("openModalLeave" ++ gn) modalJoin :: GameName -> Bool -> RoutedNomyxServer Html modalJoin gn logged = do join <- defLink (NWC.JoinGame gn) logged modalWindow join "Join" "Joining the game. Please register in the forum (see the link) and introduce yourself to the other players! If you do not whish to play, you can just view the game." ("openModalJoin" ++ gn) modalDel :: GameName -> Bool -> RoutedNomyxServer Html modalDel gn logged = do del <- defLink (NWC.DelGame gn) logged modalWindow del "Delete" ("Delete the game " ++ gn ++ " ?") ("openModalDel" ++ gn) viewPlayers :: [PlayerInfo] -> GameName -> Bool -> RoutedNomyxServer Html viewPlayers pis gn gameAdmin = do let plChunks = transpose $ chunksOf 15 (sort pis) vp <- mapM mkRow plChunks ok $ table $ mconcat vp where mkRow :: [PlayerInfo] -> RoutedNomyxServer Html mkRow row = do r <- mapM (viewPlayer gn gameAdmin) row ok $ tr $ mconcat r viewPlayer :: GameName -> Bool -> PlayerInfo -> RoutedNomyxServer Html viewPlayer gn gameAdmin (PlayerInfo pn name _) = do pad <- playAsDiv pn gn let inf = fromString name ok $ do pad td $ div ! A.id "playerNumber" $ fromString $ show pn td $ div ! A.id "playerName" $ if gameAdmin then a inf ! (href $ toValue $ "#openModalPlayAs" ++ show pn) else inf playAsDiv :: PlayerNumber -> GameName -> RoutedNomyxServer Html playAsDiv pn gn = do submitPlayAs <- showURL $ SubmitPlayAs gn main <- showURL MainPage paf <- lift $ viewForm "user" $ playAsForm $ Just pn ok $ do let cancel = a "Cancel" ! (href $ toValue main) ! A.class_ "modalButton" div ! A.id (toValue $ "openModalPlayAs" ++ show pn) ! A.class_ "modalWindow" $ do div $ do h2 $ fromString $ "When you are in a private game, you can play instead of any players. This allows you to test " ++ "the result of their actions." blazeForm (h2 (fromString $ "Play as player " ++ show pn ++ "? ") >> paf) submitPlayAs br cancel playAsForm :: Maybe PlayerNumber -> NomyxForm String playAsForm pn = inputHidden (show pn) viewVictory :: Game -> Html viewVictory g = do let vs = _playerName <$> mapMaybe (Profile.getPlayerInfo g) (getVictorious g) case vs of [] -> br a:[] -> h3 $ fromString $ "Player " ++ show a ++ " won the game!" a:bs -> h3 $ fromString $ "Players " ++ intercalate ", " bs ++ " and " ++ a ++ " won the game!" newPlayAs :: GameName -> TVar Session -> RoutedNomyxServer Response newPlayAs gn ts = toResponse <$> do methodM POST p <- liftRouteT $ eitherForm environment "user" $ playAsForm Nothing pn <- fromJust <$> getPlayerNumber ts case p of Right playAs -> do webCommand ts $ S.playAs (read playAs) pn gn link <- showURL MainPage seeOther link "Redirecting..." (Left errorForm) -> do settingsLink <- showURL $ SubmitPlayAs gn mainPage "Admin settings" "Admin settings" (blazeForm errorForm settingsLink) False True