diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Brian W Bush + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/ReadMe.md b/ReadMe.md new file mode 100644 --- /dev/null +++ b/ReadMe.md @@ -0,0 +1,49 @@ +Functions for using DLP stereo with 3-D Ready Sync projectors and OpenGL +======================================================================== + +This Haskell 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](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`. + +The code conforms to the specification <> and is based on the implementation for the stereo movie viewer Bino <>. + + +Skeletal example illustrating the use of frame-sequential DLP +------------------------------------------------------------- + +```haskell +main :: IO () +main = do + _ <- getArgsAndInitialize + initialDisplayMode $= [WithDepthBuffer, DoubleBuffered] + _ <- 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. + 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 +``` + + +Notes on hardware and software +------------------------------ + +This code has been validated with the following configuration of hardware and software: + +* Optoma ML550 WXGA 500 Lumen 3D Ready Portable DLP LED Projector, running 120 Hz at 1024x768 resolution +* Optoma ZD302 DLP Link Active Shutter 3D Glasses +* Ubuntu 15.04, 64-bit +* NVIDIA Driver Version 340.93, with `xorg.conf` option `Stereo` set to `8` +* GHC 7.6.3 +* OpenGL == 2.8.0.0 +* GLUT == 2.4.0.0 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/opengl-dlp-stereo.cabal b/opengl-dlp-stereo.cabal new file mode 100644 --- /dev/null +++ b/opengl-dlp-stereo.cabal @@ -0,0 +1,40 @@ +name: opengl-dlp-stereo +version: 0.1.2.5 +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 \<\>) and notes regarding hardware setup for DLP. In particular, note that this technique does not require a graphics card that supports @GL_STEREO@. + +license: MIT +license-file: LICENSE +author: Brian W Bush +maintainer: Brian W Bush +copyright: (c) 2015 Brian W Bush +category: Graphics +build-type: Simple +cabal-version: >=1.10 +stability: Stable +homepage: https://bitbucket.org/bwbush/opengl-dlp-stereo +bug-reports: https://bitbucket.org/bwbush/opengl-dlp-stereo/issues +package-url: https://bitbucket.org/bwbush/opengl-dlp-stereo/downloads/opengl-dlp-stereo-0.1.2.5.tar.gz + +extra-source-files: ReadMe.md + +source-repository head + type: git + location: https://bwbush@bitbucket.org/bwbush/opengl-dlp-stereo.git + +library + exposed-modules: Graphics.Rendering.DLP + build-depends: base >= 4.6 && < 5 + , 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 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Graphics/Rendering/DLP.hs b/src/Graphics/Rendering/DLP.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/DLP.hs @@ -0,0 +1,173 @@ +{-| +Module : Graphics.Rendering.DLP +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Functions for using DLP stereo with 3-D Ready Sync projectors and OpenGL. This uses the specification \<\> and is based on the implementation for the stereo movie viewer Bino \<\>. 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: + +@ +main :: IO () +main = do + _ <- getArgsAndInitialize + initialDisplayMode $= [WithDepthBuffer, DoubleBuffered] + _ <- 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. + 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 +@ + +This code has been validated with the following configuration of hardware and software: + +* Optoma ML550 WXGA 500 Lumen 3D Ready Portable DLP LED Projector, running 120 Hz at 1024x768 resolution + +* Optoma ZD302 DLP Link Active Shutter 3D Glasses + +* Ubuntu 15.04, 64-bit + +* NVIDIA Driver Version 340.93, with @xorg.conf@ option @Stereo@ set to @8@ + +* GHC 7.6.3 + +* OpenGL == 2.8.0.0 + +* GLUT == 2.4.0.0 +-} + + +module Graphics.Rendering.DLP ( +-- * DLP State and Encoding + DlpEncoding(..) +, DlpState +, initDlp +, drawDlp +-- * Active Frame(s) +, DlpEye(..) +, showEye +, showEye' +) where + + +import Control.Applicative ((<$>)) +import Control.Monad (when) +import Data.Bits ((.|.)) +import Data.IORef (IORef, newIORef) +import Data.Word (Word32) +import Graphics.Rendering.OpenGL.GL (DataType(UnsignedInt8888Rev), PixelData(..), PixelFormat(BGRA), Position(..), Size(..), Vertex2(..), ($~!), drawPixels, get, viewport, windowPos) + +import qualified Data.Vector.Storable as V (fromList, unsafeWith) + + +-- | The type of DLP encoding. See the specification \<\> 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. + deriving (Eq, Read, Show) + + +-- | Labels for the left and right eyes' views. +data DlpEye = + LeftDlp -- ^ The left eye's view. + | RightDlp -- ^ The right eye's view. + deriving (Eq, Read, Show) + + +-- | The DLP state, which tracks the sequence of frames. +newtype DlpState = DlpState {unDlpState :: Int} + + +-- | Initialize the DLP state. +initDlp :: IO (IORef DlpState) +initDlp = newIORef $ DlpState 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 + + +-- | 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 + + +-- | 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)) + + +-- | Color constants. +red, green, blue, cyan, magenta, yellow :: Word32 +red = 0x00FF0000 +green = 0x0000FF00 +blue = 0x000000FF +cyan = green .|. blue +magenta = red .|. blue +yellow = red .|. green + + +-- | 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. + + +-- | 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 + + +-- | 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. + -> IO () -- ^ An action to draw the DLP reference line. +drawDlp LeftOnly _ = return () +drawDlp RightOnly _ = return () +drawDlp encoding state = + 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 + drawLine + advanceDlp state diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,124 @@ +{-| +Module : Main +Copyright : (c) 2015 Brian W Bush +License : MIT +Maintainer : Brian W Bush +Stability : Stable +Portability : Portable + +Example application illustrating frame-sequential DLP. +-} + + +module Main ( +-- * Entry Point + main +) where + + +import Control.Monad (when) +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) + + +-- | The main action. +main :: IO () +main = + do + 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." + (_, arguments) <- getArgsAndInitialize + initialDisplayMode $= [WithDepthBuffer, DoubleBuffered] + _ <- createWindow "DLP Stereo OpenGL Example" + depthFunc $= Just Less + when ("--fullscreen" `elem` arguments) fullScreen + dlp <- initDlp + angle <- newIORef 0 + displayCallback $= display ("--mono" `notElem` arguments) dlp angle + idleCallback $= Just (idle angle) + mainLoop + + +-- | The idle callback. +idle :: IORef GLfloat -> IdleCallback +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 = + 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] + loadIdentity + preservingMatrix $ do + translate $ Vector3 offset 0 0.5 + rotate angle' $ Vector3 1 1 1 + color $ Color3 0.5 0.35 (0 :: GLfloat) + cube 0.5 + color $ Color3 0.5 0.65 (1 :: GLfloat) + cubeFrame 0.5 + preservingMatrix $ do + translate $ Vector3 offset 0 0 + rotate (- angle') $ Vector3 1 1 1 + color $ Color3 0 0.35 (0.5 :: GLfloat) + 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:* \<\>. +cube :: GLfloat -> IO () +cube w = + renderPrimitive Quads + $ mapM_ vertex3f + [ + ( w, w, w), ( w, w,-w), ( w,-w,-w), ( w,-w, w) + , ( w, w, w), ( w, w,-w), (-w, w,-w), (-w, w, w) + , ( w, w, w), ( w,-w, w), (-w,-w, w), (-w, w, w) + , (-w, w, w), (-w, w,-w), (-w,-w,-w), (-w,-w, w) + , ( w,-w, w), ( w,-w,-w), (-w,-w,-w), (-w,-w, w) + , ( w, w,-w), ( w,-w,-w), (-w,-w,-w), (-w, w,-w) + ] + + +-- | Make the frame of a cube. *Source:* \<\>. +cubeFrame :: GLfloat -> IO () +cubeFrame w = + renderPrimitive Lines + $ mapM_ vertex3f + [ + ( w,-w, w), ( w, w, w) + , ( w, w, w), (-w, w, w) + , (-w, w, w), (-w,-w, w) + , (-w,-w, w), ( w,-w, w) + , ( w,-w, w), ( w,-w,-w) + , ( w, w, w), ( w, w,-w) + , (-w, w, w), (-w, w,-w) + , (-w,-w, w), (-w,-w,-w) + , ( w,-w,-w), ( w, w,-w) + , ( w, w,-w), (-w, w,-w) + , (-w, w,-w), (-w,-w,-w) + , (-w,-w,-w), ( w,-w,-w) + ] + + +-- | Make a vertex. +vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO () +vertex3f (x, y, z) = vertex $ Vertex3 x y z