packages feed

handa-opengl (empty) → 0.1.6.1

raw patch · 10 files changed

+606/−0 lines, 10 filesdep +GLUTdep +OpenGLdep +arraysetup-changed

Dependencies added: GLUT, OpenGL, array, base, data-default, opengl-dlp-stereo

Files

+ LICENSE view
@@ -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.
+ ReadMe.md view
@@ -0,0 +1,9 @@+This is a collection of miscellaneous utility functions for OpenGL and GLUT.   It currently includes support for the following:++*   Managing vertex buffer objects (VBOs).+*   Creating shapes and wireframes.+*   Managing perspectives and frusta.+*   Using the keyboard to navigate scenes.+*   Setting up and initializing GLUT windows using command-line arguments.++Please report issues at <<https://bwbush.atlassian.net/projects/HOGL/issues/>>.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ handa-opengl.cabal view
@@ -0,0 +1,42 @@+name:                handa-opengl+version:             0.1.6.1+synopsis:            Utility functions for OpenGL and GLUT+description:         This is a collection of miscellaneous utility functions for OpenGL and GLUT.++license:             MIT+license-file:        LICENSE+author:              Brian W Bush <consult@brianwbush.info>+maintainer:          Brian W Bush <consult@brianwbush.info>+copyright:           (c) 2015 Brian W Bush+category:            Graphics+build-type:          Simple+cabal-version:       >= 1.10+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.6.1.tar.gz++extra-source-files:  ReadMe.md++source-repository head+  type: git+  location: https://bwbush@bitbucket.org/bwbush/handa-opengl.git+ +library+  build-depends:    base               >= 4.6 && < 5+               ,    array              >= 0.4.0.1+               ,    data-default       >= 0.5.3+               ,    GLUT               >= 2.4+               ,    opengl-dlp-stereo  >= 0.1.4.1+               ,    OpenGL             >= 2.8+  exposed-modules:  Graphics.Rendering.Handa.Face+                    Graphics.Rendering.Handa.Shape+                    Graphics.Rendering.Handa.Viewer+                    Graphics.Rendering.Handa.Util+                    Graphics.UI.Handa.Keyboard+                    Graphics.UI.Handa.Setup+  hs-source-dirs:   src+  exposed:          True+  buildable:        True+  ghc-options:      -Wall+  default-language: Haskell2010
+ src/Graphics/Rendering/Handa/Face.hs view
@@ -0,0 +1,89 @@+{-|+Module      :  Graphics.Rendering.Handa.Face+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Functions and types for managing objects represented as collections of faces.+-}+++module Graphics.Rendering.Handa.Face (+  -- * Types+  Face+, Edges+, faceToEdges+  -- * Rendering+, drawFaces+, drawFrame+  -- * Particular Objects+, coneFaces+, brickFaces+) where+++import Graphics.Rendering.Handa.Util (cosd, sind, vertex3)+import Graphics.Rendering.OpenGL.GL (PrimitiveMode(..), VertexComponent, renderPrimitive)+++-- | Edges are paired series of triple of vertex components.+type Edges a = [(a, a, a)]+++-- | A face is a collections of the vertices on its boundary.+type Face a = [(a, a, a)]+++-- | Convert a face to a+faceToEdges :: Face a -> Edges a+faceToEdges face = concat $ zipWith ((. return) . (:)) (init face) (tail face)+++-- | Draw faces.+drawFaces :: (Num a, VertexComponent a)+          => [Face a] -- ^ The faces.+          -> IO ()    -- ^ An action to draw the faces.+drawFaces = renderPrimitive Quads . mapM_ vertex3 . concat+++-- | Draw the frame around faces.+drawFrame :: (Num a, VertexComponent a)+          => [Face a] -- ^ The faces.+          -> IO ()    -- ^ An action to draw the frame of the faces' edges.+drawFrame = renderPrimitive Lines . mapM_ vertex3 . concatMap faceToEdges+++-- | The faces of a truncated cone that has its tip at the origin and points towards the negative z axis.+coneFaces :: (Enum a, Floating a, VertexComponent a)+          => Int      -- ^ The number of faces around the cone.+          -> a        -- ^ The height of the cone.+          -> a        -- ^ The radius of the cone.+          -> [Face a] -- ^ Faces representing the cone.+coneFaces n height radius =+  let+    point = (0, 0, 0)+    center = (0, 0, height)+    rim = [(radius * cosd x, radius * sind x, height) | x <- [0,(360 / fromIntegral n)..360]]+  in +    [+      [p0, p1, p2]+    |+      (p1, p2) <- zip (tail rim) (init rim)+    , p0 <- [point, center]+    ]+++-- | The faces of a brick that has one corner at the origin.+brickFaces :: Num a+           => a        -- ^ The x (width) dimension of the brick.+           -> a        -- ^ The y (height) dimension of the brick.+           -> a        -- ^ The z (depth) dimension of the brick.+           -> [Face a] -- ^ Faces representing the brick.+brickFaces w h d =+  [[(0, 0, z), (w, 0, z), (w, h, z), (0, h, z)] | z <- [0, d]]+  +++  [[(0, y, 0), (w, y, 0), (w, y, d), (0, y, d)] | y <- [0, h]]+  +++  [[(x, 0, 0), (x, h, 0), (x, h, d), (x, 0, d)] | x <- [0, w]]
+ src/Graphics/Rendering/Handa/Shape.hs view
@@ -0,0 +1,96 @@+{-|+Module      :  Graphics.Rendering.Handa.Shape+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Functions and types for managing shapes represented as vertex buffer objects (VBOs).+-}+++{-# LANGUAGE RecordWildCards #-}+++module Graphics.Rendering.Handa.Shape (+  -- * Types+  Shape+  -- * Functions+, makeShape+, remakeShape+, drawShape+) where+++import Control.Applicative ((<$>))+import Data.Array.Storable (newListArray, withStorableArray)+import Foreign.Ptr (nullPtr)+import Foreign.Storable (Storable, sizeOf)+import Graphics.Rendering.OpenGL (DataType, BufferObject, BufferTarget(ArrayBuffer), BufferUsage(StaticDraw), Capability(..), ClientArrayType(VertexArray), NumArrayIndices, NumComponents, PrimitiveMode, Stride, VertexArrayDescriptor(..), ($=), arrayPointer, bindBuffer, bufferData, drawArrays, clientState, genObjectNames)+++-- | A shape stored as a vertex buffer object (VBO).+data Shape =+  Shape+  {+    vbo         :: BufferObject    -- ^ The handle to the vertex buffer object.+  , components  :: NumComponents   -- ^ The number of components for the shape's vertices.+  , dataType    :: DataType        -- ^ The data type of the shape's vertices.+  , stride      :: Stride          -- ^ The stride, the number of components between consecutive vertices.+  , size        :: NumArrayIndices -- ^ The number of vertices.+  , mode        :: PrimitiveMode   -- ^ The type of primitive.+  , priorAction :: IO ()           -- ^ The display action to be executed prior to rendering the shape.+  }+++-- | Construct a shape.+makeShape :: Storable a+          => NumComponents -- ^ The number of components per vertex.+          -> DataType      -- ^ The data type for the vertices' components.+          -> PrimitiveMode -- ^ The type of primitive.+          -> [a]           -- ^ The vertices.+          -> IO ()         -- ^ The display action to be executed prior to rendering the shape.+          -> IO Shape      -- ^  An action for the shape.+makeShape components dataType mode vertices priorAction =+  let+    stride = undefined+    size = undefined+  in do+    vbo <- head <$> genObjectNames 1+    remakeShape Shape{..} vertices+++-- | Reconstruct a shape by replacing its vertices.+remakeShape :: Storable a+            => Shape      -- ^ The shape.+            -> [a]        -- ^ The replacement vertices.+            -> IO Shape   -- ^ An action for the updated shape.+remakeShape shape@Shape{..} vertices =+  let+    n = length vertices+    m =+      if null vertices+        then 0+        else sizeOf $ head vertices+    ptrSize = toEnum $ n * m+  in do+    bindBuffer ArrayBuffer $= Just vbo+    vertices' <- newListArray (0, n - 1) vertices+    withStorableArray vertices' $ \ptr -> bufferData ArrayBuffer $= (ptrSize, ptr, StaticDraw)+    bindBuffer ArrayBuffer $= Nothing+    return $ shape {size = toEnum n, stride = toEnum m}+++-- | Render a shape.    +drawShape :: Shape -- ^ The shape.+          -> IO () -- ^ An action to render the shape, also executing its prior actions before rendering it.+drawShape Shape{..} =+  do+    clientState VertexArray $= Enabled+    bindBuffer ArrayBuffer $= Just vbo+    arrayPointer VertexArray $= VertexArrayDescriptor components dataType stride nullPtr+    priorAction+    drawArrays mode 0 size+    bindBuffer ArrayBuffer $= Nothing+    clientState VertexArray $= Disabled
+ src/Graphics/Rendering/Handa/Util.hs view
@@ -0,0 +1,55 @@+{-|+Module      :  Graphics.Rendering.Handa.Util+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Miscellaneous functions for OpenGL rendering.+-}+++module Graphics.Rendering.Handa.Util (+  -- * Trigonometry+  degree+, cosd+, sind+, color4+  -- * Analytic Geometry+, vertex3+, vector3+) where+++import Graphics.Rendering.OpenGL.GL (Color4(..), ColorComponent, Vector3(..), Vertex3(..), VertexComponent, color, vertex)+++-- | One degree of arc.+degree :: Floating a => a+degree = 180 / pi+++-- | Cosine with its argument in degrees.+cosd :: Floating a => a -> a+cosd = cos . (/ degree)+++-- | Sine with its argument in degrees.+sind :: Floating a => a -> a+sind = sin . (/ degree)+++-- | Action for a four-component color from a tuple.+color4 :: ColorComponent a => (a, a, a, a) -> IO ()+color4 (r, g, b, a) = color $ Color4 r g b a+++-- | Action for a three-component vertex from a tuple.+vertex3 :: VertexComponent a => (a, a, a) -> IO ()+vertex3 (x, y, z) = vertex $ Vertex3 x y z+++-- | Construct a three-component vector from a tuple.+vector3 :: (a, a, a) -> Vector3 a+vector3 (x, y, z) = Vector3 x y z
+ src/Graphics/Rendering/Handa/Viewer.hs view
@@ -0,0 +1,157 @@+{-|+Module      :  Graphics.Rendering.Handa.Viewer+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Functions for managing perspectives and frusta.+-}+++{-# LANGUAGE RecordWildCards #-}+++module Graphics.Rendering.Handa.Viewer (+  -- * Viewer Geometry+  ViewerParameters(..)+, viewerGeometry+, fieldOfView+  -- * Typical Devices+, phoneViewer+, laptopViewer+, desktopViewer+, projectorViewer+  -- * Callbacks and Rendering+, reshape+, loadViewer+, dlpViewerDisplay+) where+++import Data.Default (Default, def)+import Graphics.Rendering.DLP (DlpEncoding, DlpEye(..))+import Graphics.Rendering.DLP.Callbacks (DlpDisplay(..))+import Graphics.Rendering.Handa.Util (degree)+import Graphics.Rendering.OpenGL (GLdouble, MatrixMode(..), Position(..), Size(..), Vector3(..), Vertex3(..), ($=!), loadIdentity, lookAt, matrixMode, perspective, viewport)+import Graphics.UI.GLUT (DisplayCallback, ReshapeCallback)+++-- | Paramaters specifying a viewer, including the frustum of the view.+data ViewerParameters =+  ViewerParameters+  {+    displayAspectRatio :: GLdouble         -- ^ The aspect ratio of the screen or display (i.e., the width divided by the height).+  , displayThrowRatio  :: GLdouble         -- ^ The throw ratio of the screen or display (i.e., the width divided by the distance).+  , distanceNearPlane  :: GLdouble         -- ^ The distance to the near plane of the frustum.+  , distanceFarPlane   :: GLdouble         -- ^ The distance to the far plane of the frustum.+  , eyePosition        :: Vertex3 GLdouble -- ^ The position of the eyes.+  , eyeSeparation      :: Vector3 GLdouble -- ^ The separation between the eyes.+  , eyeUpward          :: Vector3 GLdouble -- ^ The upward direction.+  , sceneCenter        :: Vertex3 GLdouble -- ^ The center of the scene.+  }+    deriving (Eq, Read, Show)++instance Default ViewerParameters where+  def =+    ViewerParameters+    {+      displayAspectRatio = 1+    , displayThrowRatio  = 1+    , distanceNearPlane  = 0.5+    , distanceFarPlane   = 4.5+    , eyePosition        = Vertex3 0   0 2+    , eyeSeparation      = Vector3 0.2 0 0+    , eyeUpward          = Vector3 0   1 0+    , sceneCenter        = Vertex3 0   0 0+    }+++-- | Construct viewer geometry from physical geometry.+viewerGeometry :: GLdouble         -- ^ The width of the screen or display.+               -> GLdouble         -- ^ The height of the screen or display.+               -> GLdouble         -- ^ The distance from the eyes to the screen or display.+               -> ViewerParameters -- ^ The corresponding viewer parameters.+viewerGeometry width height throw =+  def+  {+    displayAspectRatio = width / height+  , displayThrowRatio  = throw / width+  }+++-- | Viewer parameters for a typical smartphone screen.+phoneViewer :: ViewerParameters+phoneViewer = viewerGeometry 5.27 2.80 12+++-- | Viewer parameters for a typical laptop screen.+laptopViewer :: ViewerParameters+laptopViewer = viewerGeometry 13.625 7.875 24+++-- | Viewer parameters for a typical desktop monitor.+desktopViewer :: ViewerParameters+desktopViewer = viewerGeometry 20.75 11.625 32+++-- | Viewer parameters for a typical projector.+projectorViewer :: ViewerParameters+projectorViewer =+  def+  {+    displayAspectRatio = 1.6 / 1.0+  , displayThrowRatio  = 1.5 / 1.0+  }+++-- | Compute the field of view for viewer parameters.+fieldOfView :: ViewerParameters -- ^ The viewer parameters+            -> GLdouble         -- ^ The field of view, in degrees.+fieldOfView ViewerParameters{..} = 2 * atan2 0.5 displayThrowRatio * degree+++-- | Construct a reshape callback from viewer parameters.  This simply sets the frustum based on the viewer parameters and the size of the viewport.+reshape :: ViewerParameters -- ^ The viewer parameters.+        -> ReshapeCallback  -- ^ The reshape callback.+reshape vp@ViewerParameters{..} wh@(Size w h) = +  do+    viewport $=! (Position 0 0, wh)+    matrixMode $=! Projection+    loadIdentity+    perspective (fieldOfView vp) (fromIntegral w / fromIntegral h) distanceNearPlane distanceFarPlane+    matrixMode $=! Modelview 0+++-- | Create an action look at the scene according to the viewer parameters.+loadViewer :: ViewerParameters -- ^ 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+    loadIdentity+    let+      offset =+        case eye of+          LeftDlp  -> -1/2+          RightDlp ->  1/2+      Vertex3  xEye  yEye  zEye = eyePosition+      Vector3 dxEye dyEye dzEye = eyeSeparation+    lookAt+      (Vertex3 (xEye + offset * dxEye) (yEye + offset * dyEye) (zEye + offset * dzEye))+      sceneCenter+      eyeUpward+++-- | Construct a DLP display from a display callback.+dlpViewerDisplay :: DlpEncoding      -- ^ The DLP encoding.+                 -> ViewerParameters -- ^ 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 =+  def +    {+      dlpEncoding = encoding+    , doDisplay = \eye -> loadViewer viewerParameters eye >> display+    }
+ src/Graphics/UI/Handa/Keyboard.hs view
@@ -0,0 +1,47 @@+{-|+Module      :  Graphics.UI.Handa.Keyboard+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Functions for utilizing keyboard input.+-}+++module Graphics.UI.Handa.Keyboard (+  -- * Functions+  keyboardPosition+) where+++import Data.IORef (IORef)+import Graphics.Rendering.OpenGL (Vector3(..), ($~!))+import Graphics.UI.GLUT (Key(..), KeyState(..), KeyboardMouseCallback, SpecialKey(..))+++-- | Construct a callback for translating key presses into three dimensional movement.+--+-- *   The plus and minus keys, respectively, increment and decrement the y coordinate.+--+-- *   The right and left keys, respectively, increment and decrement the x coordinate.+--+-- *   The down and up keys, respectively, increment and decrment the z coordinate.+keyboardPosition :: Num a+                 => Vector3 a             -- ^ The amount to increment/decrement the x/y/z coordinate for each key press.+                 -> IORef (Vector3 a)     -- ^ A reference to the current position.+                 -> KeyboardMouseCallback -- ^ The GLUT keyboard/mouse callback.+keyboardPosition (Vector3 ix iy iz) location key Down _ _ =+  do+    let+      Vector3 dx dy dz = case key of+        (Char       '+'     ) -> Vector3   0     iy    0+        (Char       '-'     ) -> Vector3   0   (-iy)   0+        (SpecialKey KeyLeft ) -> Vector3 (-ix)   0     0+        (SpecialKey KeyRight) -> Vector3   ix    0     0+        (SpecialKey KeyUp   ) -> Vector3   0     0   (-iz)+        (SpecialKey KeyDown ) -> Vector3   0     0     iz+        _                     -> Vector3   0     0     0+    location $~! \(Vector3 x y z) -> Vector3 (x + dx) (y + dy) (z + dz)+keyboardPosition _ _ _ _ _ _ = return ()
+ src/Graphics/UI/Handa/Setup.hs view
@@ -0,0 +1,89 @@+{-|+Module      :  Graphics.UI.Handa.Setup+Copyright   :  (c) 2015 Brian W Bush+License     :  MIT+Maintainer  :  Brian W Bush <consult@brianwbush.info>+Stability   :  Stable+Portability :  Portable++Functions for setting up GLUT applications.+-}+++module Graphics.UI.Handa.Setup (+  -- * Functions+  setup+, handleArguments+, idle+) where+++import Control.Monad (when)+import Data.Default (def)+import Data.List ((\\))+import Graphics.Rendering.DLP (DlpEncoding(..))+import Graphics.Rendering.Handa.Viewer (ViewerParameters(eyeSeparation), desktopViewer, laptopViewer, phoneViewer, projectorViewer, reshape)+import Graphics.Rendering.OpenGL (BlendingFactor(..), Capability(Enabled), ComparisonFunction(Less), Vector3(..), ($=), blend, blendFunc)+import Graphics.UI.GLUT (DisplayMode(..), IdleCallback, createWindow, depthFunc, getArgsAndInitialize, fullScreen, idleCallback, initialDisplayMode, postRedisplay, reshapeCallback)+++-- | Set up a window with basic callbacks.  This creates a double-buffered window with a depth buffer, a transparency blending function, a generic reshaping callback, and a redisplaying idle function.  See 'handleArguments' for information on how command-line arguments are interpretted.+setup :: String                                       -- ^ The window title.+      -> IO (DlpEncoding, ViewerParameters, [String]) -- ^ An action returing the DLP encoding requested, the viewer parameters, and the uninterpretted arguments.+setup title =+  do+    (_, arguments) <- getArgsAndInitialize+    initialDisplayMode $= [WithDepthBuffer, DoubleBuffered]+    _window <- createWindow title+    depthFunc $= Just Less +    blend $= Enabled+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+    r@(_, viewerParameters, _) <- handleArguments arguments+    reshapeCallback $= Just (reshape viewerParameters)+    idleCallback $= Just idle+    return r+++-- | Act on command-line arguments.+--+-- *   \"--fullscreen\" puts the application in full screen mode.+--+-- *   \"--stereo\" puts the application in frame-sequential DLP stereo mode.+--+-- *   \"--cardboard\" puts the application in side-by-side (Google Cardboard) stereo mode.+--+-- *   \"--phone\" sets the frustum for a typical smartphone.+--+-- *   \"--laptop\" sets the frustum for a typical laptop.+--+-- *   \"--desktop\" sets the frustum for a typical desktop monitor.+--+-- *   \"--projection1 sets the frustum for a typical projector.+--+-- *   \"--switchEyes\" swaps the views of the left and right eyes.+handleArguments :: [String] -> IO (DlpEncoding, ViewerParameters, [String])+handleArguments arguments =+  do+    when ("--fullscreen" `elem` arguments) fullScreen+    let+      dlp+        | "--stereo"    `elem` arguments = FrameSequential+        | "--cardboard" `elem` arguments = SideBySide+        | otherwise                     = LeftOnly+      viewerParameters+        | "--phone"     `elem` arguments = phoneViewer+        | "--laptop"    `elem` arguments = laptopViewer+        | "--desktop"   `elem` arguments = desktopViewer+        | "--projector" `elem` arguments = projectorViewer+        | otherwise                      = def+      viewerParameters' =+        if "--switchEyes" `elem` arguments+        then viewerParameters {eyeSeparation = (\(Vector3 x y z) -> Vector3 (-x) (-y) (-z)) $ eyeSeparation viewerParameters}+        else viewerParameters+      keywords = ["--fullscreen", "--stereo", "--cardboard", "--phone", "--laptop", "--desktop", "--projector", "--switchEyes"]+    return (dlp, viewerParameters', arguments \\ keywords)+++-- | An idle callback that simply posts a request for redisplay.+idle :: IdleCallback+idle = postRedisplay Nothing