GLHUI (empty) → 1.0.0

raw patch · 8 files changed

+440/−0 lines, 8 filesdep +basesetup-changedbinary-added

Dependencies added: base

Files

.GLHUI.cabal.swp binary
GLHUI.cabal +55/−0
Graphics/UI/GLWindow.hs +117/−0
LICENSE +28/−0
README +1/−0
Setup.lhs +3/−0
c/HsGLWindow.c +212/−0
include/HsGLWindow.h +24/−0

+ .GLHUI.cabal.swp view

binary file changed (absent → 12288 bytes)

+ GLHUI.cabal view

@@ -0,0 +1,55 @@+name: GLHUI+version: 1.0.0+license: BSD3+license-file: LICENSE+author: Hugo Gomes <mr.hugo.gomes@gmail.com>+maintainer: Hugo Gomes <mr.hugo.gomes@gmail.com>+copyright: Hugo Gomes+homepage: http://www.hackological.com/projects/GLHUI+category: Graphics+synopsis: Open OpenGL context windows in X11 with libX11+description:+   .+   Haskell functions to open and manage a OpenGL window with libX11.+   .+   This module is intended to be imported qualified, to avoid clashes with+   Prelude functions, e.g.+   .+   > import qualified Graphics.UI.GLWindow as Window+   .+   As an example, here is a simple module that uses some of these functions +   to open a OpenGL 3.2 Context: +   .+   > module Main where                                                     +   >  +   > import Graphics.Rendering.OpenGL    +   > import qualified Graphics.UI.GLWindow as Window    +   > +   > myLoop = do clear [ColorBuffer]    +   >             t <- Window.time    +   >             clearColor $= Color4 (sin (realToFrac t) * 0.5 + 0.5)+   >                                  (sin (realToFrac (t+1)) * 0.5 + 0.5)+   >                                  (sin (realToFrac (t+2)) * 0.5 +0.5)+   >                                  0                                              +   > +   > main = do Window.init 3 2 -- initializes a OpenGL 3.2 context+   >           Window.loop myLoop -- stops when the ESC key is pressed+   >           Window.kill -- removes the window when the loop stops+   .+   Special thanks to Tiago Farto (aka xernobyl) for coding the C version of+   these functions+build-type: Simple+cabal-version: >=1.6+extra-source-files:+   README++library+   build-depends:+      base < 5+   exposed-modules:+      Graphics.UI.GLWindow+   include-dirs: include+   c-sources:+      c/HsGLWindow.c+   ghc-options: -Wall -O2+   extra-libraries: X11 GL rt

+ Graphics/UI/GLWindow.hs view

@@ -0,0 +1,117 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- |                                                                            +-- Module      : Graphics.UI.GLWindow+-- Copyright   : (c) 2011 Hugo Gomes+--                                                                              +-- License     : BSD-style                                                      +-- Maintainer  : mr.hugo.gomes@gmail.com+-- Stability   : experimental                                                   +-- Portability : GHC                                                            +--                                                                              +-- A simple OpenGL window creator that runs on X.Org with libX11.+-- This module allows the creation of different versions of OpenGL contexts+-- by initializing with the required versions.+--                                                                              +-- /Note/: The Haskell only has bindings up to OpenGL 3.2 +--    This module is intended to be imported qualified, to avoid clashes with      +--   Prelude functions, e.g.                                                      +--+--   > import qualified Graphics.UI.GLWindow as Window                            +--                                                                               +--   As an example, here is a simple module that uses some of these functions     +--   to open a OpenGL 3.2 Context:                                                +--                                                                               +--   > module Main where                                                          +--   >                                                                            +--   > import Graphics.Rendering.OpenGL                                           +--   > import qualified Graphics.UI.GLWindow as Window                            +--   >                                                                            +--   > myLoop = do clear [ColorBuffer]                                            +--   >             t <- Window.time                                               +--   >             clearColor $= Color4 (sin (realToFrac t) * 0.5 + 0.5)          +--   >                                  (sin (realToFrac (t+1)) * 0.5 + 0.5)      +--   >                                  (sin (realToFrac (t+2)) * 0.5 +0.5)       +--   >                                  0                                              +--   >                                                                            +--   > main = do Window.init 3 2 -- initializes a OpenGL 3.2 context              +--   >           Window.loop myLoop -- stops when the ESC key is pressed          +--   >           Window.kill -- removes the window when the loop stops            +--   ++module Graphics.UI.GLWindow +    (+    -- * Types+    LoopFunc+    -- * Window initialization+    , init+    , setFullscreen+    -- * Window elimination+    , kill+    -- * Window state query+    , frame+    , time+    , dtime+    , width+    , height+    , scrWidth+    , scrHeight+    -- * Loop+    , loop+    ) where++import Foreign.C+import Foreign.Ptr+import Control.Applicative+import Prelude hiding (init)++foreign import ccall unsafe "WindowInit" +  c_init :: CUInt -> CUInt -> IO (CInt)+init :: Integer -> Integer -> IO (Integer)+init glMajor glMinor = fromIntegral <$> c_init (fromIntegral glMajor) (fromIntegral glMinor)+foreign import ccall unsafe "WindowKill" +  kill :: IO ()++foreign import ccall unsafe "WindowSetFullscreen" +  c_fullscreen :: CInt -> IO ()+setFullscreen :: Bool -> IO ()+setFullscreen f = if f then c_fullscreen 1+                       else c_fullscreen 0++foreign import ccall unsafe "WindowFrame" +  c_frame :: IO (CUInt)+frame :: IO (Integer)+frame = fromIntegral <$> c_frame+foreign import ccall unsafe "WindowTime" +  c_time   :: IO (CDouble)+time :: IO (Double)+time = realToFrac <$> c_time+foreign import ccall unsafe "WindowDTime" +  c_dtime :: IO (CDouble)+dtime :: IO (Double)+dtime = realToFrac <$> c_dtime++foreign import ccall unsafe "WindowWidth" +  c_width :: IO (CUInt)+width :: IO (Integer)+width = fromIntegral <$> c_width+foreign import ccall unsafe "WindowHeight" +  c_height :: IO (CUInt)+height :: IO (Integer)+height = fromIntegral <$> c_height+foreign import ccall unsafe "WindowScrWidth" +  c_scrWidth :: IO (CUInt)+scrWidth :: IO (Integer)+scrWidth = fromIntegral <$> c_scrWidth+foreign import ccall unsafe "WindowScrHeight" +  c_scrHeight :: IO (CUInt)+scrHeight :: IO (Integer)+scrHeight = fromIntegral <$> c_scrHeight++type LoopFunc = IO ()+foreign import ccall "WindowLoop" +  c_loop :: FunPtr (LoopFunc) -> IO ()+loop :: LoopFunc -> IO ()+loop lf = mkLoop lf >>= c_loop ++foreign import ccall "wrapper"+  mkLoop :: LoopFunc -> IO( FunPtr (LoopFunc) )

+ LICENSE view

@@ -0,0 +1,28 @@+Copyright (c) 2011, Hugo Gomes+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+   used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ README view

@@ -0,0 +1,1 @@+

+ Setup.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ c/HsGLWindow.c view

@@ -0,0 +1,212 @@+#include "HsGLWindow.h"++static Display *display;+static Window window;+static GLXContext context;+static int width, height, scrwidth, scrheight;+static unsigned frame = 0;+static double ftime, dtime;+static int fullscreen = 0;++typedef struct+{+    unsigned long	flags;+    unsigned long	functions;+    unsigned long	decorations;+    long			inputMode;+    unsigned long	status;+} Hints;+++void WindowSetFullscreen(int f)+{+	XWindowChanges changes;+	Hints hints;+	+	Atom property = XInternAtom(display,"_MOTIF_WM_HINTS",True);++	hints.flags = 2;++	if(f)+	{	+		hints.decorations = False;+	+		changes.x = 0;+		changes.y = 0;+		changes.width = width = scrwidth;+		changes.height = height = scrheight;+		changes.stack_mode = Above;++		fullscreen = 1;+	}+	else+	{+		hints.decorations = True;++		changes.x = scrwidth/4;+		changes.y = scrheight/4;+		changes.width = width = scrwidth/2;+		changes.height = height = scrheight/2;+		changes.stack_mode = Above;++		fullscreen = 0;+	}++	XChangeProperty(display, window, property, property, 32, PropModeReplace, (unsigned char *)&hints, 5);+	XConfigureWindow(display, window, CWX | CWY | CWWidth | CWHeight | CWStackMode, &changes);++	//XGrabKeyboard(display, window, True, GrabModeAsync, GrabModeAsync, CurrentTime);+	//XGrabPointer(display, window, True, ButtonPressMask, GrabModeAsync, GrabModeAsync, window, None, CurrentTime);+	//XMapRaised(display, window);+}+++int WindowInit(unsigned int const major, unsigned int const minor)+{+	static const int glattr[] =+	{+		GLX_RENDER_TYPE, GLX_RGBA_BIT,+		GLX_X_RENDERABLE, 1,+		GLX_DOUBLEBUFFER, 1,+		GLX_RED_SIZE, 8,+		GLX_GREEN_SIZE, 8,+		GLX_BLUE_SIZE, 8,+		0+	};++	int gl3attr[] =+	{+		GLX_CONTEXT_MAJOR_VERSION_ARB, major,+		GLX_CONTEXT_MINOR_VERSION_ARB, minor,+		GLX_CONTEXT_FLAGS_ARB, GLX_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB,+		0+	};++	if(!(display = XOpenDisplay(0)))+	{+		puts("Could not open display.\n");+		return -1;+	}++	int nscreen = DefaultScreen(display);+	scrwidth = XDisplayWidth(display, nscreen);+	scrheight = XDisplayHeight(display, nscreen);+	+	width = scrwidth / 2;+	height = scrheight / 2;++	static XVisualInfo *visual;+	if(!(visual = glXChooseVisual(display, nscreen, (int*)glattr)))+	{+		puts("Could not find a visual.\n");+		return -2;+	}+	+	int elemc;+	GLXFBConfig *fbcfg = glXChooseFBConfig(display, nscreen, glattr, &elemc);+	if(!fbcfg)+	{+		puts("Could not find FB config.\n");+		return -3;+	}++	context = glXCreateContextAttribsARB(display, fbcfg[0], 0, 1, gl3attr);++	Window root = RootWindow(display, visual->screen);++	XSetWindowAttributes xattr;+	xattr.event_mask = KeyPressMask | ButtonPressMask | StructureNotifyMask;+	xattr.colormap = XCreateColormap(display, root, visual->visual, AllocNone);++	window = XCreateWindow(display, root, 0, 0, width, height, 0, visual->depth, InputOutput, visual->visual, CWColormap | CWEventMask, &xattr);+	XSetStandardProperties(display, window, "United Colors Of Funk", 0, None, 0, 0, 0);++	XGrabKeyboard(display, window, True, GrabModeAsync, GrabModeAsync, CurrentTime);+	XGrabPointer(display, window, True, ButtonPressMask, GrabModeAsync, GrabModeAsync, window, None, CurrentTime);+	XMapRaised(display, window);++	glXMakeCurrent(display, window, context);+	glViewport(0, 0, width, height);++	XFree(fbcfg);+	XFree(visual);++	printf("OpenGL:\n\tvendor %s\n\trenderer %s\n\tversion %s\n\tshader language %s\n", glGetString(GL_VENDOR), glGetString(GL_RENDERER), glGetString(GL_VERSION), glGetString(GL_SHADING_LANGUAGE_VERSION));++	return 1;+}+++void WindowLoop(void (*Loop)())+{+	struct timespec ts[3];	// even, odd, initial+	int done = 0;+	XEvent event;++	clock_gettime(CLOCK_MONOTONIC, ts+2);+	ts[0] = ts[1] = ts[2];++	while(!done)+	{+		while(XPending(display) > 0)+		{+			XNextEvent(display, &event);+			switch(event.type)+			{+			case ConfigureNotify:+				if((event.xconfigure.width != width) || (event.xconfigure.height != height))+				{+					width = event.xconfigure.width;+					height = event.xconfigure.height;+					glViewport(0, 0, width, height);+				}+				break;++			case ButtonPress:+				done = 1;+				break;++			case KeyPress:+				if(XLookupKeysym(&event.xkey, 0) == XK_Escape)+					done = 1;+				else if(XLookupKeysym(&event.xkey, 0) == XK_F1)+					WindowSetFullscreen(!fullscreen);+				break;+			}+		}++		Loop();+		glXSwapBuffers(display, window);+		frame++;+		clock_gettime(CLOCK_MONOTONIC, ts+(frame%2));+		dtime = 1e-9*(ts[frame%2].tv_nsec - ts[!(frame%2)].tv_nsec) + (ts[frame%2].tv_sec - ts[!(frame%2)].tv_sec);+		ftime = 1e-9*(ts[frame%2].tv_nsec - ts[2].tv_nsec) + (ts[frame%2].tv_sec - ts[2].tv_sec);+	}++	//WindowKill(0);+}+++void WindowKill(const char *str)+{+	puts(str);++	if(context)+	{+		glXMakeCurrent(display, 0, 0);+		glXDestroyContext(display, context);+		context = 0;+	}++	XCloseDisplay(display);+}+++unsigned WindowFrame(){ return frame; }+double WindowTime(){ return ftime; }+double WindowDTime(){ return dtime; }+unsigned WindowWidth(){ return width; }+unsigned WindowHeight(){ return height; }+unsigned WindowScrWidth(){ return scrwidth; }+unsigned WindowScrHeight(){ return scrheight; }+

+ include/HsGLWindow.h view

@@ -0,0 +1,24 @@+#define GL_GLEXT_PROTOTYPES+#define GLX_GLXEXT_PROTOTYPES++#include <stdio.h>+#include <time.h>+#include <X11/Xlib.h>+#include <GL/gl.h>+#include <GL/glx.h>++int WindowInit(unsigned int const major, unsigned int const minor);+void WindowKill();++void WindowSetFullscreen(int f);++unsigned WindowFrame();+double WindowTime();+double WindowDTime();++unsigned WindowWidth();+unsigned WindowHeight();+unsigned WindowScrWidth();+unsigned WindowScrHeight();++void WindowLoop(void (*)());