SimpleGfx.hs

{-# OPTIONS_GHC -Wall #-}

module FRP.Reactive.GLUT.SimpleGfx
  ( initGfx, glwrap, windowPoint
  -- remove later
  , drawBox
  ) where

import Graphics.UI.GLUT
-- import Graphics.Rendering.OpenGL as GL

windowWidth, windowHeight :: GLint
windowWidth = 800 -- physical pixels
windowHeight = 600 -- physical pixels

canvasMinX, canvasMaxX, canvasMinY, canvasMaxY :: Double
canvasMaxX =  400 -- logical units
canvasMinX = -400 -- logical units
canvasMaxY =  300 -- logical units
canvasMinY = -300 -- logical units

canvasFarZ, canvasNearZ :: GLclampd
canvasFarZ =  4000
canvasNearZ = -4000

-- Initialize GL graphics
initGfx :: String -> IO ()
initGfx title = do
  -- Glut Part
  getArgsAndInitialize
  initialWindowSize $= (Size windowWidth windowHeight)
  initialDisplayMode $= [DoubleBuffered, RGBAMode]
  createWindow title
  -- OpenGL Part
  shadeModel $= Smooth
  lineSmooth $= Enabled

  lighting $= Enabled
  -- Needs to be disabled for fieldtrip
  -- colorMaterial $= Just (Front,AmbientAndDiffuse)
  light (Light 0) $= Enabled

  -- Enable the following if non-uniform scaling will occur
  normalize $= Enabled
  -- Enable the following if only uniform scaling will occur
  -- rescaleNormal $= Enabled

  -- Set the light up at an infinite distance behind the camera
  position (Light 0) $= (Vertex4 0.0 0.0 1.0 0.0)
  ambient (Light 0) $= (Color4 0.0 0.0 0.0 1.0)
  diffuse (Light 0) $= (Color4 1.0 1.0 1.0 1.0)
  specular (Light 0) $= (Color4 1.0 1.0 1.0 1.0)

  -- Some simple defaults here.
  materialSpecular (Front) $= (Color4 1.0 1.0 1.0 1.0)
  materialEmission (Front) $= (Color4 0.0 0.0 0.0 1.0)
  materialShininess (Front) $= 70.0

  blend $= Enabled
  blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
  lineWidth $= 1.5
  clearColor $= Color4 0 0 0 0
  pointSmooth $= Enabled
  -- pointSize $= 5.0
  clearDepth $= canvasFarZ
  depthRange $= (canvasNearZ, canvasFarZ)
  depthFunc $= Just Lequal
  matrixMode $= Projection
  loadIdentity
  ortho canvasMinX canvasMaxX canvasMinY canvasMaxY canvasNearZ canvasFarZ
  matrixMode $= Modelview 0
  loadIdentity

-- | Convert a window position to a logical X,Y.  Logical zero is at the
-- origin, and [size??].
-- 
-- TODO: fix to work with variable window size.
windowPoint :: Position -> IO (Double, Double)
windowPoint (Position x y) = return $
 let pixToLog p minP maxP l u = 
       let p0to1 = (realToFrac $ p-minP)/(realToFrac $ maxP-minP)
       in (p0to1 * (u-l)) + l
 in (pixToLog x 0 (windowWidth-1) canvasMinX canvasMaxX,
     -(pixToLog y 0 (windowHeight-1) canvasMinY canvasMaxY))

-- | Wrap an OpenGL rendering action, to clear the frame-buffer before
-- swap buffers afterward.
glwrap :: IO () -> IO ()
glwrap act = do clearScreen (0.0,0.0,0.0)
                -- putStrLn "glwrap"
                act
                swapBuffers

clearScreen :: (GLdouble, GLdouble, GLdouble) -> IO()
clearScreen (r,g,b) = do
  clearColor $= Color4 (realToFrac r) (realToFrac g) (realToFrac b) 0
  clear [ColorBuffer, DepthBuffer]


vertexPF :: VertexComponent a => (a,a) -> IO ()
vertexPF = vertex . (uncurry Vertex2)

drawBox :: (MatrixComponent c, Fractional c) => (c, c) -> IO ()
drawBox (centerX,centerY) = preservingMatrix $ do
  translate $ Vector3 centerX centerY 0.0
  renderPrimitive Polygon (mapM_ vertexPF [
      (-10.0::GLdouble ,-10.0),
      (-10.0,10.0),
      (10.0,10.0),
      (10.0,-10.0) ] )