opengl-dlp-stereo 0.1.2.6 → 0.1.4.1

raw patch · 5 files changed

+218/−95 lines, 5 filesdep +data-defaultdep ~GLUTdep ~OpenGLdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default

Dependency ranges changed: GLUT, OpenGL, base, vector

API changes (from Hackage documentation)

Files

• ReadMe.md +12/−15
• opengl-dlp-stereo.cabal +15/−11
• src/Graphics/Rendering/DLP.hs +67/−48
• src/Graphics/Rendering/DLP/Callbacks.hs +105/−0
• src/Main.hs +19/−21

@@ -5,7 +5,9 @@  The code conforms to the specification <<http://lists.gnu.org/archive/html/bino-list/2013-03/pdfz6rW7jUrgI.pdf>> and is based on the implementation for the stereo movie viewer Bino <<http://git.savannah.gnu.org/cgit/bino.git/tree/src/video_output.cpp?id=bino-1.6.1#n1389>>. +Please report issues at <<https://bwbush.atlassian.net/projects/HOGLDLP/issues/>>. + Skeletal example illustrating the use of frame-sequential DLP ------------------------------------------------------------- @@ -14,24 +16,19 @@ main = do   _ <- getArgsAndInitialize   initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]-  _ <- createWindow "DLP Stereo OpenGL Example"+  _ <- createWindow \"DLP Stereo OpenGL Example\"   depthFunc $= Just Less -  dlp <- initDlp                                                         -- Initialize the DLP state.-  displayCallback $= display dlp                                         -- The display callback needs the DLP state.-  idleCallback $= Just (postRedisplay Nothing)                           -- The idle callback must force redisplay for frame-sequential encoding.+  idleCallback $= Just (postRedisplay Nothing)+  -- Use frame-sequential DLP encoding.+  dlpDisplayCallback $= def {dlpEncoding = FrameSequential, doDisplay = display}   mainLoop -encoding :: DlpEncoding-encoding = FrameSequential                                               -- Frame-sequential encoding is usually easiest to code.--display :: IORef DlpState -> DisplayCallback-display dlp = do-  clear [ColorBuffer, DepthBuffer]-  isLeftEye <- showEye' LeftDlp encoding dlp                             -- Determine whether to draw the view for the left or right eye.-  translate $ Vector3 (if isLeftEye then -0.05 else 0.05 :: GLfloat) 0 0 -- Shift the view slightly, depending on for which eye to draw.-  renderPrimitive . . .                                                  -- All of the rendering actions go here.-  drawDlp encoding dlp                                                   -- Draw the colored DLP reference line just before swapping framebuffers.-  swapBuffers+display :: DlpDisplayCallback+display eye = do+  -- Shift the view slightly, depending on for which eye to draw.+  translate $ Vector3 (if eye == LeftDlp then -0.05 else 0.05 :: GLfloat) 0 0 +  -- All of the rendering actions go here.+  renderPrimitive . . . ```  

@@ -1,7 +1,7 @@ name:                opengl-dlp-stereo-version:             0.1.2.6+version:             0.1.4.1 synopsis:            Library and example for using DLP stereo in OpenGL-description:         This package contains functions for rendering 3D stereo using DLP 3-D Ready Sync projectors and active-shutter stereo glasses.  It also includes a sample application (see \<<https://youtu.be/l3rZbMB2XjM>\>) and notes regarding hardware setup for DLP.  In particular, note that this technique does not require a graphics card that supports @GL_STEREO@.+description:         This package contains functions for rendering 3D stereo using DLP 3-D Ready Sync projectors and active-shutter stereo glasses.  It also includes a sample application (see \<<https://youtu.be/l3rZbMB2XjM>\>) and notes regarding hardware setup for DLP.  In particular, note that this technique does not require a graphics card that supports @GL_STEREO@.  This package also works with VR systems such as Google Cardboard \<<https://www.google.com/get/cardboard/>\>.  license:             MIT license-file:        LICENSE@@ -10,11 +10,11 @@ copyright:           (c) 2015 Brian W Bush category:            Graphics build-type:          Simple-cabal-version:       >=1.10+cabal-version:       >= 1.10 stability:           Stable homepage:            https://bitbucket.org/bwbush/opengl-dlp-stereo bug-reports:         https://bwbush.atlassian.net/projects/HOGLDLP/issues/-package-url:         https://bitbucket.org/bwbush/opengl-dlp-stereo/downloads/opengl-dlp-stereo-0.1.2.6.tar.gz+package-url:         https://bitbucket.org/bwbush/opengl-dlp-stereo/downloads/opengl-dlp-stereo-0.1.4.1.tar.gz  extra-source-files:  ReadMe.md @@ -24,17 +24,21 @@   library   exposed-modules:  Graphics.Rendering.DLP-  build-depends:    base   >=  4.6 && < 5-               ,    OpenGL >=  2.8-               ,    vector >= 0.10+                    Graphics.Rendering.DLP.Callbacks+  build-depends:    base         >= 4.6 && < 5+               ,    data-default >= 0.5.3+               ,    GLUT         >= 2.4+               ,    OpenGL       >= 2.8+               ,    vector       >= 0.10   hs-source-dirs:   src   default-language: Haskell2010  executable opengl-dlp-test   main-is:          Main.hs-  build-depends:    base   >=  4.6 && < 5-               ,    GLUT   >=  2.4-               ,    OpenGL >=  2.8-               ,    vector >= 0.10+  build-depends:    base+               ,    data-default+               ,    GLUT+               ,    OpenGL+               ,    vector   hs-source-dirs:   src   default-language: Haskell2010

@@ -8,7 +8,7 @@  Functions for using DLP stereo with 3-D Ready Sync projectors and OpenGL.  This uses the specification \<<http://lists.gnu.org/archive/html/bino-list/2013-03/pdfz6rW7jUrgI.pdf>\> and is based on the implementation for the stereo movie viewer Bino \<<http://git.savannah.gnu.org/cgit/bino.git/tree/src/video_output.cpp?id=bino-1.6.1#n1389>\>.  In particular, note that this technique does not require a graphics card that supports @GL_STEREO@. -Here is a skeletal example illustrating the use of frame-sequential DLP:+Below is a skeletal example illustrating the use of frame-sequential DLP.  See "Graphics.Rendering.DLP.Callbacks" for a simpler example that uses callbacks.  @ main :: IO ()@@ -17,21 +17,18 @@   initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]   _ <- createWindow \"DLP Stereo OpenGL Example\"   depthFunc $= Just Less -  dlp <- initDlp                                                         -- Initialize the DLP state.+  dlp <- initDlp FrameSequential                                         -- Initialize the DLP state.   displayCallback $= display dlp                                         -- The display callback needs the DLP state.   idleCallback $= Just (postRedisplay Nothing)                           -- The idle callback must force redisplay for frame-sequential encoding.   mainLoop -encoding :: DlpEncoding-encoding = FrameSequential                                               -- Frame-sequential encoding is usually easiest to code.- display :: IORef DlpState -> DisplayCallback display dlp = do   clear [ColorBuffer, DepthBuffer]-  isLeftEye <- showEye' LeftDlp encoding dlp                             -- Determine whether to draw the view for the left or right eye.+  isLeftEye <- showEye' LeftDlp dlp                                      -- Determine whether to draw the view for the left or right eye.   translate $ Vector3 (if isLeftEye then -0.05 else 0.05 :: GLfloat) 0 0 -- Shift the view slightly, depending on for which eye to draw.   renderPrimitive . . .                                                  -- All of the rendering actions go here.-  drawDlp encoding dlp                                                   -- Draw the colored DLP reference line just before swapping framebuffers.+  drawDlp dlp                                                            -- Draw the colored DLP reference line just before swapping framebuffers.   swapBuffers @ @@ -63,11 +60,13 @@ , DlpEye(..) , showEye , showEye'+, whichView+, whichView' ) where   import Control.Applicative ((<$>))-import Control.Monad (when)+import Control.Monad (unless, when) import Data.Bits ((.|.)) import Data.IORef (IORef, newIORef) import Data.Word (Word32)@@ -78,11 +77,11 @@  -- | The type of DLP encoding.  See the specification \<<http://lists.gnu.org/archive/html/bino-list/2013-03/pdfz6rW7jUrgI.pdf>\> for further details. data DlpEncoding =-    SideBySide      -- ^ Side-by-side encoding, where the left image is stored to the left of the right image in the framebuffer.-  | FrameSequential -- ^ Frame-sequential encoding, where left and right images alternate, each filling the whole framebuffer.-  | TopAndBottom    -- ^ Top-and-bottom encoding, where the top image is stored above the bottom image in the framebuffer.-  | LeftOnly        -- ^ Monoscopic with only the left eye's view.-  | RightOnly       -- ^ Monoscopic with only the right eye's view.+    SideBySide       -- ^ Side-by-side encoding, where the left image is stored to the left of the right image in the framebuffer.+  | FrameSequential  -- ^ Frame-sequential encoding, where left and right images alternate, each filling the whole framebuffer.+  | TopAndBottom     -- ^ Top-and-bottom encoding, where the top image is stored above the bottom image in the framebuffer.+  | LeftOnly         -- ^ Monoscopic with only the left eye's view.+  | RightOnly        -- ^ Monoscopic with only the right eye's view.   deriving (Eq, Read, Show)  @@ -94,38 +93,59 @@   -- | The DLP state, which tracks the sequence of frames.-newtype DlpState = DlpState {unDlpState :: Int}+data DlpState = DlpState DlpEncoding Int   -- | Initialize the DLP state.-initDlp :: IO (IORef DlpState)-initDlp = newIORef $ DlpState 0+initDlp :: DlpEncoding -> IO (IORef DlpState)+initDlp encoding = newIORef $ DlpState encoding 0   -- | Query whether to show the view from the specified eye for the current frame.  Client code should call this function to determine which views to draw into the framebuffer. showEye :: DlpEye      -- ^ The eye in question.-        -> DlpEncoding -- ^ The DLP encoding.         -> DlpState    -- ^ The current DLP state.         -> Bool        -- ^ Whether the view of the specified eye should be shown for the current frame.-showEye LeftDlp  FrameSequential = (== 0) . (`mod` 2) . unDlpState-showEye RightDlp FrameSequential = (/= 0) . (`mod` 2) . unDlpState-showEye RightDlp LeftOnly        = const False-showEye LeftDlp  RightOnly       = const False-showEye _        _               = const True+showEye LeftDlp  (DlpState FrameSequential  frame) = frame `mod` 2 == 0+showEye RightDlp (DlpState FrameSequential  frame) = frame `mod` 2 /= 0+showEye RightDlp (DlpState LeftOnly         _    ) = False+showEye LeftDlp  (DlpState RightOnly        _    ) = False+showEye _        _                                 = True   -- | Query whether to show the view from the specified eye for the current frame.  Client code should call this function to determine which views to draw into the framebuffer. showEye' :: DlpEye         -- ^ The eye in question.-         -> DlpEncoding    -- ^ The DLP encoding.          -> IORef DlpState -- ^ A reference to the current DLP state.          -> IO Bool        -- ^ An action for determining whether the view of the specified eye should be shown for the current frame.-showEye' eye encoding = (showEye eye encoding <$>) . get+showEye' eye = (showEye eye <$>) . get  +-- | Compute the viewport for the specified eye, given a DLP state.+whichView :: DlpEye              -- ^ The eye in question.+          -> DlpState            -- ^ The current DLP state.+          -> IO (Position, Size) -- ^ An action for computing the viewport for the eye.+whichView eye (DlpState SideBySide _) =+  do+    (Position x0 y0, Size w h) <- get viewport+    return (Position (if eye == LeftDlp then x0 else x0 + w `div` 2) y0, Size (w - w `div` 2) h)+whichView eye (DlpState TopAndBottom _) =+  do+    (Position x0 y0, Size w h) <- get viewport+    return (Position x0 (if eye == LeftDlp then y0 else y0 + h `div` 2), Size w (h - h `div` 2))+whichView _ _ = get viewport+++-- | Compute the viewport for the specified eye, given a DLP state.+whichView' :: DlpEye              -- ^ The eye in question.+           -> IORef DlpState      -- ^ A reference to the current DLP state.+           -> IO (Position, Size) -- ^ An actino for computing the viewport for the eye.+whichView' eye = (whichView eye =<<) . get++ -- | Advance the DLP state one frame. advanceDlp :: IORef DlpState -- ^ A reference to the current DLP state.            -> IO ()          -- ^ An action to advance the DLP state to the next frame.-advanceDlp = ($~! (DlpState . (`mod` 4) . (+ 1) . unDlpState))+advanceDlp dlp =+  dlp $~! \(DlpState encoding frame) -> DlpState encoding $ (frame + 1) `mod` 4   -- | Color constants.@@ -139,35 +159,34 @@   -- | Determine the correct color of the reference line for a given DLP encoding and DLP state.-dlpColor :: DlpEncoding -> DlpState -> Word32-dlpColor SideBySide      (DlpState state) = if state `mod` 2 == 0 then red   else cyan-dlpColor FrameSequential (DlpState state) = if state `mod` 4 <  2 then green else magenta-dlpColor TopAndBottom    (DlpState state) = if state `mod` 2 == 0 then blue  else yellow-dlpColor LeftOnly        _                = undefined -- Safe because drawDlp never calls the function for this DLP mode.-dlpColor RightOnly       _                = undefined -- Safe because drawDlp never acalls te function for this DLP mode.+dlpColor :: DlpState -> Word32+dlpColor (DlpState SideBySide       frame) = if frame `mod` 2 == 0 then red   else cyan+dlpColor (DlpState FrameSequential  frame) = if frame `mod` 4 <  2 then green else magenta+dlpColor (DlpState TopAndBottom     frame) = if frame `mod` 2 == 0 then blue  else yellow+dlpColor (DlpState LeftOnly         _    ) = undefined -- Safe because drawDlp never calls the function for this DLP mode.+dlpColor (DlpState RightOnly        _    ) = undefined -- Safe because drawDlp never acalls te function for this DLP mode.   -- | Determine the correct color of the reference line for a given DLP encoding and DLP state.-dlpColor' :: DlpEncoding -> IORef DlpState -> IO Word32-dlpColor' encoding = (dlpColor encoding <$>) . get+dlpColor' :: IORef DlpState -> IO Word32+dlpColor' = (dlpColor <$>) . get   -- | Draw the DLP reference line.  This action should be executed after all other drawing is complete, just before buffers are swapped.-drawDlp :: DlpEncoding    -- ^ The DLP encoding.-        -> IORef DlpState -- ^ A reference to the current DLP state.+drawDlp :: IORef DlpState -- ^ A reference to the current DLP state.         -> IO ()          -- ^ An action to draw the DLP reference line.-drawDlp LeftOnly  _     = return ()-drawDlp RightOnly _     = return ()-drawDlp encoding  state =+drawDlp dlp =   do-    (Position x0 y0, Size w h) <- get viewport-    color <- dlpColor' encoding state-    let-      pixels = V.fromList $ replicate (fromIntegral w) color-      drawLine = V.unsafeWith pixels $ drawPixels (Size w 1) . PixelData BGRA UnsignedInt8888Rev-    windowPos $ Vertex2 x0 y0-    drawLine-    when (encoding == TopAndBottom) $ do-      windowPos $ Vertex2 x0 $ y0 + h `div` 2+    DlpState encoding _ <- get dlp+    unless (encoding `elem` [LeftOnly, RightOnly]) $ do+      (Position x0 y0, Size w h) <- get viewport+      color <- dlpColor' dlp+      let+        pixels = V.fromList $ replicate (fromIntegral w) color+        drawLine = V.unsafeWith pixels $ drawPixels (Size w 1) . PixelData BGRA UnsignedInt8888Rev+      windowPos $ Vertex2 x0 y0       drawLine-    advanceDlp state+      when (encoding == TopAndBottom) $ do+        windowPos $ Vertex2 x0 $ y0 + h `div` 2+        drawLine+    advanceDlp dlp

@@ -0,0 +1,105 @@+{-|+Module      :  Graphics.Rendering.DLP.Callbacks+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++A simple callback for using DLP stereo with 3-D Ready Sync projectors and OpenGL.  See "Graphics.Rendering.DLP" for more primitive functions for using DLP and for notes on DLP specifications and hardware.++Here is a skeletal example illustrating the use of frame-sequential DLP:++@+main :: IO ()+main = do+  _ <- getArgsAndInitialize+  initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+  _ <- createWindow \"DLP Stereo OpenGL Example\"+  depthFunc $= Just Less +  idleCallback $= Just (postRedisplay Nothing)+  -- Use frame-sequential DLP encoding.+  dlpDisplayCallback $= def {dlpEncoding = FrameSequential, doDisplay = display}+  mainLoop++display :: DlpDisplayCallback+display eye = do+  -- Shift the view slightly, depending on for which eye to draw.+  translate $ Vector3 (if eye == LeftDlp then -0.05 else 0.05 :: GLfloat) 0 0 +  -- All of the rendering actions go here.+  renderPrimitive . . .+@+-}+++{-# LANGUAGE RecordWildCards #-}+++module Graphics.Rendering.DLP.Callbacks (+  -- * Callbacks+  DlpDisplay(..)+, DlpDisplayCallback+, dlpDisplayCallback+) where+++import Data.Default (Default(..))+import Graphics.Rendering.DLP (DlpEncoding(FrameSequential), DlpEye(..), drawDlp, initDlp, showEye, whichView)+import Graphics.Rendering.OpenGL (ClearBuffer(..), SettableStateVar, ($=!), clear, get, makeSettableStateVar, viewport)+import Graphics.UI.GLUT (DisplayCallback, displayCallback, swapBuffers)+++-- | The type of DLP encoding and the actions associated with the display callback.+data DlpDisplay =+  DlpDisplay+  {+    dlpEncoding :: DlpEncoding        -- ^ The DLP encoding.  The default is frame-sequential DLP encoding.+  , preDisplay  :: DisplayCallback    -- ^ The display action to perform before the views from the eye(s) are displayed.  The default is to clear the color and depth buffers.+  , doDisplay   :: DlpDisplayCallback -- ^ The action for displaying the view from an eye.  The default is to do nothing.+  , postDisplay :: DisplayCallback    -- ^ The display action to perform after the views from the eye(s) are displayed.  The default is to do nothing.+  }++instance Default DlpDisplay where+  def =+    DlpDisplay+    {+      dlpEncoding = FrameSequential+    , preDisplay  = clear [ColorBuffer, DepthBuffer]+    , doDisplay   = const $ return ()+    , postDisplay = return ()+    }+++-- | A callback for displaying using DLP.+type DlpDisplayCallback =  DlpEye          -- ^ The eye to be displayed.+                        -> DisplayCallback -- ^ The action to display the view from the eye in question.+++-- | Set a DLP display callback.  Note that 'preDisplay' is executed first, then 'doDisplay' is executed to display the views for whichever eye(s) need displaying, and finally 'postDisplay' is executed before 'Graphics.UI.GLUT.swapBuffers' is executed.  The viewport is adjusted appropriately each time before `doDisplay' is executed.+dlpDisplayCallback :: SettableStateVar DlpDisplay+dlpDisplayCallback =+  makeSettableStateVar setDlpDisplayCallback+    where+      setDlpDisplayCallback :: DlpDisplay -> IO ()+      setDlpDisplayCallback DlpDisplay{..} =+        do+          dlpRef <- initDlp dlpEncoding+          displayCallback $=!+            do+              vpSaved <- get viewport+              preDisplay+              dlp <- get dlpRef+              sequence_+                [+                  do+                    vp <- whichView eye dlp+                    viewport $=! vp+                    doDisplay eye+                    viewport $=! vpSaved+                |+                  eye <- [LeftDlp, RightDlp]+                , showEye eye dlp+                ]+              postDisplay+              drawDlp dlpRef+              swapBuffers

@@ -17,10 +17,12 @@   import Control.Monad (when)+import Data.Default (def) import Data.IORef (IORef, newIORef)-import Graphics.Rendering.DLP (DlpEncoding(..), DlpEye(..), DlpState, drawDlp, initDlp, showEye')-import Graphics.Rendering.OpenGL.GL (ClearBuffer(..), Color3(..), ComparisonFunction(Less), PrimitiveMode(..), Vector3(..), Vertex3(..), GLfloat, ($=), ($~!), clear, color, get, loadIdentity, preservingMatrix, renderPrimitive, rotate, translate, vertex)-import Graphics.UI.GLUT (DisplayCallback, DisplayMode(..), IdleCallback, createWindow, depthFunc, displayCallback, fullScreen, getArgsAndInitialize, idleCallback, initialDisplayMode, mainLoop, postRedisplay, swapBuffers)+import Graphics.Rendering.DLP (DlpEncoding(..), DlpEye(..))+import Graphics.Rendering.DLP.Callbacks (DlpDisplay(..), DlpDisplayCallback, dlpDisplayCallback)+import Graphics.Rendering.OpenGL.GL (Color3(..), ComparisonFunction(Less), PrimitiveMode(..), Vector3(..), Vertex3(..), GLfloat, ($=!), ($~!), color, get, loadIdentity, preservingMatrix, renderPrimitive, rotate, translate, vertex)+import Graphics.UI.GLUT (DisplayMode(..), IdleCallback, createWindow, depthFunc, fullScreen, getArgsAndInitialize, idleCallback, initialDisplayMode, mainLoop, postRedisplay)   -- | The main action.@@ -30,15 +32,19 @@     putStrLn "DLP Stereo OpenGL Example:"     putStrLn "    Use the --fullscreen flag to run in full screen mode."     putStrLn "    Use the --mono flag to run in monoscopic mode."+    putStrLn "    Use the --cardboard flag to run in side-by-side (Google Cardboard) mode."     (_, arguments) <- getArgsAndInitialize-    initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+    initialDisplayMode $=! [WithDepthBuffer, DoubleBuffered]     _ <- createWindow "DLP Stereo OpenGL Example"-    depthFunc $= Just Less +    depthFunc $=! Just Less      when ("--fullscreen" `elem` arguments) fullScreen-    dlp <- initDlp     angle <- newIORef 0-    displayCallback $= display ("--mono" `notElem` arguments) dlp angle-    idleCallback $= Just (idle angle)+    let encoding+          | "--mono"      `elem` arguments = LeftOnly+          | "--cardboard" `elem` arguments = SideBySide+          | otherwise                      = FrameSequential+    dlpDisplayCallback $=! def {dlpEncoding = encoding, doDisplay = display angle}+    idleCallback $=! Just (idle angle)     mainLoop  @@ -47,22 +53,17 @@ idle angle =   do     angle $~! (+ 0.1)-    -- The idle callback must force redisplay for frame-sequential encoding.     postRedisplay Nothing   -- | Draw rotating cubes.-display :: Bool -> IORef DlpState -> IORef GLfloat -> DisplayCallback-display stereo dlp angle =+display :: IORef GLfloat -> DlpDisplayCallback+display angle eye =   do-    -- Frame-sequential encoding is usually the easiest to use.-    let encoding = if stereo then FrameSequential else LeftOnly-    -- Determine whether to draw the view for the left of right eye.-    leftFrame <- showEye' LeftDlp encoding dlp     angle' <- get angle-    -- Compute how to shift the view, depending on for which eye to draw.-    let offset = if leftFrame then -0.05 else 0.05 :: GLfloat-    clear [ColorBuffer, DepthBuffer]+    let offset = case eye of+                   LeftDlp  ->  0.05 +                   RightDlp -> -0.05 :: GLfloat     loadIdentity     preservingMatrix $ do       translate $ Vector3 offset 0 0.5@@ -78,9 +79,6 @@       cube 0.25       color $ Color3 1 0.65 (0.5 :: GLfloat)       cubeFrame 0.25-    -- After all of the rendering actions, draw the colored DLP reference line just before swapping framebuffers.-    drawDlp encoding dlp-    swapBuffers   -- | Make a cube.  *Source:* \<<https://wiki.haskell.org/OpenGLTutorial2>\>.