You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
73 lines
2.2 KiB
73 lines
2.2 KiB
{-# LANGUAGE DeriveGeneric #-}
|
|
module JSONDeser where
|
|
|
|
import Data.Set(fromList)
|
|
import Data.Maybe
|
|
import qualified Data.ByteString.Lazy as BS
|
|
import Data.Aeson
|
|
import GHC.Generics
|
|
import qualified Datatypes as DT
|
|
import qualified Datatypes.Game as DT.Game
|
|
import LCG
|
|
|
|
|
|
data Cell = Cell { x :: Int, y :: Int}
|
|
deriving (Show, Generic)
|
|
|
|
data Unit = Unit { members :: [Cell], pivot :: Cell}
|
|
deriving (Show, Generic)
|
|
|
|
data Input = Input { id :: Int,
|
|
units :: [Unit],
|
|
width :: Int,
|
|
height :: Int,
|
|
filled :: [Cell],
|
|
sourceLength :: Int,
|
|
sourceSeeds :: [Int]
|
|
}
|
|
deriving (Show, Generic)
|
|
|
|
|
|
instance FromJSON Cell
|
|
instance ToJSON Cell
|
|
|
|
instance FromJSON Unit
|
|
instance ToJSON Unit
|
|
|
|
instance FromJSON Input
|
|
instance ToJSON Input
|
|
|
|
readInput :: BS.ByteString -> (Int,[(Int,DT.Game)])
|
|
readInput str = newGame (readInputInternal str)
|
|
|
|
readInputInternal :: BS.ByteString -> Input
|
|
readInputInternal str = if isJust result
|
|
then fromJust result
|
|
else error "Error during JSON parsing"
|
|
where
|
|
result = (decode str :: Maybe Input)
|
|
|
|
|
|
newGame :: Input -> (Int,[(Int,DT.Game)])
|
|
newGame input = (JSONDeser.id input, zip (sourceSeeds input) (map gameFromSeed (sourceSeeds input)))
|
|
where
|
|
gameFromSeed seed = DT.Game.new board (seedUnits seed input)
|
|
board = DT.Board w h filledelement
|
|
w = width input
|
|
h = height input
|
|
filledelement = fromList (map cellConvVM (filled input))
|
|
|
|
seedUnits :: Int -> Input -> [DT.Unit]
|
|
seedUnits s input = map (\x -> uinput !! x ) unit_index
|
|
where
|
|
unit_index = lcg s (length (units input)) (sourceLength input)
|
|
uinput = map unitConvVM (units input)
|
|
|
|
cellConvVM :: Cell -> DT.Cell
|
|
cellConvVM (Cell x y) = (x,y)
|
|
|
|
unitConvVM :: Unit -> DT.Unit
|
|
unitConvVM unit = DT.Unit (cellConvVM (pivot unit)) setcell
|
|
where
|
|
setcell = fromList (map cellConvVM (members unit))
|
|
|