Add pockets to Characters and remove the parts of this type only relevant to the client

This commit is contained in:
Tissevert 2018-12-17 12:42:00 +01:00
parent 6633f0221b
commit 5966beed85
5 changed files with 63 additions and 30 deletions

View File

@ -10,26 +10,15 @@ import Data.Aeson (encode)
import Data.ByteString.Lazy.Char8 (ByteString, putStrLn, unpack) import Data.ByteString.Lazy.Char8 (ByteString, putStrLn, unpack)
import Prelude hiding (log, putStrLn) import Prelude hiding (log, putStrLn)
import qualified Area (Key(..)) import qualified Area (Key(..))
import Character (Character(..)) import qualified Character (new)
import Game (Game(..), Position(..), State(..)) import Game (Game(..), Position(..), State(..))
import Message (Connected, receive, send) import Message (Connected, receive, send)
import qualified Message.Client as Client (Message(..)) import qualified Message.Client as Client (Message(..))
import qualified Message.Server as Server (Message(..)) import qualified Message.Server as Server (Message(..))
import Tool.Array (malloc)
edges :: Game -> Client.Message -> Connected Game edges :: Game -> Client.Message -> Connected Game
edges Empty Client.NewGame = return $ Game {
edges Empty Client.NewGame = return Initializing character = Character.new
edges Empty (Client.Resume {Client.game}) = return game
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 { , state = At $ Position {
area = Area.Key 0 area = Area.Key 0
, x = 0 , x = 0
@ -37,6 +26,8 @@ edges Initializing message@(Client.Initialize {}) = return $ Game {
} }
} }
edges Empty (Client.Resume {Client.game}) = return game
edges game message = do edges game message = do
let errorMessage = "inacceptable message " <> encode message <> " in this context" let errorMessage = "inacceptable message " <> encode message <> " in this context"
send (Server.Error $ unpack errorMessage) send (Server.Error $ unpack errorMessage)

View File

@ -4,19 +4,47 @@ module Character (
Character(..) Character(..)
, Key , Key
, dex , dex
, new
) where ) where
import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions) import Data.Aeson (ToJSONKey(..), FromJSONKey(..), ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
import Data.Map (Map)
import Data.Vector (Vector) import Data.Vector (Vector)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gender (Gender(..)) import qualified Item (Group)
import Pokemon (Pokemon) import Pokemon (Pokemon)
import Tool.Array (Array) import Tool.Array (Array, malloc)
data Badge =
Earth
| Fire
| Water
| Plant
| Electricity
| Psy
| Normal
deriving (Generic)
instance ToJSON Badge where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Badge
data Pocket =
Items
| Rare
| Techniques
| Special
deriving (Eq, Generic, Ord)
instance ToJSON Pocket where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Pocket
instance ToJSONKey Pocket
instance FromJSONKey Pocket
data Character = Character { data Character = Character {
name :: String items :: Map Pocket (Array Item.Group)
, skin :: FilePath , badges :: Array Badge
, gender :: Gender
, pokemons :: Array Pokemon , pokemons :: Array Pokemon
} deriving (Generic) } deriving (Generic)
@ -32,5 +60,17 @@ instance ToJSON Key where
instance FromJSON Key where instance FromJSON Key where
parseJSON = genericParseJSON defaultOptions parseJSON = genericParseJSON defaultOptions
new :: Character
new = Character {
items = [
(Items, malloc 30)
, (Rare, malloc 10)
, (Techniques, malloc 50)
, (Special, malloc 5)
]
, badges = malloc 8
, pokemons = malloc 6
}
dex :: Vector Character dex :: Vector Character
dex = [] dex = []

View File

@ -45,7 +45,6 @@ instance FromJSON State where
data Game = data Game =
Empty Empty
| Initializing
| Game { | Game {
character :: Character character :: Character
, state :: State , state :: State

View File

@ -2,12 +2,13 @@
{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedLists #-}
module Item ( module Item (
Item(..) Item(..)
, Group(..)
, Key , Key
, Type(..) , Type(..)
, dex , dex
) where ) where
import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions) import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, defaultOptions)
import Data.Vector (Vector) import Data.Vector (Vector)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Pokemon (Pokemon) import Pokemon (Pokemon)
@ -25,8 +26,16 @@ newtype Key = Key Int deriving (Generic)
instance ToJSON Key where instance ToJSON Key where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
instance FromJSON Key where instance FromJSON Key
parseJSON = genericParseJSON defaultOptions
data Group = Group {
item :: Key
, count :: Int
} deriving (Generic)
instance ToJSON Group where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Group
dex :: Vector Item dex :: Vector Item
dex = [] dex = []

View File

@ -6,15 +6,9 @@ module Message.Client (
import Data.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToEncoding, defaultOptions) import Data.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToEncoding, defaultOptions)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Game (Game) import Game (Game)
import Gender (Gender)
data Message = data Message =
NewGame NewGame
| Initialize {
name :: String
, skin :: String
, gender :: Gender
}
| Resume { | Resume {
game :: Game game :: Game
} deriving (Generic) } deriving (Generic)