Rasenschach-0.1: Main.hs

module Main where

import System.Directory
import System.FilePath ((</>))
import Data.IORef
import Data.Convertible
import Data.Time.Clock
import Data.List
import Data.Ord

import FRP.Yampa
import FRP.Yampa.Geometry

import qualified Graphics.UI.SDL as SDL

import qualified Render as Render
import RenderUtil

import Object
import ObjectBehaviour
import Animate
import AL
import States
import BasicTypes
import Message
import Global
import Grid
import Parser
import ParseTeam
import Helper
import Object
import Lineup
import AI

spainBorder   = rgbColor 252 0 2
spainCircle   = rgbColor 255 255 1

germanyBorder   = rgbColor 0 0 0
germanyCircle   = rgbColor 255 255 255

tiHome = (Home, spainBorder, spainCircle)
tiAway = (Away, germanyBorder, germanyCircle)

main :: IO ()
main = do
    setupBasicFiles
    sdl <- Render.init
    (playersHome, playersAway, param) <- paramFromOutside
    mainLoop sdl playersHome playersAway param
    SDL.quit

mainLoop sdl playersHome playersAway param = do
    sdlState <- newIORef Nothing
    writeIORef sdlState (Just sdl)
    bos <- baseObjs param
    let pls = playersInit param playersHome playersAway
    let alout = appendAL bos pls
    frameCounter <- newIORef 0 :: IO (IORef Int)
    t <- getCurrentTime
    let t' = convert t :: Double
    timeState <- newIORef t' --(convert t :: Double)
    let (lOO,lObj) = lineupKickoff param alout 0 Home 0 0
    Render.render param (map ooObsObjState $ elemsAL lOO) sdl
    Render.renderStartMsg sdl
    waitForSpaceKey
    animate param sdlState t' timeState frameCounter $ mergeAL lObj lOO
    count <- readIORef frameCounter
    now <- getCurrentTime
    let seconds = convert now - t'
    putStrLn $ "Frames per second: " ++ show (fromIntegral count / seconds)
    Render.renderEndMsg sdl
    continue <- shouldContinue
    if continue then mainLoop sdl playersHome playersAway param else return ()

baseObjs param =
 let
   g  = (1, ObjOutput (OOSGame 0 (0, 0) (GSKickOff, GPTeamPosition Home (Point2 0 0) 0 False) Home (Point3 0 0 0))
                        NoEvent NoEvent [])

    -- CAUTION: Always start with a valid player id!!
   ball  = (4, ObjOutput (OOSBall (Point3 0 0 0) (vector3 0 0 0) False (BSFree, BPWho 0 0))
               NoEvent NoEvent [])

 in return $ AL [g, ball]


playersInit param playersHome playersAway =
   let h = zip [100..] $ map (\pi -> op (kicksOff == piNumber pi) tiHome pi) playersHome
       a = zip [200..] $ map (op False tiAway) $ map mirrorPlayer playersAway
       axis = Point2 (pPitchWidth param / 2) (pPitchLength param / 2)
       kicksOff = piNumber $ minimumBy (\p1 p2 -> comparing dist p1 p2) playersHome
       dist pi = distance (piBasePosDefense pi) kickOffSpot
       kickOffSpot = Point2 (pPitchWidth param / 2) (pPitchLength param / 2)
       op selected ti pi = ObjOutput (OOSPlayer (Point3 0 0 0)
                                                (vector3 0 0 0)
                                                (vector3 0 0 0)
                                                selected selected selected 0
                                                ti pi 0
                                                (PBSNoBall, BSPNothing)
                                                (TSWaitingForKickOff, tspNull)
                                                NoFoot
                                     )
                               NoEvent NoEvent []
       mirrorPlayer p@(PlayerInfo { piBasePosDefense = pd, piBasePosOffense = po }) =
          p{ piBasePosDefense = mirrorPoint pd axis, piBasePosOffense = mirrorPoint po axis }

   in AL $ h ++ a


paramFromOutside :: IO ([PlayerInfo], [PlayerInfo], Param)
paramFromOutside = do
  dir <- getAppUserDataDirectory "Rasenschach"
  putStrLn dir
  Right (pHome, rulesHome) <- getTeam $ dir </> "home.team"
  Right (pAway, rulesAway) <- getTeam $ dir </> "away.team"
  let param = Param {
    pEps            = 0.1,
    pGround         = 0,
    pLeftBorderX    = 8.9,
    pRightBorderX   = 46.1,
    pUpperBorderY   = 9.3,
    pLowerBorderY   = 10,
    pPitchLength    = 102.0,
    pPitchWidth     = 83.5,
    pGoalWidth      = 10.32,

    pMaxheight      = 60.0,  -- in Meter

    pGravity        = -10.0,
    pBouncingTime   = 0.5,

    pPositionFactorX = 1.0,
    pPositionFactorY = 1.0,

    pVerticalShiftRatio = 1.0,
    pHorizontalShiftRatio = 0.3,

    pLineEnds = 10.0,

    pGameLength = 120.0,

    pRuleBaseHome = rulesHome,
    pRuleBaseAway = rulesAway,

    pGrid = undefined
  }
  return $ (pHome, pAway, param {pGrid = grid param 10 10})