{-| Module : Graphics.Rendering.DLP Copyright : (c) 2015 Brian W Bush License : MIT Maintainer : Brian W Bush <consult@brianwbush.info> Stability : Stable Portability : Portable 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@. 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 () main = do _ <- getArgsAndInitialize initialDisplayMode $= [WithDepthBuffer, DoubleBuffered] _ <- createWindow \"DLP Stereo OpenGL Example\" depthFunc $= Just Less 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 display :: IORef DlpState -> DisplayCallback display dlp = do clear [ColorBuffer, DepthBuffer] 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 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' , whichView , whichView' ) where import Control.Monad (unless, 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 \<<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. | QuadBuffer -- ^ Instead of DLP, use a quad buffer stereo. 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. data DlpState = DlpState DlpEncoding Int -- | Initialize the DLP state. 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. -> 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 -- | 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. -> 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 = (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 dlp = dlp $~! \(DlpState encoding frame) -> DlpState encoding $ (frame + 1) `mod` 4 -- | Color constants. 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 QuadBuffer _ ) = clear -- | Determine the correct color of the reference line for a given DLP encoding and DLP state. 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 :: IORef DlpState -- ^ A reference to the current DLP state. -> IO () -- ^ An action to draw the DLP reference line. drawDlp dlp = do DlpState encoding _ <- get dlp unless (encoding `elem` [LeftOnly, RightOnly, QuadBuffer]) $ 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 when (encoding == TopAndBottom) $ do windowPos $ Vertex2 x0 $ y0 + h `div` 2 drawLine advanceDlp dlp