module SoccerFun.UI.GL where
import qualified Graphics.UI.GLUT as GL
import Graphics.UI.GLUT (($=), get)
import Data.IORef
import Control.Monad
import Unsafe.Coerce
import SoccerFun.MatchControl
import SoccerFun.Types
import SoccerFun.Geometry
import SoccerFun.Referee.Ivanov
import System.Random
import SoccerFun.MatchGame
import SoccerFun.Player
import SoccerFun.Team (Team)
import Data.Maybe
import SoccerFun.Field
import SoccerFun.Ball
runMatch ∷ (Home → Field → Team) → (Home → Field → Team) → IO ()
runMatch t1 t2 = do
let
field = Field 70 105
team1 = t1 West field
team2 = t2 East field
match ← liftM (setMatchStart team1 team2 field (ivanovReferee field team1 team2) 5) newStdGen
(prog,args) ← GL.getArgsAndInitialize
GL.initialDisplayMode $= [GL.DoubleBuffered, GL.Multisampling]
p ← get GL.displayModePossible
when (not p) $ do
GL.initialDisplayMode $= [GL.DoubleBuffered]
p ← get GL.displayModePossible
when (not p) $ GL.initialDisplayMode $= []
window ← GL.createWindow "SoccerFun"
GL.clearColor $= (GL.Color4 0 0.5 0 0 ∷ GL.Color4 GL.GLclampf)
aspect ← newIORef 1
registerCallbacks window aspect =<< newIORef match
GL.cursor $= GL.LeftArrow
GL.mainLoop
GL.exit
registerCallbacks ∷ GL.Window → IORef GL.GLdouble → IORef Match → IO ()
registerCallbacks window aspect match = do
GL.displayCallback $= display
GL.reshapeCallback $= Just reshape
gameLoop
where
gameLoop = do
((refereeActions,playerWithActions),match') ← liftM stepMatch $ readIORef match
writeIORef match match'
GL.postRedisplay $ Just window
let actions = mapMaybe logRefereeAction refereeActions
if null actions
then GL.addTimerCallback 50 gameLoop
else GL.addTimerCallback 1000 gameLoop
mapM_ putStrLn actions
reshape s@(GL.Size w h) = do
writeIORef aspect newAspect
GL.viewport $= (GL.Position 0 0, s)
GL.matrixMode $= GL.Projection
GL.loadIdentity
GL.perspective 0 newAspect (1) 1
GL.matrixMode $= GL.Modelview 0
where newAspect = fromIntegral w / fromIntegral (max 1 h)
display = do
m@Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time} ← readIORef match
GL.clear [GL.ColorBuffer]
GL.loadIdentity
a ← readIORef aspect
if a < 1 then GL.ortho2D (1) 1 (1/a) (1/a) else GL.ortho2D (1*a) (1*a) (1) 1
let zoom = convertFloat $ 2.1 / flength field
GL.scale zoom zoom 1
GL.translate $ vector2 (flength field/2,fwidth field/2)
renderStatus m
GL.lineWidth $= 3
renderField field
GL.lineWidth $= 2
renderBall ball
colorRGB (1,0,0)
mapM_ renderPlayer t1
colorRGB (0,0,1)
mapM_ renderPlayer t2
GL.swapBuffers
renderStatus Match {theField = field, team1 = t1, team2 = t2, theBall = ball, score = score, playingTime = time} = do
colorRGB (0,0,0)
GL.preservingMatrix $ do
GL.translate $ vector2 (0, fwidth field + 2)
GL.lineWidth $= 2
drawStatus $ show (fst score) ++ ":" ++ show (snd score) ++ " " ++ show (fromIntegral (round (time * 100)) / 100)
renderField Field {flength = l, fwidth = w} = do
colorRGB (1,1,1)
GL.renderPrimitive GL.LineLoop $ do
vertex2 (0,0)
vertex2 (l,0)
vertex2 (l,w)
vertex2 (0,w)
renderBall (Free Ball {ballPos = p}) = do
colorRGB (1,1,1)
drawAt3D p $ GL.renderPrimitive GL.Polygon (circle 0.5 0.5 10)
renderPlayer Player {pos = p, playerID = id} = drawAt p $ do
square
drawString $ show $ playerNo id
colorRGB ∷ (GL.GLfloat,GL.GLfloat,GL.GLfloat) → IO ()
colorRGB (r,g,b) = GL.color $ GL.Color3 r g b
drawAt3D ∷ Position3D → IO () → IO ()
drawAt3D pos = drawAt (pxy pos)
drawAt ∷ Position → IO () → IO ()
drawAt pos draw = GL.preservingMatrix $ do
GL.translate $ vector2 (px pos, py pos)
draw
square ∷ IO ()
square = GL.preservingMatrix $ do
GL.renderPrimitive GL.LineLoop $ do
vertex2 (0.7,0.7)
vertex2 (0.7,0.7)
vertex2 (0.7,0.7)
vertex2 (0.7,0.7)
vector2 ∷ (Float,Float) → GL.Vector3 GL.GLfloat
vector2 (x,y) = GL.Vector3 (convertFloat x) (convertFloat y) 0
vertex2 ∷ (Float,Float) → IO ()
vertex2 (x,y) = GL.vertex $ GL.Vertex2 (convertFloat x) (convertFloat y)
circle r1 r2 step = mapM_ vertex2 vs where
is = take (truncate step + 1) [0, i' .. ]
i' = 2 * pi / step
vs = [ (r1 * cos i, r2 * sin i) | i <- is ]
drawString label = GL.preservingMatrix $ do
GL.translate $ GL.Vector3 (0.3) (0.3) (0 ∷ GL.GLfloat)
GL.scale 0.007 0.007 (0 ∷ GL.GLdouble)
GL.renderString GL.MonoRoman label
drawStatus label = GL.preservingMatrix $ do
GL.translate $ GL.Vector3 (0.3) (0.3) (0 ∷ GL.GLfloat)
GL.scale 0.01 0.01 (0 ∷ GL.GLdouble)
GL.renderString GL.MonoRoman label
convertDouble ∷ Double → GL.GLdouble
convertDouble = unsafeCoerce
convertFloat ∷ Float → GL.GLfloat
convertFloat = unsafeCoerce