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})