{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}

module Graphics.Gloss.Internals.Interface.ViewPort.Motion
	(callback_viewPort_motion)
where
import Graphics.Gloss.Data.Vector
import Graphics.Gloss.Geometry.Angle
import Graphics.Gloss.Internals.Interface.ViewPort
import Graphics.Gloss.Internals.Interface.Callback
import Graphics.Gloss.Internals.Interface.Backend
import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC
import qualified Graphics.Rendering.OpenGL.GL					as GL
import Control.Monad	
import Data.IORef


-- | Callback to handle keyboard and mouse button events
--	for controlling the viewport.
callback_viewPort_motion 
	:: IORef ViewPort 	-- ^ ref to ViewPort state
	-> IORef VPC.State 	-- ^ ref to ViewPort Control state
	-> Callback

callback_viewPort_motion portRef controlRef 
 	= Motion (viewPort_motion portRef controlRef)

viewPort_motion
	:: IORef ViewPort
	-> IORef VPC.State
	-> MotionCallback
	
viewPort_motion
	portRef controlRef
	stateRef
	pos
 = do
--	putStr $ "motion pos = " ++ show pos ++ "\n"

	translateMark	<- controlRef `getsIORef` VPC.stateTranslateMark
	rotateMark	<- controlRef `getsIORef` VPC.stateRotateMark

	(case translateMark of
	 Nothing		-> return ()
	 Just (markX, markY)	
	  -> do
		motionTranslate
	  	  portRef controlRef
		  (fromIntegral markX, fromIntegral markY)
		  pos 
		postRedisplay stateRef)


	(case rotateMark of
	 Nothing		-> return ()
	 Just (markX, markY)
	  -> do
		motionRotate
	  	  portRef controlRef
		  (fromIntegral markX, fromIntegral markY)
		  pos 
		postRedisplay stateRef)


motionTranslate
	:: IORef ViewPort
        -> IORef VPC.State
        -> (GL.GLint, GL.GLint)
        -> (Int, Int)
	-> IO ()
 
motionTranslate 
	portRef controlRef
	(markX :: GL.GLint, markY :: GL.GLint)
	(posX, posY)
 = do
	(transX, transY)
		<- portRef `getsIORef` viewPortTranslate

	scale	<- portRef `getsIORef` viewPortScale
	r	<- portRef `getsIORef` viewPortRotate

	let dX		= fromIntegral $ markX - (fromIntegral posX)
	let dY		= fromIntegral $ markY - (fromIntegral posY)

	let offset	= (dX / scale, dY / scale)

	let (oX, oY)	= rotateV (degToRad r) offset

	portRef `modifyIORef` \s -> s 
		{ viewPortTranslate	
		   = 	( transX - oX
		 	, transY + oY) }
		
	controlRef `modifyIORef` \s -> s
		{ VPC.stateTranslateMark
		   =	Just (fromIntegral posX, fromIntegral posY) }


motionRotate
	:: IORef ViewPort
	-> IORef VPC.State
	-> (GL.GLint, GL.GLint)
	-> (Int, Int)
	-> IO ()

motionRotate 
	portRef controlRef
	(markX :: GL.GLint, _markY :: GL.GLint)
	(posX, posY)
 = do
 	rotate		<- portRef    `getsIORef` viewPortRotate
	rotateFactor	<- controlRef `getsIORef` VPC.stateRotateFactor
	
	portRef `modifyIORef` \s -> s 
		{ viewPortRotate
		   = 	rotate + rotateFactor * fromIntegral ((fromIntegral posX) - markX) }
		
	controlRef `modifyIORef` \s -> s
		{ VPC.stateRotateMark
		   = 	Just (fromIntegral posX, fromIntegral posY) }


getsIORef :: IORef a -> (a -> r) -> IO r
getsIORef ref fun
 = liftM fun $ readIORef ref