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
import Data.List (sortOn)
import Data.Map ((!))
import Data.Map ((!), delete, findMin)
import Data.Ord (Down(..))
import Data.Set (Set, member)
import qualified Data.Set as Set (fromList, intersection, unions)
@ -13,25 +13,27 @@ import Hanafuda (
, cardsOf, cardsOfPack, contains, empty,flower, packOfCards, sameMonth, size, union
)
import Hanafuda.Player (Player(..), Players(..))
import Hanafuda.KoiKoi (GameBlueprint(..), Move(..), PlayerID, Step(..), Score)
import Hanafuda.Message (PublicGame)
import Hanafuda.KoiKoi (Move(..), PlayerID, Step(..), Score)
import Hanafuda.Message (PublicGame(..), PublicState(..), PublicPlayer)
move :: PlayerID -> PublicGame -> Move
move me (Game {step = ToPlay, month, players = Players p, river}) =
case getAvailableCards myHand (cardsOfPack river) of
[] -> Play $ worstFor month (p ! (nextPlayer $ p ! me)) myHand
move me (PublicGame {playerHand, public = PublicState {step = ToPlay, month, players, river}}) =
case getAvailableCards hand (cardsOfPack river) of
[] -> Play $ worstFor month opponent hand
available ->
let riverCard = bestFor month (p ! me) available in
let matchingCards = cardsOfPack . sameMonth riverCard . hand $ p ! me in
capture (bestFor month (p ! me) matchingCards) riverCard river
let riverCard = bestFor month (players ! me) available in
let matchingCards = cardsOfPack . sameMonth riverCard $ playerHand in
capture (bestFor month (players ! me) matchingCards) riverCard river
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}) =
Choose . bestFor month (p ! me) . cardsOfPack $ sameMonth card river
move me (PublicGame {public = PublicState {step = Turned card, month, players, 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 caught river =
@ -48,13 +50,13 @@ getAvailableCards hand =
choose :: Ord a => (Card -> a) -> [Card] -> Card
choose sortCriterion = head . sortOn sortCriterion
bestFor :: Flower -> Player Score -> [Card] -> Card
bestFor :: Flower -> PublicPlayer -> [Card] -> Card
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)
rank :: Flower -> Player Score -> Card -> Int
rank :: Flower -> PublicPlayer -> Card -> Int
rank monthFlower _ card
| isTrueLight card = 5
| 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.State (StateT)
import Control.Monad.Trans (lift)
import Hanafuda.KoiKoi (Game, GameBlueprint(..), PlayerID, Step(..))
import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame)
import Hanafuda.KoiKoi (PlayerID, Step(..))
import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame(..), PublicState(..))
import Network.WebSockets (Connection, receiveData, sendTextData)
import Prelude hiding (error, putStrLn)
import System.Exit (exitSuccess)
@ -77,13 +77,17 @@ answer (Message.Relay {Message.message = Message.Invitation {}}) state = do
send $ Message.Answer {Message.accept = False}
return state
answer (Message.Game {Message.game, Message.logs}) state@(Playing {key, name}) = do
case step game of
answer message@(Message.Game {Message.logs}) state@(Playing {key, name}) = do
case Message.step $ Message.public game of
Over -> send Message.Quit >> return (LoggedIn {key, name})
_ -> do
if playing game == key
then send (Message.Play {Message.move = AI.move key game}) >> return state
_ ->
if Message.playing (Message.public game) == key
then
send (Message.Play {Message.move = AI.move key game, Message.onGame = game})
>> return state
else return state
where
game = Message.state message
answer (Message.Relay {Message.from, Message.message = Message.LogOut}) (Playing {key, name, against})
| from == against = send Message.Quit >> return (LoggedIn {key, name})