diff --git a/src/Area.hs b/src/Area.hs index 7d17d01..00287ac 100644 --- a/src/Area.hs +++ b/src/Area.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedLists #-} module Area ( Area(..) - , Key + , Key(..) , dex ) where diff --git a/src/Automaton.hs b/src/Automaton.hs index 3c4084a..44a1f16 100644 --- a/src/Automaton.hs +++ b/src/Automaton.hs @@ -9,23 +9,32 @@ import Control.Monad.IO.Class (liftIO) import Data.Aeson (encode) import Data.ByteString.Lazy.Char8 (ByteString, putStrLn, unpack) import Prelude hiding (log, putStrLn) +import qualified Area (Key(..)) import Character (Character(..)) -import Game (Game(..), InitProcess(..), State(..), stub) +import Game (Game(..), Position(..), State(..)) import Message (Connected, receive, send) import qualified Message.Client as Client (Message(..)) import qualified Message.Server as Server (Message(..)) +import Tool.Array (malloc) edges :: Game -> Client.Message -> Connected Game -edges (Game {state = Start}) Client.NewGame = return $ Game.stub { - state = Initializing Name - } +edges Empty Client.NewGame = return Initializing -edges (Game {state = Start}) (Client.Resume {Client.game}) = return game +edges Empty (Client.Resume {Client.game}) = return game -edges (Game {state = Initializing Name, character}) (Client.Initialize {Client.step = Name, Client.value}) = return $ Game { - character = character { name = value } - , state = Initializing Skin +edges Initializing message@(Client.Initialize {}) = return $ Game { + character = Character { + name = Client.name message + , skin = Client.skin message + , gender = Client.gender message + , pokemons = malloc 6 + } + , state = At $ Position { + area = Area.Key 0 + , x = 0 + , y = 0 + } } edges game message = do diff --git a/src/Character.hs b/src/Character.hs index 04ebc45..a811a11 100644 --- a/src/Character.hs +++ b/src/Character.hs @@ -4,7 +4,6 @@ module Character ( Character(..) , Key , dex - , stub ) where import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions) @@ -12,7 +11,7 @@ import Data.Vector (Vector) import GHC.Generics (Generic) import Gender (Gender(..)) import qualified Pokemon (T) -import Tool.Array (Array, malloc) +import Tool.Array (Array) data Character = Character { name :: String @@ -35,10 +34,3 @@ instance FromJSON Key where dex :: Vector Character dex = [] - -stub :: Character -stub = Character { - name = "" - , skin = "" - , pokemons = malloc 6 - } diff --git a/src/Game.hs b/src/Game.hs index 2e79528..5fd5e05 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -1,16 +1,14 @@ {-# LANGUAGE DeriveGeneric #-} module Game ( Game(..) - , InitProcess(..) + , Position(..) , State(..) - , stub ) where import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions) import GHC.Generics (Generic) import Character (Character) -import qualified Character (stub) import qualified Area (Key) data Position = Position { @@ -31,13 +29,6 @@ instance ToJSON Turn where instance FromJSON Turn where parseJSON = genericParseJSON defaultOptions -data InitProcess = Gender | Name | Skin deriving (Generic) - -instance ToJSON InitProcess where - toEncoding = genericToEncoding defaultOptions -instance FromJSON InitProcess where - parseJSON = genericParseJSON defaultOptions - data State = At Position | Fighting { @@ -45,8 +36,6 @@ data State = , opponent :: Character , turn :: Turn } - | Initializing InitProcess - | Start deriving (Generic) instance ToJSON State where @@ -54,18 +43,16 @@ instance ToJSON State where instance FromJSON State where parseJSON = genericParseJSON defaultOptions -data Game = Game { - character :: Character - , state :: State - } deriving (Generic) +data Game = + Empty + | Initializing + | Game { + character :: Character + , state :: State + } + deriving (Generic) instance ToJSON Game where toEncoding = genericToEncoding defaultOptions instance FromJSON Game where parseJSON = genericParseJSON defaultOptions - -stub :: Game -stub = Game { - character = Character.stub - , state = Start - } diff --git a/src/Main.hs b/src/Main.hs index 6b69f70..7bec88e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,7 +11,7 @@ import Network.Wai.Handler.WebSockets (websocketsOr) import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions, forkPingThread) import qualified Automaton (run) import Config (listenPort) -import qualified Game (stub) +import qualified Game (Game(..)) makeApp :: IO ServerApp makeApp = @@ -19,7 +19,7 @@ makeApp = connection <- acceptRequest pending putStrLn "New connection" forkPingThread connection 20 - runReaderT (evalStateT Automaton.run Game.stub) connection + runReaderT (evalStateT Automaton.run Game.Empty) connection main :: IO () main = do diff --git a/src/Message/Client.hs b/src/Message/Client.hs index 2f59a67..bea6d58 100644 --- a/src/Message/Client.hs +++ b/src/Message/Client.hs @@ -4,14 +4,16 @@ module Message.Client ( ) where import Data.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToEncoding, defaultOptions) -import Game (Game, InitProcess(..)) import GHC.Generics (Generic) +import Game (Game) +import Gender (Gender) data Message = NewGame | Initialize { - step :: InitProcess - , value :: String + name :: String + , skin :: String + , gender :: Gender } | Resume { game :: Game