Simplify character initialization to be all in one step

This commit is contained in:
Tissevert 2018-12-15 07:53:03 +01:00
parent 355c7d08be
commit 2a3a56ad01
6 changed files with 35 additions and 45 deletions

View File

@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedLists #-}
module Area (
Area(..)
, Key
, Key(..)
, dex
) where

View File

@ -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

View File

@ -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
}

View File

@ -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
}

View File

@ -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

View File

@ -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