hanafuda
/
hannah
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Catch up with breaking changes due to the stateless transition

This commit is contained in:
Tissevert 2019-10-19 10:51:06 +02:00
parent 9fb130c944
commit c2b01445c8
2 changed files with 29 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/AI.hs
View File

@ -4,7 +4,7 @@ module AI (
) where ) where
import Data.List (sortOn) import Data.List (sortOn)
import Data.Map ((!)) import Data.Map ((!), delete, findMin)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Data.Set (Set, member) import Data.Set (Set, member)
import qualified Data.Set as Set (fromList, intersection, unions) import qualified Data.Set as Set (fromList, intersection, unions)
@ -13,25 +13,27 @@ import Hanafuda (
, cardsOf, cardsOfPack, contains, empty,flower, packOfCards, sameMonth, size, union , cardsOf, cardsOfPack, contains, empty,flower, packOfCards, sameMonth, size, union
) )
import Hanafuda.Player (Player(..), Players(..)) import Hanafuda.Player (Player(..), Players(..))
import Hanafuda.KoiKoi (GameBlueprint(..), Move(..), PlayerID, Step(..), Score) import Hanafuda.KoiKoi (Move(..), PlayerID, Step(..), Score)
import Hanafuda.Message (PublicGame) import Hanafuda.Message (PublicGame(..), PublicState(..), PublicPlayer)
move :: PlayerID -> PublicGame -> Move move :: PlayerID -> PublicGame -> Move
move me (Game {step = ToPlay, month, players = Players p, river}) = move me (PublicGame {playerHand, public = PublicState {step = ToPlay, month, players, river}}) =
case getAvailableCards myHand (cardsOfPack river) of case getAvailableCards hand (cardsOfPack river) of
[] -> Play $ worstFor month (p ! (nextPlayer $ p ! me)) myHand [] -> Play $ worstFor month opponent hand
available -> available ->
let riverCard = bestFor month (p ! me) available in let riverCard = bestFor month (players ! me) available in
let matchingCards = cardsOfPack . sameMonth riverCard . hand $ p ! me in let matchingCards = cardsOfPack . sameMonth riverCard $ playerHand in
capture (bestFor month (p ! me) matchingCards) riverCard river capture (bestFor month (players ! me) matchingCards) riverCard river
where where
myHand = cardsOfPack . hand $ p ! me hand = cardsOfPack playerHand
opponent = snd . findMin $ delete me players
move me (Game {step = Turned card, month, players = Players p, river}) = move me (PublicGame {public = PublicState {step = Turned card, month, players, river}}) =
Choose . bestFor month (p ! me) . cardsOfPack $ sameMonth card river Choose . bestFor month (players ! me) . cardsOfPack $ sameMonth card river
move me (Game {players = Players p}) = KoiKoi $ hand (p ! me) /= empty move me (PublicGame {playerHand, public = PublicState {step = Scored}}) =
KoiKoi $ playerHand /= empty
capture :: Card -> Card -> Pack -> Move capture :: Card -> Card -> Pack -> Move
capture card caught river = capture card caught river =
@ -48,13 +50,13 @@ getAvailableCards hand =
choose :: Ord a => (Card -> a) -> [Card] -> Card choose :: Ord a => (Card -> a) -> [Card] -> Card
choose sortCriterion = head . sortOn sortCriterion choose sortCriterion = head . sortOn sortCriterion
bestFor :: Flower -> Player Score -> [Card] -> Card bestFor :: Flower -> PublicPlayer -> [Card] -> Card
bestFor monthFlower player = choose (Down . rank monthFlower player) bestFor monthFlower player = choose (Down . rank monthFlower player)
worstFor :: Flower -> Player Score -> [Card] -> Card worstFor :: Flower -> PublicPlayer -> [Card] -> Card
worstFor monthFlower player = choose (rank monthFlower player) worstFor monthFlower player = choose (rank monthFlower player)
rank :: Flower -> Player Score -> Card -> Int rank :: Flower -> PublicPlayer -> Card -> Int
rank monthFlower _ card rank monthFlower _ card
| isTrueLight card = 5 | isTrueLight card = 5
| card == RainMan = 2 | card == RainMan = 2

18
src/Automaton.hs
View File

@ -15,8 +15,8 @@ import Control.Concurrent (threadDelay)
import Control.Monad.Reader (ReaderT, ask) import Control.Monad.Reader (ReaderT, ask)
import Control.Monad.State (StateT) import Control.Monad.State (StateT)
import Control.Monad.Trans (lift) import Control.Monad.Trans (lift)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), PlayerID, Step(..)) import Hanafuda.KoiKoi (PlayerID, Step(..))
import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame) import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame(..), PublicState(..))
import Network.WebSockets (Connection, receiveData, sendTextData) import Network.WebSockets (Connection, receiveData, sendTextData)
import Prelude hiding (error, putStrLn) import Prelude hiding (error, putStrLn)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
@ -77,13 +77,17 @@ answer (Message.Relay {Message.message = Message.Invitation {}}) state = do
send $ Message.Answer {Message.accept = False} send $ Message.Answer {Message.accept = False}
return state return state
answer (Message.Game {Message.game, Message.logs}) state@(Playing {key, name}) = do answer message@(Message.Game {Message.logs}) state@(Playing {key, name}) = do
case step game of case Message.step $ Message.public game of
Over -> send Message.Quit >> return (LoggedIn {key, name}) Over -> send Message.Quit >> return (LoggedIn {key, name})
_ -> do _ ->
if playing game == key if Message.playing (Message.public game) == key
then send (Message.Play {Message.move = AI.move key game}) >> return state then
send (Message.Play {Message.move = AI.move key game, Message.onGame = game})
>> return state
else return state else return state
where
game = Message.state message
answer (Message.Relay {Message.from, Message.message = Message.LogOut}) (Playing {key, name, against}) answer (Message.Relay {Message.from, Message.message = Message.LogOut}) (Playing {key, name, against})
| from == against = send Message.Quit >> return (LoggedIn {key, name}) | from == against = send Message.Quit >> return (LoggedIn {key, name})