/usr/share/doc/libghc-glut-doc/examples/RedBook/Select.hs is in libghc-glut-doc 2.4.0.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | {-
Select.hs (adapted from select.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
This is an illustration of the selection mode and name stack, which detects
whether objects which collide with a viewing volume. First, four triangles
and a rectangular box representing a viewing volume are drawn (drawScene
routine). The green triangle and yellow triangles appear to lie within the
viewing volume, but the red triangle appears to lie outside it. Then the
selection mode is entered (selectObjects routine). Drawing to the screen
ceases. To see if any collisions occur, the four triangles are called. In
this example, the green triangle causes one hit with the name 1, and the
yellow triangles cause one hit with the name 3.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
-- draw a triangle with vertices at (x1, y1), (x2, y2) and (x3, y3) at z units
-- away from the origin.
drawTriangle ::
Vertex2 GLfloat -> Vertex2 GLfloat -> Vertex2 GLfloat -> GLfloat -> IO ()
drawTriangle (Vertex2 x1 y1) (Vertex2 x2 y2) (Vertex2 x3 y3) z = do
renderPrimitive Triangles $ mapM_ vertex [
Vertex3 x1 y1 z,
Vertex3 x2 y2 z,
Vertex3 x3 y3 z]
-- draw a rectangular box with these outer x, y, and z values
drawViewVolume :: Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()
drawViewVolume (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2) = do
-- resolve overloading, not needed in "real" programs
let color3f = color :: Color3 GLfloat -> IO ()
color3f (Color3 1 1 1)
renderPrimitive LineLoop $ mapM_ vertex [
Vertex3 x1 y1 (-z1),
Vertex3 x2 y1 (-z1),
Vertex3 x2 y2 (-z1),
Vertex3 x1 y2 (-z1)]
renderPrimitive LineLoop $ mapM_ vertex [
Vertex3 x1 y1 (-z2),
Vertex3 x2 y1 (-z2),
Vertex3 x2 y2 (-z2),
Vertex3 x1 y2 (-z2)]
renderPrimitive Lines $ mapM_ vertex [ -- 4 lines
Vertex3 x1 y1 (-z1),
Vertex3 x1 y1 (-z2),
Vertex3 x1 y2 (-z1),
Vertex3 x1 y2 (-z2),
Vertex3 x2 y1 (-z1),
Vertex3 x2 y1 (-z2),
Vertex3 x2 y2 (-z1),
Vertex3 x2 y2 (-z2)]
-- drawScene draws 4 triangles and a wire frame which represents the viewing
-- volume.
drawScene :: IO ()
drawScene = do
matrixMode $= Projection
loadIdentity
perspective 40 (4/3) 1 100
matrixMode $= Modelview 0
loadIdentity
lookAt (Vertex3 7.5 7.5 12.5) (Vertex3 2.5 2.5 (-5)) (Vector3 0 1 0)
-- resolve overloading, not needed in "real" programs
let color3f = color :: Color3 GLfloat -> IO ()
color3f (Color3 0 1 0) -- green triangle
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)
color3f (Color3 1 0 0) -- red triangle
drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)
color3f (Color3 1 1 0) -- yellow triangles
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)
drawViewVolume (Vertex3 0 0 0) (Vertex3 5 5 10)
processHits :: Maybe [HitRecord] -> IO ()
processHits Nothing = putStrLn "selection buffer overflow"
processHits (Just hitRecords) = do
putStrLn ("hits = " ++ show (length hitRecords))
mapM_ (\(HitRecord z1 z2 names) -> do
putStrLn (" number of names for hit = " ++ show (length names))
putStr (" z1 is " ++ show z1)
putStrLn ("; z2 is " ++ show z2)
putStr " the name is"
sequence_ [ putStr (" " ++ show n) | Name n <- names ]
putChar '\n')
hitRecords
-- selectObjects "draws" the triangles in selection mode, assigning names for
-- the triangles. Note that the third and fourth triangles share one name, so
-- that if either or both triangles intersects the viewing/clipping volume,
-- only one hit will be registered.
bufSize :: GLsizei
bufSize = 512
selectObjects :: IO ()
selectObjects = do
(_, maybeHitRecords) <- getHitRecords bufSize $ do
withName (Name 0) $ do
preservingMatrix $ do
matrixMode $= Projection
loadIdentity
ortho 0 5 0 5 0 10
matrixMode $= Modelview 0
loadIdentity
loadName (Name 1)
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)
loadName (Name 2)
drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)
loadName (Name 3)
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)
drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)
flush
processHits maybeHitRecords
myInit :: IO ()
myInit = do
depthFunc $= Just Less
shadeModel $= Flat
display :: DisplayCallback
display = do
clearColor $= Color4 0 0 0 0
clear [ ColorBuffer, DepthBuffer ]
drawScene
selectObjects
flush
keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _ _ = exitWith ExitSuccess
keyboard _ _ _ _ = return ()
-- Main Loop
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]
initialWindowSize $= Size 200 200
initialWindowPosition $= Position 100 100
createWindow progName
myInit
displayCallback $= display
keyboardMouseCallback $= Just keyboard
mainLoop
|