diff --git a/handa-opengl.cabal b/handa-opengl.cabal --- a/handa-opengl.cabal +++ b/handa-opengl.cabal @@ -1,5 +1,5 @@ name: handa-opengl -version: 0.1.11.2 +version: 0.1.12.1 synopsis: Utility functions for OpenGL and GLUT description: This is a collection of miscellaneous utility functions for OpenGL and GLUT. @@ -14,7 +14,7 @@ stability: Stable homepage: https://bitbucket.org/bwbush/handa-opengl bug-reports: https://bwbush.atlassian.net/projects/HOGL/issues/ -package-url: https://bitbucket.org/bwbush/handa-opengl/downloads/handa-opengl-0.1.11.2.tar.gz +package-url: https://bitbucket.org/bwbush/handa-opengl/downloads/handa-opengl-0.1.12.1.tar.gz extra-source-files: ReadMe.md @@ -31,6 +31,7 @@ , GLUT >= 2.7.0.1 , opengl-dlp-stereo >= 0.1.5.1 , OpenGL >= 2.12.0.1 + , split >= 0.2.2 , vector-space >= 0.10.2 exposed-modules: Foreign.C.Types.Instances Graphics.Rendering.Handa.Face diff --git a/src/Graphics/Rendering/Handa/Projection.hs b/src/Graphics/Rendering/Handa/Projection.hs --- a/src/Graphics/Rendering/Handa/Projection.hs +++ b/src/Graphics/Rendering/Handa/Projection.hs @@ -14,6 +14,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -21,22 +22,26 @@ module Graphics.Rendering.Handa.Projection ( -- * Screens. Screen(..) +, upperRight , aspectRatio , throwRatio -- * Projections. +, OffAxisProjection(..) , projection +, fetchProjection ) where import Data.AdditiveGroup (AdditiveGroup) import Data.Aeson (FromJSON) -import Data.AffineSpace ((.-.)) -import Data.Binary (Binary(..)) +import Data.AffineSpace ((.+^), (.-.)) +import Data.Binary (Binary) import Data.Cross (cross3) import Data.Data (Data) -import Data.VectorSpace ((<.>), magnitude, normalized) +import Data.List.Split (chunksOf) +import Data.VectorSpace ((*^), (<.>), magnitude, normalized) import GHC.Generics (Generic) -import Graphics.Rendering.OpenGL (GLmatrix, MatrixComponent, MatrixOrder(RowMajor), Vector3(..), Vertex3(..), frustum, multMatrix, newMatrix, translate) +import Graphics.Rendering.OpenGL (GLmatrix, MatrixComponent, MatrixOrder(RowMajor), Vector3(..), Vertex3(..), frustum, get, getMatrixComponents, matrix, multMatrix, newMatrix, translate) import Graphics.Rendering.OpenGL.GL.Tensor.Instances (origin) @@ -60,6 +65,13 @@ } +-- | The upper right corner. +upperRight :: (Num a) + => Screen a + -> Vertex3 a +upperRight Screen{..} = lowerRight .+^ (upperLeft .-. lowerLeft) + + -- | The aspect ratio. aspectRatio :: (AdditiveGroup a, RealFloat a) => Screen a -- ^ The screen geometry. @@ -86,20 +98,30 @@ throw / width --- | Make an off-axis projection for a screen. This projection is based on the equations in \<\> . +-- | The equations to use for off-axis projection. +data OffAxisProjection = + KooimaOffAxis -- ^ Based on Kooima 2009, \<\>, which assumes a rectangular screen. + | VTKOffAxis -- ^ Based on VTK 6.3.0, \<\>, which does not assume a rectangular screen. + deriving (Eq, Read, Show) + + +-- | Make an off-axis projection for a screen. projection :: forall a . (AdditiveGroup a, MatrixComponent a, RealFloat a) - => Screen a -- ^ The screen geometry. - -> Vertex3 a -- ^ The eye position. - -> a -- ^ The distance to the near culling plane. - -> a -- ^ The distance to the far culling plane. - -> IO () -- ^ An action for performing the off-axis projection. -projection Screen{..} eye near far = + => OffAxisProjection -- ^ The off-axis equations to use. + -> Screen a -- ^ The screen geometry. + -> Vertex3 a -- ^ The eye position. + -> a -- ^ The distance to the near culling plane. + -> a -- ^ The distance to the far culling plane. + -> IO () -- ^ An action for performing the off-axis projection. + +-- Based on Kooima 2009, \<\>, which assumes a rectangular screen . +projection KooimaOffAxis Screen{..} eye near far = do let -- Orthonomal basis for screen. vr = normalized $ lowerRight .-. lowerLeft vu = normalized $ upperLeft .-. lowerLeft - vn = vr `cross3` vu + vn = normalized $ vr `cross3` vu -- Screen corners relative to eye. va = lowerLeft .-. eye vb = lowerRight .-. eye @@ -114,9 +136,51 @@ top = realToFrac $ (vu <.> vc) * scaling -- Matrix transforming world to screen. m = [[x, y, z, 0] | Vector3 x y z <- [vr, vu, vn]] ++ [[0, 0, 0, 1]] - -- Perpendicator projection + -- Perpendicator projection. frustum left right bottom top (realToFrac near) (realToFrac far) -- Rotate to non-perpendicular. multMatrix =<< (newMatrix RowMajor $ concat m :: IO (GLmatrix a)) -- Move apex of frustum. translate $ origin .-. eye + +-- Rewrite of VTK 6.3.0, \<\>, which does not assume a rectangular screen, in cleaner notation and using vector algebra. +projection VTKOffAxis s@Screen{..} eye near far = + do + let + -- Orthonomal basis for screen. + vr = normalized $ lowerRight .-. lowerLeft + vu = normalized $ upperRight s .-. lowerRight + vn = normalized $ vr `cross3` vu + -- Basis for inverse. + idet = 1 / (vr <.> vu `cross3` vn) + ur = idet *^ vu `cross3` vn + uu = idet *^ vn `cross3` vr + un = idet *^ vr `cross3` vu + -- Screen corners relative to eye. + va = lowerLeft .-. eye + vd = upperRight s .-. eye + -- Distance from eye to screen. + throw = - va <.> un + -- Extent on near clipping plane. + scaling = near / throw + left = realToFrac $ (ur <.> va) * scaling + right = realToFrac $ (ur <.> vd) * scaling + bottom = realToFrac $ (uu <.> va) * scaling + top = realToFrac $ (uu <.> vd) * scaling + -- Matrix transforming world to screen. + m = [[x, y, z, 0] | Vector3 x y z <- [ur, uu, un]] ++ [[0, 0, 0, 1]] + -- Perpendicator projection. + frustum left right bottom top (realToFrac near) (realToFrac far) + -- Rotate to non-perpendicular. + multMatrix =<< (newMatrix RowMajor $ concat m :: IO (GLmatrix a)) + -- Move apex of frustum. + translate $ origin .-. eye + + +-- | Retrieve the current projection matrix. +fetchProjection :: forall a . (MatrixComponent a, RealFloat a) + => IO [[a]] -- ^ An action to retrieve the projection matrix, in row-major order. +fetchProjection = + do + m <- get $ matrix Nothing :: IO (GLmatrix a) + chunksOf 4 <$> getMatrixComponents RowMajor m diff --git a/src/Graphics/Rendering/Handa/Viewer.hs b/src/Graphics/Rendering/Handa/Viewer.hs --- a/src/Graphics/Rendering/Handa/Viewer.hs +++ b/src/Graphics/Rendering/Handa/Viewer.hs @@ -32,21 +32,25 @@ , reshape , loadViewer , dlpViewerDisplay +, dlpViewerDisplay' ) where import Data.AdditiveGroup (AdditiveGroup) +import Data.AffineSpace ((.+^)) import Data.Aeson (FromJSON) -import Data.Binary (Binary(..)) +import Data.Binary (Binary) import Data.Data (Data) +import Data.VectorSpace ((*^)) import Data.Default (Default, def) +import Data.IORef (IORef) import Foreign.Storable (Storable) import GHC.Generics (Generic) import Graphics.Rendering.DLP (DlpEncoding, DlpEye(..)) import Graphics.Rendering.DLP.Callbacks (DlpDisplay(..)) -import Graphics.Rendering.Handa.Projection (Screen(..), aspectRatio, projection, throwRatio) +import Graphics.Rendering.Handa.Projection (OffAxisProjection(VTKOffAxis), Screen(..), aspectRatio, projection, throwRatio) import Graphics.Rendering.Handa.Util (degree) -import Graphics.Rendering.OpenGL (GLdouble, MatrixComponent, MatrixMode(..), Position(..), Vector3(..), Vertex3(..), ($=!), loadIdentity, lookAt, matrixMode, scale, viewport) +import Graphics.Rendering.OpenGL (GLdouble, MatrixComponent, MatrixMode(..), Position(..), Vector3(..), Vertex3(..), ($=!), get, loadIdentity, lookAt, matrixMode, scale, viewport) import Graphics.Rendering.OpenGL.GL.Tensor.Instances () import Graphics.UI.GLUT (DisplayCallback, ReshapeCallback) @@ -93,11 +97,11 @@ } , nearPlane = 0.1 , farPlane = 100 - , eyePosition = Vertex3 0 0 1 - , eyeSeparation = Vector3 0.2 0 0 - , eyeUpward = Vector3 0 1 0 - , sceneCenter = Vertex3 0 0 0 - , sceneScale = Vector3 1 1 1 + , eyePosition = Vertex3 0 0 1 + , eyeSeparation = Vector3 0.02 0 0 + , eyeUpward = Vector3 0 1 0 + , sceneCenter = Vertex3 0 0 0 + , sceneScale = Vector3 1 1 1 } @@ -118,7 +122,7 @@ , upperLeft = Vertex3 (- 1 / 2) ( height / width / 2) 0 } , eyePosition = Vertex3 0 0 (throw / width) - , sceneScale = Vector3 1 (height / width) 1 + , sceneScale = 0.5 *^ Vector3 1 (height / width) 1 } @@ -172,42 +176,70 @@ viewport $=! (Position 0 0, wh) matrixMode $=! Projection loadIdentity - projection screen eyePosition nearPlane farPlane + projection VTKOffAxis screen eyePosition nearPlane farPlane matrixMode $=! Modelview 0 -- | Create an action look at the scene according to the viewer parameters. -loadViewer :: (RealFloat a, Storable a) - => ViewerParameters a -- ^ The viewer parameters. +loadViewer :: (AdditiveGroup a, MatrixComponent a, RealFloat a, Storable a) + => Bool -- ^ Whether to use an on-axis projection. + -> ViewerParameters a -- ^ The viewer parameters. -> DlpEye -- ^ The eye from which to view. -> IO () -- ^ An action for looking at the scene using the specified eye and viewer parameters. -loadViewer ViewerParameters{..} eye = - do - let - offset = - case eye of - LeftDlp -> -0.5 - RightDlp -> 0.5 - Vertex3 xEye yEye zEye = eyePosition - Vector3 dxEye dyEye dzEye = eyeSeparation - Vector3 sx sy sz = realToFrac <$> sceneScale :: Vector3 GLdouble - loadIdentity - scale sx sy sz - lookAt - (realToFrac <$> Vertex3 (xEye + offset * dxEye) (yEye + offset * dyEye) (zEye + offset * dzEye)) - (realToFrac <$> sceneCenter) - (realToFrac <$> eyeUpward) +loadViewer onAxis ViewerParameters{..} eye = + let + offset = + case eye of + LeftDlp -> -0.5 + RightDlp -> 0.5 + eyePosition' = eyePosition .+^ offset *^ eyeSeparation + Vector3 sx sy sz = realToFrac <$> sceneScale :: Vector3 GLdouble + in + if onAxis + then do + loadIdentity + lookAt + (realToFrac <$> eyePosition') + (realToFrac <$> sceneCenter) + (realToFrac <$> eyeUpward) + scale sx sy sz + else do + matrixMode $=! Projection + loadIdentity + projection VTKOffAxis screen eyePosition' nearPlane farPlane + matrixMode $=! Modelview 0 + loadIdentity + scale sx sy sz -- | Construct a DLP display from a display callback. -dlpViewerDisplay :: (RealFloat a, Storable a) - => DlpEncoding -- ^ The DLP encoding. +dlpViewerDisplay :: (AdditiveGroup a, MatrixComponent a, RealFloat a, Storable a) + => Bool -- ^ Whether to use on-axis projection. + -> DlpEncoding -- ^ The DLP encoding. -> ViewerParameters a -- ^ The viewer parameters. -> DisplayCallback -- ^ The display callback. -> DlpDisplay -- ^ The DLP display data for using the specified encoding, viewer parameters, and display callback. -dlpViewerDisplay encoding viewerParameters display = +dlpViewerDisplay onAxis encoding viewerParameters display = def { dlpEncoding = encoding - , doDisplay = \eye -> loadViewer viewerParameters eye >> display + , doDisplay = \eye -> loadViewer onAxis viewerParameters eye >> display + } + + +-- | Construct a DLP display from a display callback. +dlpViewerDisplay' :: (AdditiveGroup a, MatrixComponent a, RealFloat a, Storable a) + => Bool -- ^ Whether to use on-axis projection. + -> DlpEncoding -- ^ The DLP encoding. + -> IORef (ViewerParameters a) -- ^ A reference to the viewer parameters. + -> DisplayCallback -- ^ The display callback. + -> DlpDisplay -- ^ The DLP display data for using the specified encoding, viewer parameters, and display callback. +dlpViewerDisplay' onAxis encoding viewerParameters display = + def + { + dlpEncoding = encoding + , doDisplay = \eye -> do + viewerParameters' <- get viewerParameters + loadViewer onAxis viewerParameters' eye + display }