GLFW: Difference between revisions
mNo edit summary |
(add sample program) |
||
Line 32: | Line 32: | ||
Current version is [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/GLFW-0.3 GLFW-0.3]. It's a repackage to work with Cabal 1.2 or later. It now compiles GLFW C source code as part of the building process, please report to the package maintainer if you have build problems. | Current version is [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/GLFW-0.3 GLFW-0.3]. It's a repackage to work with Cabal 1.2 or later. It now compiles GLFW C source code as part of the building process, please report to the package maintainer if you have build problems. | ||
== Sample Program == | |||
To demonstrate the usage of GLFW for OpenGL based Haskell applications, here is a sample program that allows user to draw lines by holding the left mouse button and move the mouse. | |||
<haskell> | |||
import Graphics.Rendering.OpenGL as GL | |||
import Graphics.UI.GLFW as GLFW | |||
import Graphics.Rendering.OpenGL (($=)) | |||
import Control.Concurrent | |||
</haskell> | |||
Because the program needs to process user input, i.e., mouse button and movements, we'll use a continuation like structure for this purpose. The <hask>Action</hask> type represents an IO operation that returns the next <hask>Action</hask> to continue execution. | |||
<haskell> | |||
data Action = Action (IO Action) | |||
</haskell> | |||
The main program mostly involves initializing OpenGL and GLFW. | |||
<haskell> | |||
main = do | |||
GLFW.initialize | |||
-- open window | |||
GLFW.openWindow (GL.Size 400 400) [GLFW.DisplayAlphaBits 8] GLFW.Window | |||
GLFW.windowTitle $= "GLFW Demo" | |||
GL.shadeModel $= GL.Smooth | |||
-- enable antialiasing | |||
GL.lineSmooth $= GL.Enabled | |||
GL.blend $= GL.Enabled | |||
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) | |||
GL.lineWidth $= 1.5 | |||
-- set the color to clear background | |||
GL.clearColor $= Color4 0 0 0 0 | |||
-- set 2D orthogonal view inside windowSizeCallback because | |||
-- any change to the Window size should result in different | |||
-- OpenGL Viewport. | |||
GLFW.windowSizeCallback $= (\ size@(GL.Size w h) -> do | |||
GL.viewport $= (GL.Position 0 0, size) | |||
GL.matrixMode $= GL.Projection | |||
GL.loadIdentity | |||
GL.ortho2D 0 (realToFrac w) (realToFrac h) 0) | |||
-- keep all line strokes as a list of points in a MVar | |||
lines <- newMVar [] | |||
-- invoke the active drawing loop | |||
active lines | |||
-- finish up | |||
GLFW.closeWindow | |||
GLFW.terminate | |||
</haskell> | |||
There are usually two ways to structure the main loop of GLFW programs. One is by active polling of events and then process them. The screen buffer is usually redrawn every time before <hask>swapBuffers</hask>. This is the simplest main loop often seen in game applications, and may waste CPU cycles even when there is no update to be displayed. Note that <hask>swapBuffers</hask> by default calls <hask>pollEvents</hask> implicitly, so there is no need to do a separate poll. | |||
<haskell> | |||
-- we start with waitForPress action | |||
active lines = loop waitForPress | |||
where | |||
loop action = do | |||
-- draw the entire screen | |||
render lines | |||
-- swap buffer | |||
GLFW.swapBuffers | |||
-- check whether ESC is pressed for termination | |||
p <- GLFW.getKey GLFW.ESC | |||
case p of | |||
GLFW.Press -> return () | |||
_ -> do | |||
-- perform action | |||
Action action' <- action | |||
-- sleep for 1ms to yield CPU to other applications | |||
GLFW.sleep 0.001 | |||
-- loop with next action | |||
loop action' | |||
waitForPress = do | |||
b <- GLFW.getMouseButton GLFW.ButtonLeft | |||
case b of | |||
GLFW.Release -> return (Action waitForPress) | |||
GLFW.Press -> do | |||
-- when left mouse button is pressed, add the point | |||
-- to lines and switch to waitForRelease action. | |||
(GL.Position x y) <- GL.get GLFW.mousePos | |||
modifyMVar_ lines (return . ((x,y):) . ((x,y):)) | |||
return (Action waitForRelease) | |||
waitForRelease = do | |||
-- keep track of mouse movement while waiting for button | |||
-- release | |||
(GL.Position x y) <- GL.get GLFW.mousePos | |||
-- update the line with new ending position | |||
modifyMVar_ lines (return . ((x,y):) . tail) | |||
b <- GLFW.getMouseButton GLFW.ButtonLeft | |||
case b of | |||
-- when button is released, switch back back to | |||
-- waitForPress action | |||
GLFW.Release -> return (Action waitForPress) | |||
GLFW.Press -> return (Action waitForRelease) | |||
</haskell> | |||
Another way to process inputs and structure the main loop is to register event callbacks and use <hask>waitEvents</hask>. This way we don't have to put the program to sleep every 1ms because it'll not be using any CPU cycle when there is no event to handle. | |||
One reminder in this approach is that <hask>swapBuffers</hask> must be handled with care, because it by default invokes <hask>pollEvents</hask>, which in turn invokes all callback functions. So if <hask>swapBuffers</hask> is used inside a callback, it'll create infinite loop and hang the program. To avoid it, we should disable the <hask>AutoPollEvent</hask> behavior using <hask>disableSpecial</hask>. | |||
Another optimization we can do is to use a dirty marker to remember whether the screen really needs to be redrawn. This'll not only save CPU cycles but also speed up event handling to avoid piling up events in the event queue. Similar tricks can be done to optimize the active polling approach. | |||
<haskell> | |||
passive lines = do | |||
-- disable auto polling in swapBuffers | |||
GLFW.disableSpecial GLFW.AutoPollEvent | |||
-- keep track of whether ESC has been pressed | |||
quit <- newMVar False | |||
-- keep track of whether screen needs to be redrawn | |||
dirty <- newMVar True | |||
-- mark screen dirty in refresh callback which is often called | |||
-- when screen or part of screen comes into visibility. | |||
GLFW.windowRefreshCallback $= (modifyMVar_ dirty (\_ -> return False)) | |||
-- use key callback to track whether ESC is pressed | |||
GLFW.keyCallback $= (\k s -> | |||
if fromEnum k == fromEnum GLFW.ESC && s == GLFW.Press | |||
then modifyMVar_ quit (\_ -> return True) | |||
else return ()) | |||
-- by default start with waitForPress | |||
waitForPress dirty | |||
loop dirty quit | |||
where | |||
loop dirty quit = do | |||
GLFW.waitEvents | |||
-- redraw screen if dirty | |||
d <- readMVar dirty | |||
if d then (render lines >> GLFW.swapBuffers) else return () | |||
modifyMVar_ dirty (\_ -> False) | |||
-- check if we need to quit the loop | |||
q <- readMVar quit | |||
if q then return () else loop dirty quit | |||
waitForPress dirty = do | |||
GLFW.mousePosCallback $= (\_ -> return ()) | |||
GLFW.mouseButtonCallback $= (\b s -> | |||
if b == GLFW.ButtonLeft && s == GLFW.Press | |||
then do | |||
-- when left mouse button is pressed, add the point | |||
-- to lines and switch to waitForRelease action. | |||
(GL.Position x y) <- GL.get GLFW.mousePos | |||
modifyMVar_ lines (return . ((x,y):) . ((x,y):)) | |||
waitForRelease dirty | |||
else return ()) | |||
waitForRelease dirty = do | |||
GLFW.mousePosCallback $= (\ (Position x y) -> do | |||
-- update the line with new ending position | |||
modifyMVar_ lines (return . ((x,y):) . tail) | |||
-- mark screen dirty | |||
modifyMVar_ dirty (\_ -> return True)) | |||
GLFW.mouseButtonCallback $= (\b s -> | |||
-- when left mouse button is released, switch back to | |||
-- waitForPress action. | |||
if b == GLFW.ButtonLeft && s == GLFW.Release | |||
then waitForPress dirty | |||
else return ()) | |||
</haskell> | |||
Just replace <hask>active</hask> with <hask>passive</hask> in the <hask>main</hask> program to run it. | |||
The rest of the program goes below | |||
<haskell> | |||
render lines = do | |||
l <- readMVar lines | |||
GL.clear [GL.ColorBuffer, GL.StencilBuffer] | |||
GL.color $ color3 1 0 0 | |||
GL.renderPrimitive GL.Lines $ foldr (>>) (return ()) (map | |||
(\ (x, y) -> GL.vertex (vertex3 (fromIntegral x) (fromIntegral y) 0)) l) | |||
vertex3 :: Float -> Float -> Float -> GL.Vertex3 Float | |||
vertex3 = GL.Vertex3 | |||
color3 :: Float -> Float -> Float -> GL.Color3 Float | |||
color3 = GL.Color3 | |||
</haskell> |
Revision as of 03:53, 16 January 2008
About
This is a Haskell module for GLFW OpenGL framework. It provides an alternative to GLUT for OpenGL based Haskell programs.
Status
The library is being used by the Haskell School of Expression (SOE) code to render Graphics in a cross-platform manner. It currently interfaces with GLFW version 2.6, works on Windows, Linux (i386) and Mac OS X (both intel and ppc).
GLFW itself is well documented (see GLFW website), and the Haskell module API is documented via Haddock.
Not all functions are fully tested, and there are still a few GLFW C functions missing from the Haskell module, namely the image loading functions. They are excluded because image handling is a separate issue, and low level buffer manipulation would obscure their use further. Texture loading from TGA format is supported both from file and from memory (via a string buffer)..
The Haskell module also provides basic text rendering while GLFW doesn't. It comes from a free 8x16 font which is made into a TGA texture, stored as a Haskell string in the file GLFW.hs. Text rendering is only possible with Alpha enabled. Again, see SOE.hs from the SOE package for sample usage.
GLFW doesn't work well with GHC threads, forkIO or threadDelay. So avoid them if you can.
Download
Current version is GLFW-0.3. It's a repackage to work with Cabal 1.2 or later. It now compiles GLFW C source code as part of the building process, please report to the package maintainer if you have build problems.
Sample Program
To demonstrate the usage of GLFW for OpenGL based Haskell applications, here is a sample program that allows user to draw lines by holding the left mouse button and move the mouse.
import Graphics.Rendering.OpenGL as GL
import Graphics.UI.GLFW as GLFW
import Graphics.Rendering.OpenGL (($=))
import Control.Concurrent
Because the program needs to process user input, i.e., mouse button and movements, we'll use a continuation like structure for this purpose. The Action
type represents an IO operation that returns the next Action
to continue execution.
data Action = Action (IO Action)
The main program mostly involves initializing OpenGL and GLFW.
main = do
GLFW.initialize
-- open window
GLFW.openWindow (GL.Size 400 400) [GLFW.DisplayAlphaBits 8] GLFW.Window
GLFW.windowTitle $= "GLFW Demo"
GL.shadeModel $= GL.Smooth
-- enable antialiasing
GL.lineSmooth $= GL.Enabled
GL.blend $= GL.Enabled
GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
GL.lineWidth $= 1.5
-- set the color to clear background
GL.clearColor $= Color4 0 0 0 0
-- set 2D orthogonal view inside windowSizeCallback because
-- any change to the Window size should result in different
-- OpenGL Viewport.
GLFW.windowSizeCallback $= (\ size@(GL.Size w h) -> do
GL.viewport $= (GL.Position 0 0, size)
GL.matrixMode $= GL.Projection
GL.loadIdentity
GL.ortho2D 0 (realToFrac w) (realToFrac h) 0)
-- keep all line strokes as a list of points in a MVar
lines <- newMVar []
-- invoke the active drawing loop
active lines
-- finish up
GLFW.closeWindow
GLFW.terminate
There are usually two ways to structure the main loop of GLFW programs. One is by active polling of events and then process them. The screen buffer is usually redrawn every time before swapBuffers
. This is the simplest main loop often seen in game applications, and may waste CPU cycles even when there is no update to be displayed. Note that swapBuffers
by default calls pollEvents
implicitly, so there is no need to do a separate poll.
-- we start with waitForPress action
active lines = loop waitForPress
where
loop action = do
-- draw the entire screen
render lines
-- swap buffer
GLFW.swapBuffers
-- check whether ESC is pressed for termination
p <- GLFW.getKey GLFW.ESC
case p of
GLFW.Press -> return ()
_ -> do
-- perform action
Action action' <- action
-- sleep for 1ms to yield CPU to other applications
GLFW.sleep 0.001
-- loop with next action
loop action'
waitForPress = do
b <- GLFW.getMouseButton GLFW.ButtonLeft
case b of
GLFW.Release -> return (Action waitForPress)
GLFW.Press -> do
-- when left mouse button is pressed, add the point
-- to lines and switch to waitForRelease action.
(GL.Position x y) <- GL.get GLFW.mousePos
modifyMVar_ lines (return . ((x,y):) . ((x,y):))
return (Action waitForRelease)
waitForRelease = do
-- keep track of mouse movement while waiting for button
-- release
(GL.Position x y) <- GL.get GLFW.mousePos
-- update the line with new ending position
modifyMVar_ lines (return . ((x,y):) . tail)
b <- GLFW.getMouseButton GLFW.ButtonLeft
case b of
-- when button is released, switch back back to
-- waitForPress action
GLFW.Release -> return (Action waitForPress)
GLFW.Press -> return (Action waitForRelease)
Another way to process inputs and structure the main loop is to register event callbacks and use waitEvents
. This way we don't have to put the program to sleep every 1ms because it'll not be using any CPU cycle when there is no event to handle.
One reminder in this approach is that swapBuffers
must be handled with care, because it by default invokes pollEvents
, which in turn invokes all callback functions. So if swapBuffers
is used inside a callback, it'll create infinite loop and hang the program. To avoid it, we should disable the AutoPollEvent
behavior using disableSpecial
.
Another optimization we can do is to use a dirty marker to remember whether the screen really needs to be redrawn. This'll not only save CPU cycles but also speed up event handling to avoid piling up events in the event queue. Similar tricks can be done to optimize the active polling approach.
passive lines = do
-- disable auto polling in swapBuffers
GLFW.disableSpecial GLFW.AutoPollEvent
-- keep track of whether ESC has been pressed
quit <- newMVar False
-- keep track of whether screen needs to be redrawn
dirty <- newMVar True
-- mark screen dirty in refresh callback which is often called
-- when screen or part of screen comes into visibility.
GLFW.windowRefreshCallback $= (modifyMVar_ dirty (\_ -> return False))
-- use key callback to track whether ESC is pressed
GLFW.keyCallback $= (\k s ->
if fromEnum k == fromEnum GLFW.ESC && s == GLFW.Press
then modifyMVar_ quit (\_ -> return True)
else return ())
-- by default start with waitForPress
waitForPress dirty
loop dirty quit
where
loop dirty quit = do
GLFW.waitEvents
-- redraw screen if dirty
d <- readMVar dirty
if d then (render lines >> GLFW.swapBuffers) else return ()
modifyMVar_ dirty (\_ -> False)
-- check if we need to quit the loop
q <- readMVar quit
if q then return () else loop dirty quit
waitForPress dirty = do
GLFW.mousePosCallback $= (\_ -> return ())
GLFW.mouseButtonCallback $= (\b s ->
if b == GLFW.ButtonLeft && s == GLFW.Press
then do
-- when left mouse button is pressed, add the point
-- to lines and switch to waitForRelease action.
(GL.Position x y) <- GL.get GLFW.mousePos
modifyMVar_ lines (return . ((x,y):) . ((x,y):))
waitForRelease dirty
else return ())
waitForRelease dirty = do
GLFW.mousePosCallback $= (\ (Position x y) -> do
-- update the line with new ending position
modifyMVar_ lines (return . ((x,y):) . tail)
-- mark screen dirty
modifyMVar_ dirty (\_ -> return True))
GLFW.mouseButtonCallback $= (\b s ->
-- when left mouse button is released, switch back to
-- waitForPress action.
if b == GLFW.ButtonLeft && s == GLFW.Release
then waitForPress dirty
else return ())
Just replace active
with passive
in the main
program to run it.
The rest of the program goes below
render lines = do
l <- readMVar lines
GL.clear [GL.ColorBuffer, GL.StencilBuffer]
GL.color $ color3 1 0 0
GL.renderPrimitive GL.Lines $ foldr (>>) (return ()) (map
(\ (x, y) -> GL.vertex (vertex3 (fromIntegral x) (fromIntegral y) 0)) l)
vertex3 :: Float -> Float -> Float -> GL.Vertex3 Float
vertex3 = GL.Vertex3
color3 :: Float -> Float -> Float -> GL.Color3 Float
color3 = GL.Color3