opengl-dlp-stereo 0.1.4.1 → 0.1.5.2
raw patch · 4 files changed
+85/−46 lines, 4 filesdep ~GLUTdep ~OpenGLdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: GLUT, OpenGL, base, vector
API changes (from Hackage documentation)
+ Graphics.Rendering.DLP: QuadBuffer :: DlpEncoding
Files
- opengl-dlp-stereo.cabal +8/−6
- src/Graphics/Rendering/DLP.hs +19/−15
- src/Graphics/Rendering/DLP/Callbacks.hs +52/−21
- src/Main.hs +6/−4
opengl-dlp-stereo.cabal view
@@ -1,5 +1,5 @@ name: opengl-dlp-stereo-version: 0.1.4.1+version: 0.1.5.2 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@. This package also works with VR systems such as Google Cardboard \<<https://www.google.com/get/cardboard/>\>. @@ -14,7 +14,7 @@ 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.4.1.tar.gz+package-url: https://bitbucket.org/bwbush/opengl-dlp-stereo/downloads/opengl-dlp-stereo-0.1.5.2.tar.gz extra-source-files: ReadMe.md @@ -25,12 +25,13 @@ library exposed-modules: Graphics.Rendering.DLP Graphics.Rendering.DLP.Callbacks- build-depends: base >= 4.6 && < 5+ build-depends: base >= 4.8.1 && < 5 , data-default >= 0.5.3- , GLUT >= 2.4- , OpenGL >= 2.8- , vector >= 0.10+ , GLUT >= 2.7.0.1+ , OpenGL >= 2.12.0.1+ , vector >= 0.11 hs-source-dirs: src+ ghc-options: -Wall default-language: Haskell2010 executable opengl-dlp-test@@ -41,4 +42,5 @@ , OpenGL , vector hs-source-dirs: src+ ghc-options: -Wall default-language: Haskell2010
src/Graphics/Rendering/DLP.hs view
@@ -65,7 +65,6 @@ ) where -import Control.Applicative ((<$>)) import Control.Monad (unless, when) import Data.Bits ((.|.)) import Data.IORef (IORef, newIORef)@@ -77,11 +76,12 @@ -- | 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.+ | QuadBuffer -- ^ Instead of DLP, use a quad buffer stereo. deriving (Eq, Read, Show) @@ -102,13 +102,15 @@ -- | 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.- -> DlpState -- ^ The current DLP state.- -> Bool -- ^ Whether the view of the specified eye should be shown for the current frame.+showEye :: DlpEye -- ^ The eye in question.+ -> DlpState -- ^ The current DLP state.+ -> Bool -- ^ Whether the view of the specified eye should be shown for the current frame. 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 LeftDlp (DlpState QuadBuffer frame) = frame `mod` 2 == 0+showEye RightDlp (DlpState QuadBuffer frame) = frame `mod` 2 /= 0 showEye _ _ = True @@ -149,22 +151,24 @@ -- | Color constants.-red, green, blue, cyan, magenta, yellow :: Word32+red, green, blue, cyan, magenta, yellow, clear :: Word32 red = 0x00FF0000 green = 0x0000FF00 blue = 0x000000FF cyan = green .|. blue magenta = red .|. blue yellow = red .|. green+clear = 0xFF000000 -- | Determine the correct color of the reference line for a given DLP encoding and DLP state. 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.+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.+dlpColor (DlpState QuadBuffer _ ) = clear -- | Determine the correct color of the reference line for a given DLP encoding and DLP state.
src/Graphics/Rendering/DLP/Callbacks.hs view
@@ -44,8 +44,9 @@ 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 Data.IORef (IORef)+import Graphics.Rendering.DLP (DlpEncoding(FrameSequential, QuadBuffer), DlpEye(..), DlpState, drawDlp, initDlp, showEye, whichView)+import Graphics.Rendering.OpenGL (BufferMode(BackLeftBuffer, BackRightBuffer), ClearBuffer(..), SettableStateVar, ($=!), clear, drawBuffer, get, makeSettableStateVar, viewport) import Graphics.UI.GLUT (DisplayCallback, displayCallback, swapBuffers) @@ -81,25 +82,55 @@ makeSettableStateVar setDlpDisplayCallback where setDlpDisplayCallback :: DlpDisplay -> IO ()- setDlpDisplayCallback DlpDisplay{..} =+ setDlpDisplayCallback dlpDisplay@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+ case dlpEncoding of+ QuadBuffer -> doQuad dlpRef dlpDisplay+ _ -> doDlp dlpRef dlpDisplay+++-- | Make a display callback for DLP.+doDlp :: IORef DlpState -- ^ A reference to the DLP state.+ -> DlpDisplay -- ^ The display information.+ -> DisplayCallback -- ^ The display callback.+doDlp dlpRef DlpDisplay{..} =+ 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+++-- | Make a display callback for quad buffer stereo.+doQuad :: IORef DlpState -- ^ A reference to the DLP state.+ -> DlpDisplay -- ^ The display information.+ -> DisplayCallback -- ^ The display callback.+doQuad dlpRef DlpDisplay{..} =+ do+ sequence_+ [+ do+ drawBuffer $=! buffer+ preDisplay+ doDisplay eye+ postDisplay+ drawDlp dlpRef+ |+ (eye, buffer) <- zip [LeftDlp, RightDlp] [BackLeftBuffer, BackRightBuffer]+ ]+ swapBuffers
src/Main.hs view
@@ -33,16 +33,18 @@ 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."+ putStrLn " Use the --quadbuffer flag to run in quad buffer stereo mode." (_, arguments) <- getArgsAndInitialize- initialDisplayMode $=! [WithDepthBuffer, DoubleBuffered]+ initialDisplayMode $=! (if "--quadbuffer" `elem` arguments then (Stereoscopic :) else id) [WithDepthBuffer, DoubleBuffered] _ <- createWindow "DLP Stereo OpenGL Example" depthFunc $=! Just Less when ("--fullscreen" `elem` arguments) fullScreen angle <- newIORef 0 let encoding- | "--mono" `elem` arguments = LeftOnly- | "--cardboard" `elem` arguments = SideBySide- | otherwise = FrameSequential+ | "--quadbuffer" `elem` arguments = QuadBuffer+ | "--mono" `elem` arguments = LeftOnly+ | "--cardboard" `elem` arguments = SideBySide+ | otherwise = FrameSequential dlpDisplayCallback $=! def {dlpEncoding = encoding, doDisplay = display angle} idleCallback $=! Just (idle angle) mainLoop