Handle the end of games
This commit is contained in:
parent
66d2926635
commit
b2253b81d6
8 changed files with 153 additions and 90 deletions
|
|
@ -1,5 +1,13 @@
|
|||
# Revision history for hanafudapi
|
||||
|
||||
## 0.2.2.0 -- 2019-08-12
|
||||
|
||||
* Handle the end of games
|
||||
|
||||
## 0.2.1.0 -- 2019-01-08
|
||||
|
||||
* Use latest changes in the lib to send a log of what happened during a turn
|
||||
|
||||
## 0.2.0.1 -- 2018-08-26
|
||||
|
||||
* Games are now playable
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: hanafuda-webapp
|
||||
version: 0.2.1.0
|
||||
version: 0.2.2.0
|
||||
synopsis: A webapp for the Haskell hanafuda library
|
||||
-- description:
|
||||
homepage: https://framagit.org/hanafuda
|
||||
|
|
|
|||
|
|
@ -7,29 +7,28 @@ import Control.Monad.Except (runExceptT)
|
|||
import Control.Monad.Reader (asks, lift)
|
||||
import Control.Monad.Writer (runWriterT)
|
||||
import qualified Data (RW(..))
|
||||
import qualified Game (new, play)
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Game(..))
|
||||
import Data.Map (Map, (!?))
|
||||
import qualified Game (Key, T, new, play)
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Game(..), Step(..))
|
||||
import qualified Session (Status(..), T(..), Update)
|
||||
import qualified Server (get, logIn, logOut, update, register)
|
||||
import qualified Server (endGame, get, logIn, logOut, update, register)
|
||||
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
|
||||
import qualified Message (FromClient(..), T(..), broadcast, get, notifyPlayers, relay, send, sendTo, update)
|
||||
|
||||
type Vertex = Session.Status
|
||||
receive :: Session.Status -> Message.FromClient -> App.T ()
|
||||
|
||||
edges :: Vertex -> Message.FromClient -> App.T Vertex
|
||||
|
||||
edges (Session.LoggedIn False) logIn@(Message.LogIn login) =
|
||||
receive (Session.LoggedIn False) logIn@(Message.LogIn login) =
|
||||
asks App.key >>= App.try . (Server.logIn login)
|
||||
>>= maybe
|
||||
(Message.relay logIn Message.broadcast >> return (Session.LoggedIn True))
|
||||
(withError $ Session.LoggedIn False)
|
||||
(Message.relay logIn Message.broadcast >> setSessionStatus (Session.LoggedIn True))
|
||||
sendError
|
||||
|
||||
edges (Session.LoggedIn True) logOut@Message.LogOut = do
|
||||
receive (Session.LoggedIn True) logOut@Message.LogOut = do
|
||||
Message.relay logOut Message.broadcast
|
||||
asks App.key >>= App.update_ . Server.logOut
|
||||
return (Session.LoggedIn False)
|
||||
setSessionStatus (Session.LoggedIn False)
|
||||
|
||||
edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
|
||||
receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
|
||||
session <- App.get to
|
||||
case Session.status session of
|
||||
Session.LoggedIn True -> do
|
||||
|
|
@ -37,10 +36,10 @@ edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
|
|||
App.update_ (Server.update to (Data.set $ Session.Answering key :: Session.Update))
|
||||
Message.broadcast $ Message.update {Message.paired = [key, to]}
|
||||
(Message.relay invitation $ Message.sendTo [to])
|
||||
return (Session.Waiting to)
|
||||
_ -> Session.LoggedIn True `withError` "They just left"
|
||||
setSessionStatus (Session.Waiting to)
|
||||
_ -> sendError "They just left"
|
||||
|
||||
edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do
|
||||
receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
|
||||
session <- App.get to
|
||||
key <- asks App.key
|
||||
case Session.status session of
|
||||
|
|
@ -57,42 +56,52 @@ edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do
|
|||
Message.broadcast $ Message.update {Message.alone = [key, to]}
|
||||
return $ Session.LoggedIn True
|
||||
App.update_ $ Server.update to (Data.set newStatus :: Session.Update)
|
||||
return newStatus
|
||||
_ -> (Session.LoggedIn True) `withError` "They're not waiting for your answer"
|
||||
setSessionStatus newStatus
|
||||
_ -> sendError "They're not waiting for your answer"
|
||||
|
||||
edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
|
||||
receive (Session.Playing gameKey) played@(Message.Play {}) = do
|
||||
key <- asks App.key
|
||||
game <- Server.get gameKey <$> App.server
|
||||
(result, logs) <- lift . runWriterT . runExceptT $ Game.play key move game
|
||||
(result, logs) <- lift . runWriterT . runExceptT $ Game.play key (Message.move played) game
|
||||
case result of
|
||||
Left message -> status `withError` message
|
||||
Right newGame ->
|
||||
case newGame of
|
||||
KoiKoi.Over _ -> undefined
|
||||
KoiKoi.On on -> do
|
||||
App.update_ $ Server.update gameKey (const on)
|
||||
Message.notifyPlayers on logs
|
||||
return status
|
||||
Left message -> sendError message
|
||||
Right newGame -> do
|
||||
Message.notifyPlayers newGame logs
|
||||
case KoiKoi.step newGame of
|
||||
KoiKoi.Over -> do
|
||||
App.debug $ "Game " ++ show gameKey ++ " ended"
|
||||
App.update_ $ Server.endGame gameKey
|
||||
_ -> App.update_ $ Server.update gameKey (const newGame)
|
||||
|
||||
edges state _ =
|
||||
state `withError` ("Invalid message in state " ++ show state)
|
||||
receive (Session.Playing gameKey) Message.Quit = do
|
||||
games <- (Data.get <$> App.server :: App.T (Map Game.Key Game.T))
|
||||
case games !? gameKey of
|
||||
Nothing -> do
|
||||
key <- asks App.key
|
||||
Message.broadcast $ Message.update {Message.alone = [key]}
|
||||
setSessionStatus (Session.LoggedIn True)
|
||||
_ -> sendError "Game is still running"
|
||||
|
||||
withError :: Vertex -> String -> App.T Vertex
|
||||
withError vertex message =
|
||||
(Message.send $ Message.Error message) >> return vertex
|
||||
receive state _ = sendError $ "Invalid message in state " ++ show state
|
||||
|
||||
run :: App.T ()
|
||||
run = do
|
||||
message <- Message.get
|
||||
status <- Session.status <$> App.current
|
||||
newStatus <- edges status message
|
||||
sendError :: String -> App.T ()
|
||||
sendError = Message.send . Message.Error
|
||||
|
||||
setSessionStatus :: Session.Status -> App.T ()
|
||||
setSessionStatus newStatus = do
|
||||
key <- asks App.key
|
||||
App.update_ $ Server.update key $ (Data.set newStatus :: Session.Update)
|
||||
App.debug $ show newStatus
|
||||
run
|
||||
|
||||
loop :: App.T ()
|
||||
loop = do
|
||||
message <- Message.get
|
||||
status <- Session.status <$> App.current
|
||||
status `receive` message
|
||||
loop
|
||||
|
||||
start :: App.T ()
|
||||
start = do
|
||||
App.debug "Initial state"
|
||||
Message.Welcome <$> App.server <*> asks App.key >>= Message.send
|
||||
run
|
||||
loop
|
||||
|
|
|
|||
32
src/Game.hs
32
src/Game.hs
|
|
@ -8,7 +8,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Game (
|
||||
Key
|
||||
, View
|
||||
, T
|
||||
, export
|
||||
, new
|
||||
|
|
@ -26,7 +25,7 @@ import qualified Data (Key)
|
|||
import qualified Player (Key)
|
||||
import qualified Hanafuda (Flower(..), Card(..), Pack, cardsOfPack, empty)
|
||||
import qualified Hanafuda.Player (Player(..), Players(..))
|
||||
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), On(..), Over(..), Score, Source(..), Step(..), Yaku(..), new, play)
|
||||
import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), Score, Source(..), Step(..), Yaku(..), new, play)
|
||||
import GHC.Generics
|
||||
|
||||
deriving instance Generic Hanafuda.Card
|
||||
|
|
@ -40,13 +39,12 @@ deriving instance Generic Hanafuda.KoiKoi.Step
|
|||
deriving instance Generic1 (Hanafuda.Player.Player Player.Key)
|
||||
deriving instance Generic1 (Hanafuda.Player.Players Player.Key)
|
||||
|
||||
type On = Hanafuda.KoiKoi.On Player.Key
|
||||
type Over = Hanafuda.KoiKoi.Over Player.Key
|
||||
type View = Hanafuda.KoiKoi.Game Player.Key
|
||||
type T = Hanafuda.KoiKoi.Game Player.Key
|
||||
|
||||
deriving instance Generic On
|
||||
deriving instance Generic Over
|
||||
deriving instance Generic View
|
||||
deriving instance Generic T
|
||||
|
||||
instance ToJSON T where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
|
||||
instance FromJSON Hanafuda.Card
|
||||
instance ToJSON Hanafuda.Card
|
||||
|
|
@ -90,29 +88,25 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
|
|||
toJSON = toJSON1
|
||||
toEncoding = toEncoding1
|
||||
|
||||
type T = Hanafuda.KoiKoi.On Player.Key
|
||||
|
||||
instance ToJSON T
|
||||
|
||||
type Key = Data.Key T
|
||||
|
||||
new :: Player.Key -> Player.Key -> IO T
|
||||
new p1 p2 = do
|
||||
Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
|
||||
Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.WholeYear
|
||||
|
||||
export :: Player.Key -> T -> Value
|
||||
export key on = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast
|
||||
export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
|
||||
where
|
||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on
|
||||
Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
|
||||
maskOpponentsHand k player
|
||||
| k == key = player
|
||||
| otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
|
||||
Object ast = toJSON $ on {
|
||||
Object ast = toJSON $ game {
|
||||
Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
|
||||
}
|
||||
|
||||
play :: Hanafuda.KoiKoi.Environment m => Player.Key -> Hanafuda.KoiKoi.Move -> T -> m (Hanafuda.KoiKoi.Game Player.Key)
|
||||
play key move on
|
||||
| Hanafuda.KoiKoi.playing on == key =
|
||||
Hanafuda.KoiKoi.play move on
|
||||
play key move game
|
||||
| Hanafuda.KoiKoi.playing game == key =
|
||||
Hanafuda.KoiKoi.play move game
|
||||
| otherwise = throwError "Not your turn"
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ import qualified Game (T, export)
|
|||
import qualified Session (T(..))
|
||||
import qualified Server (T(..), get)
|
||||
import qualified App (Context(..), T, connection, debug, server)
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Action, On(..), Move(..))
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), Move(..))
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
data FromClient =
|
||||
|
|
@ -36,6 +36,7 @@ data FromClient =
|
|||
| LogIn {name :: Text}
|
||||
| LogOut
|
||||
| Play {move :: KoiKoi.Move}
|
||||
| Quit
|
||||
| Ping
|
||||
deriving (Generic)
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
module Server (
|
||||
T(..)
|
||||
, disconnect
|
||||
, endGame
|
||||
, get
|
||||
, logIn
|
||||
, logOut
|
||||
|
|
@ -96,6 +97,10 @@ disconnect :: Player.Key -> T -> T
|
|||
disconnect key =
|
||||
Data.update (delete key :: Sessions -> Sessions) . logOut key
|
||||
|
||||
endGame :: Game.Key -> T -> T
|
||||
endGame key =
|
||||
Data.update (delete key :: Games -> Games)
|
||||
|
||||
logIn :: Text -> Player.Key -> T -> Either String T
|
||||
logIn name key server =
|
||||
Data.update (Set.insert name) .
|
||||
|
|
|
|||
54
www/game.js
54
www/game.js
|
|
@ -48,8 +48,12 @@ function Game(modules) {
|
|||
}
|
||||
|
||||
function handleGameMessage(o) {
|
||||
if(o.game.deck == 24) {
|
||||
return o.logs.length > 0 ? modules.async.sequence(applyDiff(o), setGame(o)) : setGame(o);
|
||||
if(o.game.deck == 24) { // deck is full, means new round
|
||||
if(o.logs.length > 0) { // but still some logs, from the previous round
|
||||
return modules.async.sequence(applyDiff(o), setGame(o)); // so play the diff, then set the new round
|
||||
} else {
|
||||
return setGame(o); // directly set a whole new game
|
||||
}
|
||||
} else {
|
||||
return applyDiff(o);
|
||||
}
|
||||
|
|
@ -70,6 +74,22 @@ function Game(modules) {
|
|||
|
||||
function handleStep(o) {
|
||||
return function(f) {
|
||||
handleTurnedCard(o, f);
|
||||
if(status.step == "Scored") {
|
||||
if(status.playing) {
|
||||
askKoikoi(o, f);
|
||||
} else {
|
||||
theyScored(o, f);
|
||||
}
|
||||
} else if (status.step == "Over") {
|
||||
gameEnd(o, f);
|
||||
} else {
|
||||
f();
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
function handleTurnedCard(o, f) {
|
||||
if(status.step == "Turned") {
|
||||
setTurned(o.game.step.contents);
|
||||
} else {
|
||||
|
|
@ -80,8 +100,9 @@ function Game(modules) {
|
|||
deck.removeChild(deck.lastChild);
|
||||
}
|
||||
}
|
||||
if(status.step == "Scored") {
|
||||
if(status.playing) {
|
||||
}
|
||||
|
||||
function askKoikoi(o, f) {
|
||||
modules.screen.dialog({
|
||||
text: modules.i18n.get('youScored'),
|
||||
answers: [
|
||||
|
|
@ -89,7 +110,10 @@ function Game(modules) {
|
|||
{label: 'koikoi', action: function() {play({koiKoi: true}); f();}}
|
||||
]
|
||||
});
|
||||
} else {
|
||||
|
||||
}
|
||||
|
||||
function theyScored(o, f) {
|
||||
modules.screen.dialog({
|
||||
text: modules.i18n.get('theyScored')(modules.room.name(o.game.playing)),
|
||||
answers: [
|
||||
|
|
@ -97,10 +121,26 @@ function Game(modules) {
|
|||
]
|
||||
});
|
||||
}
|
||||
} else {
|
||||
|
||||
function gameEnd(o, f) {
|
||||
var winner, maxScore;
|
||||
for(var key in o.game.scores) {
|
||||
if(maxScore == undefined || o.game.scores[key] > maxScore) {
|
||||
winner = key;
|
||||
maxScore = o.game.scores[key];
|
||||
}
|
||||
}
|
||||
modules.screen.dialog({
|
||||
text: modules.i18n.get(modules.session.is(winner) ? 'won' : 'lost'),
|
||||
answers: [{
|
||||
label: 'endGame',
|
||||
action: function() {
|
||||
modules.messaging.send({tag: "Quit"});
|
||||
modules.screen.select('reception');
|
||||
f();
|
||||
}
|
||||
};
|
||||
}]
|
||||
});
|
||||
}
|
||||
|
||||
function applyDiff(o) {
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ function Translations() {
|
|||
alone: "No one to play with yet ! Wait a little",
|
||||
decline: "Decline",
|
||||
endRound: "End the round",
|
||||
endGame: "Return to main menu",
|
||||
join: "Join",
|
||||
invite: "Invite",
|
||||
invited: function(name) {
|
||||
|
|
@ -24,6 +25,7 @@ function Translations() {
|
|||
},
|
||||
koikoi: "KoiKoi !!",
|
||||
leave: "Leave",
|
||||
lost: "You lost the game",
|
||||
monthFlower: function(flower) {
|
||||
return "This month's flower is the " + flower;
|
||||
},
|
||||
|
|
@ -37,6 +39,7 @@ function Translations() {
|
|||
theyScored: function(name) {
|
||||
return name + " scored";
|
||||
},
|
||||
won: "You won !",
|
||||
yourTurn: "Your turn",
|
||||
youScored: "You scored ! Do you want to get your points and end the round or KoiKoi ?"
|
||||
},
|
||||
|
|
@ -57,6 +60,7 @@ function Translations() {
|
|||
alone: "Personne pour jouer pour l'instant ! Attendez un peu",
|
||||
decline: "Refuser",
|
||||
endRound: "Finir la manche",
|
||||
endGame: "Retourner au menu principal",
|
||||
join: "Entrer",
|
||||
invite: "Inviter",
|
||||
invited: function(name) {
|
||||
|
|
@ -64,6 +68,7 @@ function Translations() {
|
|||
},
|
||||
koikoi: "KoiKoi !!",
|
||||
leave: "Partir",
|
||||
lost: "Vous avez perdu",
|
||||
monthFlower: function(flower) {
|
||||
return "C'est le mois des " + flower;
|
||||
},
|
||||
|
|
@ -77,6 +82,7 @@ function Translations() {
|
|||
theyScored: function(name) {
|
||||
return name + " a marqué";
|
||||
},
|
||||
won: "Vous avez gagné !",
|
||||
yourTurn: "À vous",
|
||||
youScored: "Vous avez marqué ! Voulez-vous empocher vos gains et terminer la manche ou faire KoiKoi ?"
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue