/usr/share/doc/libghc-glut-doc/examples/RedBook4/UnProject.hs is in libghc-glut-doc 2.7.0.12-1build5.
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 | {-
UnProject.hs (adapted from unproject.c which is (c) Silicon Graphics, Inc.)
Copyright (c) Sven Panne 2002-2005 <svenpanne@gmail.com>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
When the left mouse button is pressed, this program reads the mouse
position and determines two 3D points from which it was transformed.
Very little is displayed.
-}
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT
display :: DisplayCallback
display = do
clear [ ColorBuffer ]
flush
reshape :: ReshapeCallback
reshape size@(Size w h) = do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
perspective 45 (fromIntegral w / fromIntegral h) 1 100
matrixMode $= Modelview 0
loadIdentity
keyboardMouse :: KeyboardMouseCallback
keyboardMouse (MouseButton LeftButton) Down _ (Position x y) = do
v@(_, Size _ h) <- get viewport
mvMatrix <- get (matrix (Just (Modelview 0))) :: IO (GLmatrix GLdouble)
projMatrix <- get (matrix (Just Projection)) :: IO (GLmatrix GLdouble)
let realY = fromIntegral h - y -1
putStrLn ("Coordinates at cursor are (" ++ show x ++", " ++ show realY ++ ")")
w0 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 0) mvMatrix projMatrix v
putStrLn ("World coords at z=0.0 are " ++ show w0)
w1 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 1) mvMatrix projMatrix v
putStrLn ("World coords at z=1.0 are " ++ show w1)
keyboardMouse (MouseButton RightButton) Down _ _ = exitWith ExitSuccess
keyboardMouse (Char '\27') Down _ _ = exitWith ExitSuccess
keyboardMouse _ _ _ _ = return ()
main :: IO ()
main = do
(progName, _args) <- getArgsAndInitialize
initialDisplayMode $= [ SingleBuffered, RGBMode ]
initialWindowSize $= Size 500 500
initialWindowPosition $= Position 100 100
_ <- createWindow progName
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboardMouse
mainLoop
|