diff --git a/.GLHUI.cabal.swp b/.GLHUI.cabal.swp new file mode 100644 Binary files /dev/null and b/.GLHUI.cabal.swp differ diff --git a/GLHUI.cabal b/GLHUI.cabal new file mode 100644 --- /dev/null +++ b/GLHUI.cabal @@ -0,0 +1,55 @@ +name: GLHUI +version: 1.0.0 +license: BSD3 +license-file: LICENSE +author: Hugo Gomes +maintainer: Hugo Gomes +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 diff --git a/Graphics/UI/GLWindow.hs b/Graphics/UI/GLWindow.hs new file mode 100644 --- /dev/null +++ b/Graphics/UI/GLWindow.hs @@ -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) ) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/c/HsGLWindow.c b/c/HsGLWindow.c new file mode 100644 --- /dev/null +++ b/c/HsGLWindow.c @@ -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; } + diff --git a/include/HsGLWindow.h b/include/HsGLWindow.h new file mode 100644 --- /dev/null +++ b/include/HsGLWindow.h @@ -0,0 +1,24 @@ +#define GL_GLEXT_PROTOTYPES +#define GLX_GLXEXT_PROTOTYPES + +#include +#include +#include +#include +#include + +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 (*)());