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