Simplify character initialization to be all in one step
This commit is contained in:
parent
355c7d08be
commit
2a3a56ad01
6 changed files with 35 additions and 45 deletions
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE OverloadedLists #-}
|
||||
module Area (
|
||||
Area(..)
|
||||
, Key
|
||||
, Key(..)
|
||||
, dex
|
||||
) where
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
31
src/Game.hs
31
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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue