htanks/Render.hs

module Render ( setup
              , resize
              , render
              ) where


import Game
import Level
import Tank

import Bindings.GLPng

import Control.Monad.State

import Data.Fixed
import Data.Ratio

import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble)
import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho)
import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..))
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)
import Graphics.Rendering.OpenGL.GL.VertexSpec


setup :: Int -> Int -> Game ()
setup w h = do
  resize w h
  (tex, info) <- liftIO $ pngBind "tex/Wood.png" NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) Linear'
  liftIO $ print info
  

resize :: Int -> Int -> Game ()
resize w h = do
  let wn = fromIntegral w
      hn = fromIntegral h
      aspect = fromReal (wn/hn)
  
  lvl <- gets level
  let s = max (0.5*(fromIntegral $ levelWidth lvl)/aspect) (0.5*(fromIntegral $ levelHeight lvl)) :: GLdouble
  
  liftIO $ do
    matrixMode $= Projection
    loadIdentity
    ortho (-s*aspect) (s*aspect) (-s) s (-1) 1
    
    matrixMode $= Modelview 0
    
    viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h)))


render :: Game ()
render = do
  tank <- liftM head $ gets tanks
  let x = fromReal . posx $ tank
      y = fromReal . posy $ tank
  
  liftIO $ do
           clear [ColorBuffer]
           
           renderPrimitive Quads $ do
                    vertex $ Vertex2 (x-0.5 :: GLfloat) (y-0.5 :: GLfloat)
                    vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat)
                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat)
                    vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat)

fromReal :: (Real a, Fractional b) => a -> b
fromReal = fromRational . toRational