/usr/share/doc/libghc-glut-doc/examples/BOGLGP/Chapter01/Simple.hs is in libghc-glut-doc 2.1.2.2-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 | {-
Simple.hs (adapted from Simple.cpp which is (c) 2004 Astle/Hawkins)
Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>
This file is part of HOpenGL and distributed under a BSD-style license
See the file libraries/GLUT/LICENSE
-}
import Control.Monad ( unless )
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import Graphics.UI.GLUT hiding ( initialize )
--------------------------------------------------------------------------------
-- Setup GLUT and OpenGL, drop into the event loop.
--------------------------------------------------------------------------------
main :: IO ()
main = do
-- Setup the basic GLUT stuff
getArgsAndInitialize
initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]
-- Create the window
initialWindowSize $= Size 1024 768
initialWindowPosition $= Position 100 150
createWindow "BOGLGP - Chapter 1 - Simple"
initialize
-- Register the event callback functions
displayCallback $= display
reshapeCallback $= Just reshape
keyboardMouseCallback $= Just keyboardMouseHandler
-- No need for an idle callback here, this would just hog the CPU
-- without any visible effect
-- At this point, control is relinquished to the GLUT event handler.
-- Control is returned as events occur, via the callback functions.
mainLoop
--------------------------------------------------------------------------------
-- One time setup, including creating menus, creating a light, setting the
-- shading mode and clear color, and loading textures.
--------------------------------------------------------------------------------
initialize :: IO ()
initialize = do
-- set up the only meny
attachMenu RightButton (Menu [MenuEntry "Exit" (exitWith ExitSuccess)])
depthFunc $= Just Less
--------------------------------------------------------------------------------
-- Handle mouse and keyboard events. For this simple demo, just exit on a
-- left click or when q is pressed.
--------------------------------------------------------------------------------
keyboardMouseHandler :: KeyboardMouseCallback
keyboardMouseHandler (MouseButton LeftButton)_ _ _ = exitWith ExitSuccess
keyboardMouseHandler (Char 'q') _ _ _ = exitWith ExitSuccess
keyboardMouseHandler _ _ _ _ = postRedisplay Nothing
--------------------------------------------------------------------------------
-- Reset the viewport for window changes.
--------------------------------------------------------------------------------
reshape :: ReshapeCallback
reshape size@(Size width height) =
unless (height == 0) $ do
viewport $= (Position 0 0, size)
matrixMode $= Projection
loadIdentity
perspective 90 (fromIntegral width / fromIntegral height) 1 100
matrixMode $= Modelview 0
--------------------------------------------------------------------------------
-- Clear and redraw the scene.
--------------------------------------------------------------------------------
display :: DisplayCallback
display = do
-- set up the camera
loadIdentity
lookAt (Vertex3 0 1 6) (Vertex3 0 0 0) (Vector3 0 1 0)
-- clear the screen
clear [ ColorBuffer, DepthBuffer ]
-- resolve overloading, not needed in "real" programs
let color3f = color :: Color3 GLfloat -> IO ()
vertex3f = vertex :: Vertex3 GLfloat -> IO ()
-- draw a triangle
renderPrimitive Triangles $ do
color3f (Color3 1 0 0)
vertex3f (Vertex3 2 2.5 (-1))
color3f (Color3 0 1 0)
vertex3f (Vertex3 (-3.5) (-2.5) (-1))
color3f (Color3 0 0 1)
vertex3f (Vertex3 2 (-4) 0)
-- draw a polygon
renderPrimitive Polygon $ do
color3f (Color3 1 1 1)
vertex3f (Vertex3 (-1) 2 0)
color3f (Color3 1 1 0)
vertex3f (Vertex3 (-3) (-0.5) 0)
color3f (Color3 0 1 1)
vertex3f (Vertex3 (-1.5) (-3) 0)
color3f (Color3 0 0 0)
vertex3f (Vertex3 1 (-2) 0)
color3f (Color3 1 0 1)
vertex3f (Vertex3 1 1 0)
-- draw everything and swap the display buffer
swapBuffers
|