handa-opengl 0.1.11.2 → 0.1.12.1

raw patch · 3 files changed

+144/−47 lines, 3 filesdep +splitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: split

API changes (from Hackage documentation)

Files

• handa-opengl.cabal +3/−2
• src/Graphics/Rendering/Handa/Projection.hs +77/−13
• src/Graphics/Rendering/Handa/Viewer.hs +64/−32

@@ -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

@@ -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 \<<http://csc.lsu.edu/~kooima/pdfs/gen-perspective.pdf>\> .+-- | The equations to use for off-axis projection.+data OffAxisProjection =+    KooimaOffAxis -- ^ Based on Kooima 2009, \<<http://csc.lsu.edu/~kooima/pdfs/gen-perspective.pdf>\>, which assumes a rectangular screen.+  | VTKOffAxis    -- ^ Based on VTK 6.3.0, \<<https://gitlab.kitware.com/vtk/vtk/blob/v6.3.0/Rendering/Core/vtkCamera.cxx#L414>\>, 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, \<<http://csc.lsu.edu/~kooima/pdfs/gen-perspective.pdf>\>, 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, \<<https://gitlab.kitware.com/vtk/vtk/blob/v6.3.0/Rendering/Core/vtkCamera.cxx#L414>\>, 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

@@ -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     }