Rasenschach-0.1.2: Main.hs

module Main where
 
import Graphics.UI.SDL (Surface) 
import Graphics.UI.SDL.TTF
import Graphics.UI.SDL.Mixer as Mix

import System.Directory
import System.FilePath ((</>))
import Data.IORef
import Data.Convertible
import Data.Time.Clock
import Data.List
import Data.Ord
import Data.Array  
import Control.Monad 
   
import FRP.Yampa
import FRP.Yampa.Geometry

import qualified Graphics.UI.SDL as SDL
  
import qualified Render 
import RenderUtil

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

spainBorder :: SDL.Pixel
spainBorder   = rgbColor 252 0 2
spainCircle :: SDL.Pixel
spainCircle   = rgbColor 255 255 1

germanyBorder :: SDL.Pixel
germanyBorder   = rgbColor 0 0 0
germanyCircle :: SDL.Pixel
germanyCircle   = rgbColor 255 255 255

tiHome :: (Team, SDL.Pixel, SDL.Pixel)
tiHome = (Home, spainBorder, spainCircle)
tiAway :: (Team, SDL.Pixel, SDL.Pixel)
tiAway = (Away, germanyBorder, germanyCircle)
 
main :: IO ()
main = do
    setupBasicFiles
    sdl <- Render.init
    (playersHome, playersAway, param) <- paramFromOutside
    mainLoop sdl playersHome playersAway param
    SDL.quit

mainLoop :: (Num i, Ix i) => (Surface, Surface, Array i Font, Array Int (Surface, Int), Chunk, Chunk, Chunk) -> [PlayerInfo] -> [PlayerInfo] -> Param -> IO ()
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
    rightNow <- getCurrentTime
    let seconds = convert rightNow - 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 :: (Monad m, Num k) => t -> m (AL k ObjOutput)
baseObjs _ =
 let
   g  = (1, ObjOutput (OOSGame 100 (0, 0) (GSKickOff, GPTeamPosition Home 100 [] (Point2 0 0) 0 False OOPKickOff) 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 :: (Enum k, Num k) => Param -> [PlayerInfo] -> [PlayerInfo] -> AL k ObjOutput
playersInit param playersHome playersAway =
   let h = zip [100..] $ map (\pI -> op (kicksOff == piNumber pI) tiHome pI) playersHome
       a = zip [200..] $ map (op False tiAway . 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 pl@(PlayerInfo { piBasePosDefense = pd, piBasePosOffense = po }) =
          pl{ 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    = 3.0, --8.9,
    pRightBorderX   = 43.0, --46.1,
    pUpperBorderY   = 2.0, --9.3,
    pLowerBorderY   = 4.0, --10,
    pPitchLength    = 116.8,
    pPitchWidth     = 89.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})