freekick2-0.1.0: src/Swos.hs

module Swos(SWOSTeamFile(..),
  SWOSTeam(..),
  SWOSPlayer(..),
  SWOSKit(..),
  SWOSSkills(..),
  SWOSColor(..),
  SWOSPosition(..),
  numPositions,
  isGoalkeeper,
  isDefender,
  isMidfielder,
  isAttacker,
  loadTeamsFromFile,
  loadTeamsFromDirectory
  )
where

import Data.Bits
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Char8 as C
import Control.Monad
import Control.Applicative
import System.Directory
import System.FilePath

import BinHelpers

packTwo :: Int -> Int -> Put
packTwo s1 s2 = 
  let a = fromIntegral s1
      b = fromIntegral s2
  in putWord8 (a `shiftL` 4 .|. (b .&. 15))

data SWOSTeamFile = SWOSTeamFile {
    numteams  :: Int
  , fileteams :: [SWOSTeam]
  }
  deriving (Show, Read, Eq)

data SWOSTeam = SWOSTeam {
    teamnation     :: Int
  , teamnumber     :: Int
  , swosteamnumber :: Int
  , teamname       :: String
  , teamtactics    :: Int
  , teamdivision   :: Int
  , primarykit     :: SWOSKit
  , secondarykit   :: SWOSKit
  , teamcoachname  :: String
  , teamplpos      :: C.ByteString
  , teamplayers    :: [SWOSPlayer]
  }
  deriving (Show, Read, Eq)

data SWOSColor = Grey | White | Black | Orange | Red | Blue | Brown | LightBlue | Green | Yellow
  deriving (Show, Read, Eq, Enum)

numPositions :: Int -> (Int, Int, Int)
numPositions 0 = (4, 4, 2)
numPositions 1 = (5, 4, 1)
numPositions 2 = (4, 5, 1)
numPositions 3 = (5, 3, 2)
numPositions 4 = (3, 5, 2)
numPositions 5 = (4, 3, 3)
numPositions 6 = (4, 2, 4)
numPositions 7 = (3, 4, 3)
numPositions 8 = (4, 4, 2)
numPositions 9 = (5, 2, 3)
numPositions 10 = (3, 2, 5)
numPositions 11 = (6, 3, 1)
numPositions _ = (4, 4, 2)

data SWOSKit = SWOSKit {
    kittype         :: Int
  , kitfirstcolor   :: SWOSColor
  , kitsecondcolor  :: SWOSColor
  , kitshortcolor   :: SWOSColor
  , kitsockscolor   :: SWOSColor
  }
  deriving (Show, Read, Eq)

data SWOSPosition = Goalkeeper | RightBack | LeftBack | Defender | RightWing | LeftWing | Midfielder | Attacker
  deriving (Show, Read, Eq, Enum)

isGoalkeeper :: SWOSPosition -> Bool
isGoalkeeper n = n == Goalkeeper

isDefender :: SWOSPosition -> Bool
isDefender RightBack = True
isDefender LeftBack  = True
isDefender Defender  = True
isDefender _         = False

isMidfielder :: SWOSPosition -> Bool
isMidfielder RightWing  = True
isMidfielder LeftWing   = True
isMidfielder Midfielder = True
isMidfielder _          = False

isAttacker :: SWOSPosition -> Bool
isAttacker n = n == Attacker

data SWOSPlayer = SWOSPlayer {
    plnationality :: Int
  , plnumber      :: Int
  , plname        :: String
  , plposition    :: SWOSPosition
  , plheadtype    :: Int
  , plunknown     :: Int
  , plmidbyte     :: Word8
  , plskills      :: SWOSSkills
  , plvalue       :: Int
  , plcareerbytes :: C.ByteString
  }
  deriving (Show, Read, Eq)

data SWOSSkills = SWOSSkills {
    skpassing   :: Int
  , skshooting  :: Int
  , skheading   :: Int
  , sktackling  :: Int
  , skcontrol   :: Int
  , skspeed     :: Int
  , skfinishing :: Int
  }
  deriving (Show, Read, Eq)

nullPlayer :: SWOSPlayer
nullPlayer = SWOSPlayer 0 0 "" Goalkeeper 0 0 0 nullSkills 0 (C.replicate 5 '\0')

nullSkills :: SWOSSkills
nullSkills = SWOSSkills 0 0 0 0 0 0 0

instance Binary SWOSTeamFile where
  put s = do
    putWord8 0x00
    putWord8Int (numteams s)
    mapM_ put (take (numteams s) (fileteams s))
  get = do
    _ <- get :: Get Word8
    n <- fromIntegral <$> getWord8
    ts <- replicateM n get
    return $ SWOSTeamFile n ts

instance Binary SWOSTeam where
  put s = do
    putWord8Int (teamnation s)
    putWord8Int (teamnumber s)
    putWord16le $ fromIntegral (swosteamnumber s)
    putWord8 0x00
    putName 19 (caps $ teamname s)
    putWord8Int (teamtactics s)
    putWord8Int (teamdivision s)
    put (primarykit s)
    put (secondarykit s)
    putName 24 (caps $ teamcoachname s)
    putBytes 16 (teamplpos s)
    mapM_ put (take 16 $ teamplayers s ++ repeat nullPlayer)
  get = do
    b1 <- getWord8Int
    b2 <- getWord8Int
    b3 <- fromIntegral <$> getWord16le
    _  <- get :: Get Word8
    tn <- getBytes 19
    b5 <- getWord8Int
    b6 <- getWord8Int
    kit1 <- get
    kit2 <- get
    cn <- getBytes 24
    pp  <- getBytes 16
    pls <- replicateM 16 get
    return $ SWOSTeam b1 b2 b3 (getName tn) b5 b6 kit1 kit2 (getName cn) pp pls

instance Binary SWOSKit where
  put s = do
    putWord8Int (kittype s)
    putWord8Int (fromEnum $ kitfirstcolor s)
    putWord8Int (fromEnum $ kitsecondcolor s)
    putWord8Int (fromEnum $ kitshortcolor s)
    putWord8Int (fromEnum $ kitsockscolor s)
  get = do
    t1 <- getWord8Int
    t2 <- toEnum <$> getWord8Int
    t3 <- toEnum <$> getWord8Int
    t4 <- toEnum <$> getWord8Int
    t5 <- toEnum <$> getWord8Int
    return $ SWOSKit t1 t2 t3 t4 t5

instance Binary SWOSPlayer where
  put s = do
    putWord8Int (plnationality s)
    putWord8 0x00
    putWord8Int (plnumber s)
    putName 23 (caps $ plname s)
    let bn = (fromIntegral (fromEnum $ plposition s) `shiftL` 5 .|. fromIntegral (plheadtype s) `shiftL` 3 .|. fromIntegral (plunknown s))
    putWord8 bn
    putWord8 (plmidbyte s)
    put (plskills s)
    putWord8Int (plvalue s)
    putBytes 5 (plcareerbytes s)
  get = do
    b0 <- getWord8Int
    _  <- getWord8Int
    b1 <- getWord8Int
    ns <- getBytes 23
    b2 <- getWord8Int
    b3 <- getWord8
    sks <- get
    b4 <- getWord8Int
    cr <- getBytes 5
    return $ SWOSPlayer b0 b1 (getName ns) (toEnum $ b2 `shiftR` 5) (b2 `shiftR` 3 .&. 0x03) (b2 .&. 0x03) b3 sks b4 cr

instance Binary SWOSSkills where
  put s = do
    packTwo 0x00 (skpassing s)
    packTwo (skshooting s) (skheading s)
    packTwo (sktackling s) (skcontrol s)
    packTwo (skspeed s) (skfinishing s)
  get = do
    b1 <- getWord8Int
    b2 <- getWord8Int
    b3 <- getWord8Int
    b4 <- getWord8Int
    let p = b1 .&. 15
        v = b2 `shiftR` 4
        h = b2 .&. 15
        t = b3 `shiftR` 4
        c = b3 .&. 15
        s = b4 `shiftR` 4
        f = b4 .&. 15
    return $ SWOSSkills p v h t c s f

loadTeamsFromFile :: FilePath -> IO [SWOSTeam]
loadTeamsFromFile fp = liftM fileteams (decodeFile fp)

loadTeamsFromDirectory :: FilePath -> IO [SWOSTeam]
loadTeamsFromDirectory fp = do
  fs <- getDirectoryContents fp
  tss <- forM fs $ \f -> do
    isfile <- doesFileExist (fp </> f)
    if isfile
      then loadTeamsFromFile (fp </> f)
      else return []
  return $ concat tss