73 lines
1.9 KiB
Haskell
73 lines
1.9 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Automaton (
|
|
run
|
|
) where
|
|
|
|
import Control.Monad.State (get, put)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Data.Aeson (encode)
|
|
import Data.ByteString.Lazy.Char8 (ByteString, putStrLn, unpack)
|
|
import Data.Vector ((!))
|
|
import Prelude hiding (log, putStrLn)
|
|
import qualified Area (Key(..), dex)
|
|
import qualified Character (new)
|
|
import Game (Direction(..), Game(..), Position(..), State(..))
|
|
import Message (Connected, receive, send)
|
|
import qualified Message.Client as Client (Message(..))
|
|
import qualified Message.Server as Server (Message(..))
|
|
|
|
edges :: Game -> Client.Message -> Connected ()
|
|
edges Empty Client.NewGame = set $ Game {
|
|
character = Character.new
|
|
, state = At $ Position {
|
|
area = Area.Key 0
|
|
, x = 0
|
|
, y = 0
|
|
, direction = S
|
|
}
|
|
}
|
|
|
|
edges Empty (Client.Resume {Client.game}) = set game
|
|
|
|
edges game@(Game {state = At position}) (Client.Move {Client.to}) =
|
|
set $ game {state = At newPosition}
|
|
where
|
|
newPosition
|
|
| direction position == to =
|
|
let (dx, dy) =
|
|
case to of
|
|
N -> (0, -1)
|
|
S -> (0, 1)
|
|
E -> (1, 0)
|
|
W -> (-1, 0)
|
|
in
|
|
position { x = x position + dx, y = y position + dy }
|
|
| otherwise = position { direction = to }
|
|
|
|
edges _ (Client.Load {Client.area}) =
|
|
case area of
|
|
Area.Key n -> send . Server.Area $ Area.dex ! n
|
|
|
|
edges _ message = do
|
|
let errorMessage = "inacceptable message " `mappend` encode message `mappend` " in this context"
|
|
send (Server.Error $ unpack errorMessage)
|
|
log errorMessage
|
|
|
|
log :: ByteString -> Connected ()
|
|
log line =
|
|
liftIO $ putStrLn line
|
|
|
|
set :: Game -> Connected ()
|
|
set game = do
|
|
log $ encode game
|
|
put game
|
|
send $ Server.Game game
|
|
|
|
run :: Connected ()
|
|
run = do
|
|
message <- Message.receive
|
|
game <- get
|
|
edges game message
|
|
run
|