frag-1.1: src/Camera.hs

{-# LANGUAGE BangPatterns #-}

-- Camera.hs; Mun Hon Cheong (mhch295@cse.unsw.edu.au) 2005

-- Functions to manipulate a camera

module Camera where

import Matrix
import qualified AFRPGeometry as P
import PhysicalDimensions
import Graphics.UI.GLUT

data Camera = Camera {cpos      :: !(Double,Double,Double),
                      viewPos   :: !(Double,Double,Double),
                      upVec     :: !(Double,Double,Double)
                     } deriving (Show,Read)

-- initialise a camera
initCamera ::(Real a) => (a, a, a)-> (a, a, a) -> (a, a, a) -> Camera
initCamera  (a,b,c) (d,e,f) (g,h,i) =
   Camera {cpos    = ((realToFrac a),(realToFrac b),(realToFrac c)),
           viewPos = ((realToFrac d),(realToFrac e),(realToFrac f)),
           upVec   = ((realToFrac g),(realToFrac h),(realToFrac i))}


-- convert from a tuple of doubles to an OpenGL vector
toVector3 :: Vec3 -> Vector3 GLdouble
toVector3 (a,b,c) =  Vector3 a b c


-- convert from a tuple of doubles to an OpenGL vertex
toVertex3 :: Vec3 -> Vertex3 GLdouble
toVertex3 (a,b,c) =  Vertex3 a b c


-- gets OpenGL to assume the view of the camera
cameraLook :: Camera -> IO()
cameraLook camera = do
   let headPos  = vectorAdd (0,30,0) (cpos camera)
   let headView = vectorAdd (0,30,0) (viewPos camera)
   lookAt (toVertex3 headPos) (toVertex3 headView) (toVector3 (upVec camera))


-- sets the view vector of the camera based on the displacement
-- of the cursor from the center of the screent. Hardcoded to
-- work at resolutions of 640x480
setView :: (Position2, Camera) -> (Camera)
setView ((P.Point2 x y),cam) =
  let cam1 =
        rotateView cam ((realToFrac (240 - y))/ 250.0)
          (normalise (crossProd (vectorSub (viewPos cam) (cpos cam)) (upVec cam)))
  in rotateView cam1 ((realToFrac (320 - x))/ 250.0) (0,1,0)


-- gets the vector from the players "muzzle point" to
-- infinity along the view vector. The muzzle point
-- isn't at the tip of the gun, its actually close
-- just a bit to the right of the start of the view vector
-- . It just creates the illusion that its being fired from
-- the players gun
firePos :: Vec3 -> Vec3 -> (Vec3,Vec3)
firePos (x,y,z) (vx,vy,vz) =
      let (sx,sy,sz) = normalise $
              crossProd (normalise $ vectorSub (vx,vy,vz) (x,y,z)) (0,1,0)
          (vsx,vsy,vsz) = normalise $
              crossProd (normalise $ vectorSub (vx,vy,vz) (x,y,z)) (sx,sy,sz)
          (sx1,sy1,sz1) = vectorAdd (2*sx,2*sy,2*sz) (x,(y+30),z)
          (sx2,sy2,sz2) = vectorAdd (2*vsx,2*vsy,2*vsz) (sx1,sy1,sz1)
          infin = ((x+(15000000*(vx-x))),
                   ((y+30)+(15000000*((vy+30)-(y+30)))),
                   (z+(15000000*(vz-z))))
          (_,_,_) = normalise $ vectorSub (sx2,sy2,sz2) infin
      in ((sx2,sy2,sz2),infin)


-- rotates the view vector along a vector
rotateView :: Camera -> Double -> Vec3 -> Camera
rotateView cam angle (x,y,z)=
   let
     (viewX,viewY,viewZ) = vectorSub (viewPos cam) (cpos cam)
     cosTheta = cos angle
     sinTheta = sin angle
     minusCosTheta = 1 - cosTheta
     nextViewX = (cosTheta   + minusCosTheta*x*x)*viewX +
                 (minusCosTheta*x*y - z*sinTheta)*viewY +
                 (minusCosTheta*x*z + y*sinTheta)*viewZ
     nextViewY = (minusCosTheta*x*y + z*sinTheta)*viewX +
                 (cosTheta   + minusCosTheta*y*y)*viewY +
                 (minusCosTheta*y*z - x*sinTheta)*viewZ
     nextViewZ = (minusCosTheta*x*y - y*sinTheta)*viewX +
                 (minusCosTheta*y*z + x*sinTheta)*viewY +
                 (cosTheta   + minusCosTheta*z*z)*viewZ
     (nVx,nVy,nVz) = vectorAdd (cpos cam) (nextViewX, nextViewY, nextViewZ)
   in Camera {cpos=(cpos cam), viewPos=(nVx, nVy, nVz), upVec = (upVec cam)}


-- moves the camera along the view vector
move :: (Double,Camera) -> Camera
move (speed,cam) =
  let
     (x,y,z)       = (cpos cam)
     (vpx,vpy,vpz) = (viewPos cam)
     (vx,vy,vz)    = normalise (vectorSub (viewPos cam) (cpos cam))
     newx = (vx*speed)
     newy = (vy*speed)
     newz = (vz*speed)
     newvx = (vx*speed)
     newvy = (vy*speed)
     newvz = (vz*speed)
  in Camera {cpos    = (x+newx,y+newy,z+newz),
             viewPos = (vpx+newvx,vpy+newvy,vpz+newvz),
             upVec   = (upVec cam)}


-- moves the camera pependicular to the view vector
strafe :: (Double,Camera) -> Camera
strafe (speed,cam) =
   let
      (sx,_,sz) =
         normalise (crossProd (vectorSub (viewPos cam) (cpos cam)) (upVec cam))
      (x,y,z) = (cpos cam)
      (vx,vy,vz) = (viewPos cam)
      newx = x + (sx*speed)
      newz = z + (sz*speed)
      newvx = vx + (sx*speed)
      newvz = vz + (sz*speed)
   in Camera {cpos    = (newx, y, newz),
              viewPos = (newvx, vy, newvz),
              upVec   = (upVec cam)}


-- sets the position of the camera
setPos :: Vec3 -> Camera-> Camera
setPos vec cam =
   Camera {cpos    = vec,
           viewPos = (viewPos cam),
           upVec   = (upVec cam)}


-- lowers the camera along the y-axis
dropCam :: (Camera,Double) -> Camera
dropCam (cam,vel) =
   let cam1 = setPos (vectorAdd (cpos cam) (0,vel,0)) cam
   in setViewPos (vectorAdd (viewPos cam1) (0,vel,0)) cam1


-- sets the target position the camera is looking at
setViewPos :: Vec3 -> Camera-> Camera
setViewPos vec cam =
   Camera {cpos    = (cpos cam),
           viewPos = vec,
           upVec   = (upVec cam)}