diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Bindings/GLPng.hsc | 158 | ||||
| -rw-r--r-- | src/Bindings/GLX.hsc | 265 | ||||
| -rw-r--r-- | src/CPUPlayer.hs | 19 | ||||
| -rw-r--r-- | src/DefaultPlayer.hs | 36 | ||||
| -rw-r--r-- | src/GLDriver.hs | 67 | ||||
| -rw-r--r-- | src/GLX.hs | 214 | ||||
| -rw-r--r-- | src/Game.hs | 52 | ||||
| -rw-r--r-- | src/HTanks.hs | 199 | ||||
| -rw-r--r-- | src/Level.hs | 18 | ||||
| -rw-r--r-- | src/Player.hs | 27 | ||||
| -rw-r--r-- | src/Render.hs | 167 | ||||
| -rw-r--r-- | src/Texture.hs | 8 |
12 files changed, 1230 insertions, 0 deletions
diff --git a/src/Bindings/GLPng.hsc b/src/Bindings/GLPng.hsc new file mode 100644 index 0000000..453bddc --- /dev/null +++ b/src/Bindings/GLPng.hsc @@ -0,0 +1,158 @@ +{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} + +module Bindings.GLPng ( PngInfo(..) + , Mipmap(..) + , Trans (..) + , pngBind + ) where + +import Data.Generics + +import Foreign.C.String (CString, withCString) +import Foreign.C.Types +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr +import Foreign.Storable + +import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) + + +#include <GL/gl.h> +#include <GL/glpng.h> + + +data PngInfo = PngInfo + { pngWidth :: !CUInt + , pngHeight :: !CUInt + , pngDepth :: !CUInt + , pngAlpha :: !CUInt + } deriving (Eq, Ord, Show, Typeable) + +instance Storable PngInfo where + sizeOf _ = (#size pngInfo) + alignment _ = alignment (undefined :: CUInt) + + peek pi = do + w <- (#peek pngInfo, Width) pi + h <- (#peek pngInfo, Height) pi + d <- (#peek pngInfo, Depth) pi + a <- (#peek pngInfo, Alpha) pi + + return (PngInfo w h d a) + + poke pi (PngInfo w h d a) = do + (#poke pngInfo, Width) pi w + (#poke pngInfo, Height) pi h + (#poke pngInfo, Depth) pi d + (#poke pngInfo, Alpha) pi a + + + + +png_NoMipmap :: CInt +png_NoMipmap = (#const PNG_NOMIPMAP) + +png_BuildMipmap :: CInt +png_BuildMipmap = (#const PNG_BUILDMIPMAP) + +png_SimpleMipmap :: CInt +png_SimpleMipmap = (#const PNG_SIMPLEMIPMAP) + + +data Mipmap = NoMipmap | BuildMipmap | SimpleMipmap + deriving (Eq, Show) + +marshalMipmap :: Mipmap -> CInt +marshalMipmap m + | m == NoMipmap = png_NoMipmap + | m == BuildMipmap = png_BuildMipmap + | m == SimpleMipmap = png_SimpleMipmap + + +png_Alpha :: CInt +png_Alpha = (#const PNG_ALPHA) + +png_Solid :: CInt +png_Solid = (#const PNG_SOLID) + +data Trans = Alpha | Solid + deriving (Eq, Show) + +marshalTrans :: Trans -> CInt +marshalTrans t + | t == Alpha = png_Alpha + | t == Solid = png_Solid + + +magToMin :: MagnificationFilter -> MinificationFilter +magToMin magFilter = (magFilter, Nothing) + + +gl_NEAREST :: CInt +gl_NEAREST = (#const GL_NEAREST) + +gl_LINEAR :: CInt +gl_LINEAR = (#const GL_LINEAR) + +gl_NEAREST_MIPMAP_NEAREST :: CInt +gl_NEAREST_MIPMAP_NEAREST = (#const GL_NEAREST_MIPMAP_NEAREST) + +gl_LINEAR_MIPMAP_NEAREST :: CInt +gl_LINEAR_MIPMAP_NEAREST = (#const GL_LINEAR_MIPMAP_NEAREST) + +gl_NEAREST_MIPMAP_LINEAR :: CInt +gl_NEAREST_MIPMAP_LINEAR = (#const GL_NEAREST_MIPMAP_LINEAR) + +gl_LINEAR_MIPMAP_LINEAR :: CInt +gl_LINEAR_MIPMAP_LINEAR = (#const GL_LINEAR_MIPMAP_LINEAR) + + +marshalMinificationFilter :: MinificationFilter -> CInt +marshalMinificationFilter x = fromIntegral $ case x of + (Nearest, Nothing ) -> gl_NEAREST + (Linear', Nothing ) -> gl_LINEAR + (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST + (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST + (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR + (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR + +marshalMagnificationFilter :: MagnificationFilter -> CInt +marshalMagnificationFilter = marshalMinificationFilter . magToMin + + +gl_CLAMP :: CInt +gl_CLAMP = (#const GL_CLAMP) + +gl_REPEAT :: CInt +gl_REPEAT = (#const GL_REPEAT) + +gl_CLAMP_TO_EDGE :: CInt +gl_CLAMP_TO_EDGE = (#const GL_CLAMP_TO_EDGE) + +gl_CLAMP_TO_BORDER :: CInt +gl_CLAMP_TO_BORDER = (#const GL_CLAMP_TO_BORDER) + +gl_MIRRORED_REPEAT :: CInt +gl_MIRRORED_REPEAT = (#const GL_MIRRORED_REPEAT) + + +marshalTextureWrapMode :: (Repetition, Clamping) -> CInt +marshalTextureWrapMode x = fromIntegral $ case x of + (Repeated, Clamp) -> gl_CLAMP + (Repeated, Repeat) -> gl_REPEAT + (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE + (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER + (Mirrored, Repeat) -> gl_MIRRORED_REPEAT + _ -> error ("marshalTextureWrapMode: illegal value " ++ show x) + +foreign import ccall unsafe "GL/glpng.h pngBind" + rawPngBind :: CString -> CInt -> CInt -> Ptr PngInfo -> CInt -> CInt -> CInt -> IO CUInt + + +pngBind :: String -> Mipmap -> Trans -> (Repetition, Clamping) -> MinificationFilter -> MagnificationFilter -> IO (CUInt, PngInfo) +pngBind name mipmap trans wrapst minfilter magfilter = alloca $ \infop -> withCString name $ \cname -> do + ret <- rawPngBind cname (marshalMipmap mipmap) (marshalTrans trans) infop (marshalTextureWrapMode wrapst) + (marshalMinificationFilter minfilter) (marshalMagnificationFilter magfilter) + info <- peek infop + return (ret, info) +
\ No newline at end of file diff --git a/src/Bindings/GLX.hsc b/src/Bindings/GLX.hsc new file mode 100644 index 0000000..d5fed4d --- /dev/null +++ b/src/Bindings/GLX.hsc @@ -0,0 +1,265 @@ +{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} + +module Bindings.GLX ( createColormap + , createWindow + , setClassHint + , chooseFBConfig + , getVisualFromFBConfig + , VisualInfo(..) + , SetWindowAttributes(..) + , nullSetWindowAttributes + , renderType + , rgbaBit + , drawableType + , windowBit + , xRenderable + , doublebuffer + , depthSize + , stencilSize + , createContext + , makeCurrent + , destroyContext + , swapBuffers + , Context(..) + , Drawable + ) where + +import Data.Generics +import Data.Int +import Data.Word + +import Foreign.C.String (withCString) +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Marshal.Array (peekArray, withArray0) +import Foreign.Storable + +import Graphics.X11.Types (AttributeMask, Colormap, ColormapAlloc, Cursor, EventMask, Pixmap, Window, WindowClass, VisualID, XID) +import Graphics.X11.Xlib.Extras (none, xFree, ClassHint, resName, resClass, TextProperty) +import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) + + +#include <GL/glx.h> + + +type Drawable = XID + +newtype FBConfig = FBConfig (Ptr FBConfig) + deriving (Eq, Ord, Show, Typeable, Data, Storable) + +newtype Context = Context (Ptr Context) + deriving (Eq, Ord, Show, Typeable, Data, Storable) + +newtype Visual = Visual (Ptr Visual) + deriving (Eq, Ord, Show, Typeable, Data, Storable) + +data VisualInfo = VisualInfo + { viVisual :: !Visual + , viVisualid :: !VisualID + , viScreen :: !CInt + , viDepth :: !CInt + , viClass :: !CInt + , viRedMask :: !CULong + , viGreenMask :: !CULong + , viBlueMask :: !CULong + , viColormapSize :: !CInt + , viBitsPerRgb :: !CInt + } deriving (Eq, Ord, Show, Typeable) + +instance Storable VisualInfo where + sizeOf _ = (#size XVisualInfo) + alignment _ = alignment (undefined :: CULong) + + peek vi = do + visual <- (#peek XVisualInfo, visual) vi + visualid <- (#peek XVisualInfo, visualid) vi + screen <- (#peek XVisualInfo, screen) vi + depth <- (#peek XVisualInfo, depth) vi + viclass <- (#peek XVisualInfo, class) vi + red_mask <- (#peek XVisualInfo, red_mask) vi + green_mask <- (#peek XVisualInfo, green_mask) vi + blue_mask <- (#peek XVisualInfo, blue_mask) vi + colormap_size <- (#peek XVisualInfo, colormap_size) vi + bits_per_rgb <- (#peek XVisualInfo, bits_per_rgb) vi + + return (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) + + + poke vi (VisualInfo visual visualid screen depth viclass red_mask green_mask blue_mask colormap_size bits_per_rgb) = do + (#poke XVisualInfo, visual) vi visual + (#poke XVisualInfo, visualid) vi visualid + (#poke XVisualInfo, screen) vi screen + (#poke XVisualInfo, depth) vi depth + (#poke XVisualInfo, class) vi viclass + (#poke XVisualInfo, red_mask) vi red_mask + (#poke XVisualInfo, green_mask) vi green_mask + (#poke XVisualInfo, blue_mask) vi blue_mask + (#poke XVisualInfo, colormap_size) vi colormap_size + (#poke XVisualInfo, bits_per_rgb) vi bits_per_rgb + + +data SetWindowAttributes = SetWindowAttributes + { swaBackgroundPixmap :: !Pixmap + , swaBackgroundPixel :: !Pixel + , swaBorderPixmap :: !Pixmap + , swaBitGravity :: !CInt + , swaWinGravity :: !CInt + , swaBackingStore :: !CInt + , swaBackingPlanes :: !CULong + , swaBackingPixel :: !CULong + , swaSaveUnder :: !Bool + , swaEventMask :: !EventMask + , swaDoNotPropagateMask :: !CULong + , swaOverrideRedirect :: !Bool + , swaColormap :: !Colormap + , swaCursor :: !Cursor + } deriving (Eq, Ord, Show, Typeable) + +instance Storable SetWindowAttributes where + sizeOf _ = (#size XSetWindowAttributes) + alignment _ = alignment (undefined :: CULong) + + peek swa = do + background_pixmap <- (#peek XSetWindowAttributes, background_pixmap) swa + background_pixel <- (#peek XSetWindowAttributes, background_pixel) swa + border_pixmap <- (#peek XSetWindowAttributes, border_pixmap) swa + bit_gravity <- (#peek XSetWindowAttributes, bit_gravity) swa + win_gravity <- (#peek XSetWindowAttributes, win_gravity) swa + backing_store <- (#peek XSetWindowAttributes, backing_store) swa + backing_planes <- (#peek XSetWindowAttributes, backing_planes) swa + backing_pixel <- (#peek XSetWindowAttributes, backing_pixel) swa + save_under <- (#peek XSetWindowAttributes, save_under) swa + event_mask <- (#peek XSetWindowAttributes, event_mask) swa + do_not_propagate_mask <- (#peek XSetWindowAttributes, do_not_propagate_mask) swa + override_redirect <- (#peek XSetWindowAttributes, override_redirect) swa + colormap <- (#peek XSetWindowAttributes, colormap) swa + cursor <- (#peek XSetWindowAttributes, cursor) swa + + return (SetWindowAttributes + background_pixmap + background_pixel + border_pixmap + bit_gravity + win_gravity + backing_store + backing_planes + backing_pixel + save_under + event_mask + do_not_propagate_mask + override_redirect + colormap + cursor) + + poke swa (SetWindowAttributes + background_pixmap + background_pixel + border_pixmap + bit_gravity + win_gravity + backing_store + backing_planes + backing_pixel + save_under + event_mask + do_not_propagate_mask + override_redirect + colormap + cursor) = do + (#poke XSetWindowAttributes, background_pixmap) swa background_pixmap + (#poke XSetWindowAttributes, background_pixel) swa background_pixel + (#poke XSetWindowAttributes, border_pixmap) swa border_pixmap + (#poke XSetWindowAttributes, bit_gravity) swa bit_gravity + (#poke XSetWindowAttributes, win_gravity) swa win_gravity + (#poke XSetWindowAttributes, backing_store) swa backing_store + (#poke XSetWindowAttributes, backing_planes) swa backing_planes + (#poke XSetWindowAttributes, backing_pixel) swa backing_pixel + (#poke XSetWindowAttributes, save_under) swa save_under + (#poke XSetWindowAttributes, event_mask) swa event_mask + (#poke XSetWindowAttributes, do_not_propagate_mask) swa do_not_propagate_mask + (#poke XSetWindowAttributes, override_redirect) swa override_redirect + (#poke XSetWindowAttributes, colormap) swa colormap + (#poke XSetWindowAttributes, cursor) swa cursor + +nullSetWindowAttributes :: SetWindowAttributes +nullSetWindowAttributes = (SetWindowAttributes 0 0 0 0 0 0 0 0 False 0 0 False 0 0) + + +foreign import ccall unsafe "GL/glx.h XCreateColormap" + createColormap :: Display -> Window -> Visual -> ColormapAlloc -> IO Colormap + +foreign import ccall unsafe "GL/glx.h XCreateWindow" + createWindow :: Display -> Window -> Position -> Position -> + Dimension -> Dimension -> CInt -> CInt -> WindowClass -> + Visual -> AttributeMask -> Ptr SetWindowAttributes -> IO Window + +foreign import ccall unsafe "GL/glx.h XSetClassHint" + xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO () + +setClassHint :: Display -> Window -> ClassHint -> IO () +setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p -> + withCString (resName hint) $ \res_name -> + withCString (resClass hint) $ \res_class -> do + (#poke XClassHint, res_name) p res_name + (#poke XClassHint, res_class) p res_class + xSetClassHint disp wnd p + + +foreign import ccall unsafe "GL/glx.h glXChooseFBConfig" + glXChooseFBConfig :: Display -> CInt -> Ptr CInt -> Ptr CInt -> IO (Ptr FBConfig) + +chooseFBConfig :: Display -> CInt -> [(CInt, CInt)] -> IO [FBConfig] +chooseFBConfig disp sc attr = alloca $ \n -> withArray0 (fromIntegral none) (concatMap (\(a,b) -> [a,b]) attr) $ \attrp -> do + configs <- glXChooseFBConfig disp sc attrp n + nelements <- peek n + configlist <- peekArray (fromIntegral nelements) configs + xFree configs + return configlist + + +renderType :: CInt +renderType = (#const GLX_RENDER_TYPE) + +rgbaBit :: CInt +rgbaBit = (#const GLX_RGBA_BIT) + +drawableType :: CInt +drawableType = (#const GLX_DRAWABLE_TYPE) + +windowBit :: CInt +windowBit = (#const GLX_WINDOW_BIT) + +xRenderable :: CInt +xRenderable = (#const GLX_X_RENDERABLE) + +doublebuffer :: CInt +doublebuffer = (#const GLX_DOUBLEBUFFER) + +depthSize :: CInt +depthSize = (#const GLX_DEPTH_SIZE) + +stencilSize :: CInt +stencilSize = (#const GLX_STENCIL_SIZE) + +foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig" + glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo) + +getVisualFromFBConfig :: Display -> FBConfig -> IO (VisualInfo) +getVisualFromFBConfig disp config = do + viptr <- glXGetVisualFromFBConfig disp config + vi <- peek viptr + xFree viptr + return vi + +foreign import ccall unsafe "GL/glx.h glXCreateContext" + createContext :: Display -> Ptr VisualInfo -> Context -> Bool -> IO Context + +foreign import ccall unsafe "GL/glx.h glXMakeCurrent" + makeCurrent :: Display -> Drawable -> Context -> IO Bool + +foreign import ccall unsafe "GL/glx.h glXDestroyContext" + destroyContext :: Display -> Context -> IO () + +foreign import ccall unsafe "GL/glx.h glXSwapBuffers" + swapBuffers :: Display -> Drawable -> IO () diff --git a/src/CPUPlayer.hs b/src/CPUPlayer.hs new file mode 100644 index 0000000..0276de3 --- /dev/null +++ b/src/CPUPlayer.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module CPUPlayer ( CPUPlayer(..) + ) where + + +import Data.Fixed +import Data.Ratio ((%)) +import Data.Typeable + +import GLDriver +import Player + + +data CPUPlayer = CPUPlayer Micro + deriving (Typeable, Show) + +instance Player CPUPlayer where + playerUpdate (CPUPlayer angle) _ = (CPUPlayer (if (angle+0.1) > 180 then angle-359.9 else angle+0.1), Just angle, True, Just (-angle), False) diff --git a/src/DefaultPlayer.hs b/src/DefaultPlayer.hs new file mode 100644 index 0000000..af9aaf5 --- /dev/null +++ b/src/DefaultPlayer.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DeriveDataTypeable, PatternGuards #-} + +module DefaultPlayer ( DefaultPlayer(..) + ) where + + +import qualified Data.Set as S +import Data.Fixed +import Data.Ratio ((%)) +import Data.Typeable + +import Game (Tank(..)) +import GLDriver +import Player + + +data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool + deriving (Typeable, Show) + +instance Player DefaultPlayer where + playerUpdate (DefaultPlayer keys aimx aimy shoot) tank = + let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0) + y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0) + ax = aimx - (fromRational . toRational . tankX $ tank) + ay = aimy - (fromRational . toRational . tankY $ tank) + move = (x /= 0 || y /= 0) + angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing + aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing + in (DefaultPlayer keys aimx aimy False, angle, move, aangle, shoot) + + handleEvent (DefaultPlayer keys aimx aimy shoot) ev + | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy shoot + | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy shoot + | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y shoot + | Just (MousePressEvent x y) <- fromEvent ev = DefaultPlayer keys x y True + | otherwise = DefaultPlayer keys aimx aimy shoot diff --git a/src/GLDriver.hs b/src/GLDriver.hs new file mode 100644 index 0000000..7340075 --- /dev/null +++ b/src/GLDriver.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} + +module GLDriver ( Driver(..) + , SomeDriver(..) + , Event + , SomeEvent(..) + , fromEvent + , QuitEvent(..) + , Key(..) + , KeyPressEvent(..) + , KeyReleaseEvent(..) + , MouseMotionEvent(..) + , MousePressEvent(..) + ) where + +import Data.Typeable + + +class Driver a where + initialized :: a -> Bool + + initGL :: a -> IO a + deinitGL :: a -> IO () + + swapBuffers :: a -> IO () + + nextEvent :: a -> IO (a, Maybe SomeEvent) + +data SomeDriver = forall d. Driver d => SomeDriver d + +instance Driver SomeDriver where + initialized (SomeDriver d) = initialized d + initGL (SomeDriver d) = initGL d >>= return . SomeDriver + deinitGL (SomeDriver d) = deinitGL d + swapBuffers (SomeDriver d) = swapBuffers d + nextEvent (SomeDriver d) = nextEvent d >>= \(gl, ev) -> return (SomeDriver gl, ev) + + +class (Typeable a, Show a) => Event a + +data SomeEvent = forall a. Event a => SomeEvent a +instance Show SomeEvent where + show (SomeEvent a) = show a + +fromEvent :: Event a => SomeEvent -> Maybe a +fromEvent (SomeEvent a) = cast a + + +data QuitEvent = QuitEvent deriving (Typeable, Show) +instance Event QuitEvent + + +data Key = KeyLeft | KeyRight | KeyUp | KeyDown + deriving (Eq, Ord, Show) + +data KeyPressEvent = KeyPressEvent Key deriving (Typeable, Show) +instance Event KeyPressEvent + +data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show) +instance Event KeyReleaseEvent + + +data MouseMotionEvent = MouseMotionEvent Float Float deriving (Typeable, Show) +instance Event MouseMotionEvent + +data MousePressEvent = MousePressEvent Float Float deriving (Typeable, Show) +instance Event MousePressEvent diff --git a/src/GLX.hs b/src/GLX.hs new file mode 100644 index 0000000..6f5b0fc --- /dev/null +++ b/src/GLX.hs @@ -0,0 +1,214 @@ +module GLX ( glxDriver + ) where + +import GLDriver +import Bindings.GLX + +import Control.Monad (when, unless) + +import Data.Bits ((.|.)) +import Data.Maybe (isJust) +import Data.Ratio + +import Graphics.Rendering.OpenGL.GL (($=), GLdouble, GLfloat, Vector3(..), Capability(..)) +import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho, translate) + +import Graphics.X11.Types +import Graphics.X11.Xlib.Atom (internAtom) +import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow) +import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending) +import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data, ev_x, ev_y, getWindowAttributes, wa_width, wa_height) +import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols) +import Graphics.X11.Xlib.Types +import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName) + +import Foreign.Marshal.Utils (with) +import Foreign.Ptr +import Foreign.Storable + + + +data GLX = GLX + { glxDisplay :: !Display + , glxWindow :: !Window + , glxContext :: !Context + , glxDeleteWindow :: !Atom + , glxScale :: !Rational + , glxLevelWidth :: !Int + , glxLevelHeight :: !Int + } + +glxDriver :: Int -> Int -> GLX +glxDriver w h = GLX + { glxDisplay = Display nullPtr + , glxWindow = 0 + , glxContext = Context nullPtr + , glxDeleteWindow = 0 + , glxScale = 1 + , glxLevelWidth = w + , glxLevelHeight = h + } + + +instance Driver GLX where + initialized glx = ((glxContext glx) /= (Context nullPtr)) + + initGL glx = do + when (initialized glx) $ fail "GLX already initialized" + + disp <- openDisplay "" + delwnd <- internAtom disp "WM_DELETE_WINDOW" False + fbconfigs <- chooseFBConfig disp (fromIntegral . defaultScreen $ disp) + [ (renderType, rgbaBit) + , (drawableType, windowBit) + , (doublebuffer, 1) + , (xRenderable, 1) + , (depthSize, 1) + , (stencilSize, 1) + ] + visualinfo <- getVisualFromFBConfig disp (head fbconfigs) + rootwindow <- rootWindow disp (fromIntegral $ viScreen visualinfo) + cmap <- createColormap disp rootwindow (viVisual visualinfo) allocNone + + let swa = nullSetWindowAttributes {swaColormap = cmap, swaEventMask = structureNotifyMask .|. keyPressMask .|. keyReleaseMask .|. pointerMotionMask .|. buttonPressMask} + + wnd <- with swa $ \swaptr -> + createWindow disp rootwindow 0 0 800 600 0 (fromIntegral $ viDepth visualinfo) inputOutput (viVisual visualinfo) (cWBorderPixel.|.cWColormap.|.cWEventMask) swaptr + + setClassHint disp wnd (ClassHint "HTanks" "htanks") + setWMProtocols disp wnd [delwnd] + + storeName disp wnd "HTanks" + + mapWindow disp wnd + + waitForMapNotify disp wnd + + ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True + makeCurrent disp wnd ctx + + wa <- getWindowAttributes disp wnd + s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . wa_width $ wa) (fromIntegral . wa_height $ wa) + + return glx + { glxDisplay = disp + , glxWindow = wnd + , glxContext = ctx + , glxDeleteWindow = delwnd + , glxScale = s + } + + deinitGL glx = do + destroyWindow (glxDisplay glx) (glxWindow glx) + destroyContext (glxDisplay glx) (glxContext glx) + + swapBuffers glx = Bindings.GLX.swapBuffers (glxDisplay glx) (glxWindow glx) + + nextEvent glx = allocaXEvent $ nextEvent' glx + + +nextEvent' :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent) +nextEvent' glx xevent = do + p <- pending $ glxDisplay glx + if (p > 0) then do + Graphics.X11.Xlib.Event.nextEvent (glxDisplay glx) xevent + (newglx, ev) <- handleEvent glx xevent + + if isJust ev then + return (newglx, ev) + else + nextEvent' newglx xevent + else + return (glx, Nothing) + + +handleEvent :: GLX -> XEventPtr -> IO (GLX, Maybe SomeEvent) +handleEvent glx xevent = do + event <- getEvent xevent + let evtype = ev_event_type event + case () of + _ | evtype == configureNotify -> do + s <- resize (glxLevelWidth glx) (glxLevelHeight glx) (fromIntegral . ev_width $ event) (fromIntegral . ev_height $ event) + return (glx {glxScale = s}, Nothing) + | evtype == keyPress -> do + keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 + case () of + _ | keysym == xK_Escape -> return (glx, Just $ SomeEvent QuitEvent) + | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp) + | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown) + | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft) + | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight) + | keysym == xK_w -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyUp) + | keysym == xK_s -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyDown) + | keysym == xK_a -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyLeft) + | keysym == xK_d -> return (glx, Just $ SomeEvent $ KeyPressEvent KeyRight) + | otherwise -> return (glx, Nothing) + | evtype == keyRelease -> do + keysym <- keycodeToKeysym (glxDisplay glx) (ev_keycode event) 0 + case () of + _ | keysym == xK_Up -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp) + | keysym == xK_Down -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown) + | keysym == xK_Left -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft) + | keysym == xK_Right -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight) + | keysym == xK_w -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyUp) + | keysym == xK_s -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyDown) + | keysym == xK_a -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyLeft) + | keysym == xK_d -> return (glx, Just $ SomeEvent $ KeyReleaseEvent KeyRight) + | otherwise -> return (glx, Nothing) + | evtype == clientMessage -> do + if ((glxDeleteWindow glx) == (fromIntegral . head . ev_data $ event)) + then + return (glx, Just $ SomeEvent QuitEvent) + else + return (glx, Nothing) + | evtype == motionNotify -> do + (x, y) <- windowToGameCoords glx (ev_x event) (ev_y event) + wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx) + return (glx, Just $ SomeEvent $ MouseMotionEvent x y) + | evtype == buttonPress -> do + (x, y) <- windowToGameCoords glx (ev_x event) (ev_y event) + wa <- getWindowAttributes (glxDisplay glx) (glxWindow glx) + return (glx, Just $ SomeEvent $ MousePressEvent x y) + + | otherwise -> return (glx, Nothing) + + +windowToGameCoords :: Integral a => GLX -> a -> a -> IO (Float, Float) +windowToGameCoords glx x y = getWindowAttributes (glxDisplay glx) (glxWindow glx) >>= \wa -> + let w = fromIntegral . wa_width $ wa + h = fromIntegral . wa_height $ wa + in return (((-w/2 + wx)/s + lw/2), ((h/2 - wy)/s + lh/2)) + where s = fromRational . glxScale $ glx + lw = fromIntegral . glxLevelWidth $ glx + lh = fromIntegral . glxLevelHeight $ glx + wx = fromIntegral x + wy = fromIntegral y + + +resize :: Int -> Int -> Int -> Int -> IO Rational +resize lw lh w h = do + let aspect = (fromIntegral w)%(fromIntegral h) + s = (max ((fromIntegral lw)/aspect) (fromIntegral lh))/2 + sf = fromRational s + aspectf = fromRational aspect + + matrixMode $= Projection + loadIdentity + ortho (-sf*aspectf) (sf*aspectf) (-sf) sf (-1) 1 + translate $ Vector3 (-(fromIntegral lw)/2) (-(fromIntegral lh)/2) (0 :: GLfloat) + + matrixMode $= Modelview 0 + + viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) + + return $ (fromIntegral h)/(2*s) + +waitForMapNotify :: Display -> Window -> IO () +waitForMapNotify disp wnd = allocaXEvent waitForMapNotify' + where + waitForMapNotify' event = do + Graphics.X11.Xlib.Event.nextEvent disp event + window <- get_Window event + eventType <- get_EventType event + unless (window == wnd && eventType == mapNotify) $ + waitForMapNotify' event diff --git a/src/Game.hs b/src/Game.hs new file mode 100644 index 0000000..b31009e --- /dev/null +++ b/src/Game.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Game ( Tank(..) + , Shoot(..) + , GameState(..) + , Game + , runGame + ) where + +import Level +import Texture + +import Control.Monad +import Control.Monad.State +import Data.Fixed +import qualified Data.Map as M + + +data Tank = Tank + { tankX :: !Micro + , tankY :: !Micro + , tankDir :: !Micro + , tankAim :: !Micro + , tankSpeed :: !Micro + , tankTurnspeed :: !Micro + , tankMoving :: !Bool + , tankShootSpeed :: !Micro + , tankShootBounces :: !Int + , tankShootsLeft :: !Int + } deriving Show + +data Shoot = Shoot + { shootX :: !Micro + , shootY :: !Micro + , shootDir :: !Micro + , shootSpeed :: !Micro + , shootBouncesLeft :: !Int + , shootTank :: !Int + } deriving Show + +data GameState = GameState + { level :: !Level + , tanks :: ![Tank] + , shoots :: ![Shoot] + , textures :: !(M.Map Texture TextureObject) + } deriving (Show) + +newtype Game a = Game (StateT GameState IO a) + deriving (Monad, MonadIO, MonadState GameState) + +runGame :: GameState -> Game a -> IO (a, GameState) +runGame st (Game a) = runStateT a st diff --git a/src/HTanks.hs b/src/HTanks.hs new file mode 100644 index 0000000..6d07cb6 --- /dev/null +++ b/src/HTanks.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE PatternGuards, GeneralizedNewtypeDeriving #-} + +import Game +import Level +import Render +import Player +import CPUPlayer +import DefaultPlayer + +import GLDriver +import GLX + +import Control.Concurrent (threadDelay) +import Control.Monad.State +import Data.Fixed +import Data.Maybe +import qualified Data.Map as M +import Data.Ratio +import qualified Data.Set as S +import Data.Time.Clock + + +data MainState = MainState + { run :: !Bool + , driver :: !SomeDriver + , time :: !UTCTime + , players :: ![SomePlayer] + } + +newtype MainT m a = MainT (StateT MainState m a) + deriving (Monad, MonadState MainState, MonadIO, MonadTrans) + +type Main = MainT Game + +runMain :: MainState -> Main a -> Game (a, MainState) +runMain st (MainT a) = runStateT a st + + +main :: IO () +main = do + let theLevel = testLevel + gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel) + + when (initialized gl) $ do + currentTime <- getCurrentTime + let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = + [ SomePlayer $ DefaultPlayer S.empty 0 0 False + , SomePlayer $ CPUPlayer 0 + ]} + gameState = GameState {level = theLevel, tanks = [ Tank 5.0 5.0 0 0 2 270 False 3 2 5 + , Tank 5.0 3.5 0 0 2 270 False 3 2 5 + ], shoots = [], textures = M.empty} + + runGame gameState $ do + setup + runMain mainState mainLoop + + deinitGL gl + +minFrameTime :: NominalDiffTime +minFrameTime = 0.01 + +mainLoop :: Main () +mainLoop = do + gl <- gets driver + t <- gets time + handleEvents + + lift render + + liftIO $ swapBuffers gl + + rtime <- liftIO getCurrentTime + let drender = diffUTCTime rtime t + when (drender < minFrameTime) $ + liftIO $ threadDelay $ truncate $ 1e6*(minFrameTime - drender) + + currenttime <- liftIO getCurrentTime + let d = round $ 1e3*(diffUTCTime currenttime t) + + replicateM_ d simulationStep + + let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t + + modify $ \state -> state {time = newtime} + + runnext <- gets run + when runnext mainLoop + + +updateAngle :: Micro -> State Tank () +updateAngle angle = do + oldangle <- gets tankDir + tspeed <- gets tankTurnspeed >>= return . (/1000) + + let diff = angle - oldangle + let diff360 = if (diff > 180) + then (diff-360) + else if (diff <= -180) + then (diff+360) + else diff + + let (diff180, angle180) = if (diff360 > 90) + then (diff360-180, oldangle+180) + else if (diff360 <= -90) + then (diff360+180, oldangle-180) + else (diff360, oldangle) + + let turn = if (diff180 > tspeed) + then tspeed + else if (diff180 < -tspeed) + then (-tspeed) + else diff180 + + let newangle = angle180 + turn + + let newangle180 = if (newangle > 180) + then (newangle-360) + else if (newangle <= -180) + then (newangle+360) + else newangle + + modify $ \tank -> tank {tankDir = newangle180} + + +updateTank :: Maybe Micro -> Bool -> Maybe Micro -> State Tank () +updateTank angle move aangle = do + when (isJust angle) $ + updateAngle $ fromJust angle + + when (isJust aangle) $ + modify $ \tank -> tank {tankAim = fromJust aangle} + + when move $ do + tdir <- gets tankDir + tspeed <- gets tankSpeed + moved <- gets tankMoving + + when (isNothing angle || (isJust angle && (tdir == fromJust angle)) || moved) $ do + let anglej = (fromRational . toRational $ tdir)*pi/180 + x = tspeed * fromRational (round ((cos anglej)*1000)%1000000) + y = tspeed * fromRational (round ((sin anglej)*1000)%1000000) + + modify $ \tank -> tank {tankX = x + tankX tank, tankY = y + tankY tank, tankMoving = True} + + when (not move) $ do + modify $ \tank -> tank {tankMoving = False} + + +updateShoot :: State Shoot () +updateShoot = do + angle <- gets shootDir >>= return . (/180) . (*pi) . fromRational . toRational + speed <- gets shootSpeed + let dx = speed * fromRational (round ((cos angle)*1000)%1000000) + dy = speed * fromRational (round ((sin angle)*1000)%1000000) + + modify $ \shoot -> shoot {shootX = dx + shootX shoot, shootY = dy + shootY shoot} + + +simulationStep :: Main () +simulationStep = do + oldplayers <- gets players + oldtanks <- lift $ gets tanks + + let (p, t, s) = unzip3 $ map updateTank' $ zip oldplayers oldtanks + ts = zip3 t s [0..] + shootingtanks = map (\(tank, _, n) -> (tank, n)) $ filter (\(tank, shoot, _) -> shoot && (tankShootsLeft tank) > 0) $ ts + newtanks = map (\(tank, shoot, _) -> if shoot then tank {tankShootsLeft = (tankShootsLeft tank) - 1} else tank) $ ts + newshoots = map (\(tank, n) -> Shoot + { shootX = tankX tank + , shootY = tankY tank + , shootDir = tankAim tank + , shootSpeed = tankShootSpeed tank + , shootBouncesLeft = tankShootBounces tank + , shootTank = n + }) shootingtanks + + + modify $ \state -> state {players = p} + lift $ modify $ \state -> state {tanks = newtanks, shoots = map (execState updateShoot) (shoots state ++ newshoots)} + where + updateTank' (player, tank) = let (p, angle, move, aangle, shoot) = playerUpdate player tank + t = execState (updateTank angle move aangle) tank + in (p, t, shoot) + + +handleEvents :: Main () +handleEvents = do + (newgl, event) <- gets driver >>= liftIO . nextEvent + modify $ \state -> state {driver = newgl} + when (isJust event) $ do + Main.handleEvent $ fromJust event + modify $ \state -> state {players = map (\p -> Player.handleEvent p $ fromJust event) $ players state} + handleEvents + +handleEvent :: SomeEvent -> Main () +handleEvent ev + | Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False} + | otherwise = return () diff --git a/src/Level.hs b/src/Level.hs new file mode 100644 index 0000000..c99a4b5 --- /dev/null +++ b/src/Level.hs @@ -0,0 +1,18 @@ +module Level ( Level(..) + , testLevel + ) where + +import Data.List + +data Level = Level + { levelWidth :: !Int + , levelHeight :: !Int + } deriving (Show) + + + +testLevel :: Level +testLevel = Level + { levelWidth = 10 + , levelHeight = 10 + }
\ No newline at end of file diff --git a/src/Player.hs b/src/Player.hs new file mode 100644 index 0000000..baf1cbe --- /dev/null +++ b/src/Player.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} + +module Player ( Player(..) + , SomePlayer(..) + ) where + +import Data.Fixed +import Data.Typeable + +import Game (Tank(..)) +import GLDriver (SomeEvent) + + +class Player a where + playerUpdate :: a -> Tank -> (a, Maybe Micro, Bool, Maybe Micro, Bool) + handleEvent :: a -> SomeEvent -> a + + handleEvent player _ = player + + +data SomePlayer = forall a. Player a => SomePlayer a + +instance Player SomePlayer where + playerUpdate (SomePlayer player) tank = + let (p, angle, move, aangle, shoot) = playerUpdate player tank + in (SomePlayer p, angle, move, aangle, shoot) + handleEvent (SomePlayer player) event = SomePlayer $ handleEvent player event diff --git a/src/Render.hs b/src/Render.hs new file mode 100644 index 0000000..d1276a3 --- /dev/null +++ b/src/Render.hs @@ -0,0 +1,167 @@ +module Render ( setup + , render + ) where + + +import Paths_htanks +import Game +import Level +import Texture + +import Control.Monad.State + +import Data.Fixed +import Data.Maybe +import Data.Ratio +import qualified Data.Map as M + +import Bindings.GLPng + +import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble, Capability(..), Vector3(..)) +import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..)) +import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, preservingMatrix, ortho, translate, rotate) +import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..)) +import Graphics.Rendering.OpenGL.GL.PerFragment (blend, blendFunc, BlendingFactor(..)) +import Graphics.Rendering.OpenGL.GL.Texturing.Application (texture) +import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding, TextureObject(..)) +import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) +import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..)) +import Graphics.Rendering.OpenGL.GL.VertexSpec + + +texturePath :: Texture -> IO FilePath +texturePath t = getDataFileName $ path t + where + path TextureWood = "tex/Wood.png" + path TextureTank = "tex/Tank.png" + path TextureCannon = "tex/Cannon.png" + path TextureBullet = "tex/Bullet.png" + +getTexture :: Texture -> Game TextureObject +getTexture t = do + ts <- gets textures + let tobj = M.lookup t ts + + if (isJust tobj) + then + return $ fromJust tobj + else do + path <- liftIO $ texturePath t + tex <- liftIO $ pngBind path BuildMipmap Alpha (Repeated, Repeat) (Linear', Just Linear') Linear' >>= return . TextureObject . fromIntegral . fst + modify $ \state -> state {textures = M.insert t tex ts} + return tex + + +setup :: Game () +setup = do + liftIO $ do + blend $= Enabled + blendFunc $= (SrcAlpha, OneMinusSrcAlpha) + + -- cache textures + getTexture TextureWood + getTexture TextureTank + getTexture TextureCannon + getTexture TextureBullet + + return () + + +render :: Game () +render = do + tanklist <- gets tanks + shootlist <- gets shoots + + textureWood <- getTexture TextureWood + textureTank <- getTexture TextureTank + textureCannon <- getTexture TextureCannon + textureBullet <- getTexture TextureBullet + + (lw, lh) <- gets level >>= \l -> return (fromIntegral . levelWidth $ l :: GLfloat, fromIntegral . levelHeight $ l :: GLfloat) + + liftIO $ do + clear [ColorBuffer] + + texture Texture2D $= Enabled + textureBinding Texture2D $= Just textureWood + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 0 lh + + texCoord $ TexCoord2 lw 0 + vertex $ Vertex2 lw lh + + texCoord $ TexCoord2 lw lh + vertex $ Vertex2 lw 0 + + texCoord $ TexCoord2 0 lh + vertex $ Vertex2 (0 :: GLfloat) (0 :: GLfloat) + + forM_ tanklist $ \tank -> preservingMatrix $ do + let x = fromReal . tankX $ tank + y = fromReal . tankY $ tank + rotDir = fromReal . tankDir $ tank + rotAim = fromReal . tankAim $ tank + + translate $ Vector3 x y (0 :: GLfloat) + rotate rotDir $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureTank + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) + + texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat) + + rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureCannon + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat) + + texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat) + + forM_ shootlist $ \shoot -> preservingMatrix $ do + let x = fromReal . shootX $ shoot + y = fromReal . shootY $ shoot + rotDir = fromReal . shootDir $ shoot + + translate $ Vector3 x y (0 :: GLfloat) + rotate rotDir $ Vector3 0 0 (1 :: GLfloat) + + textureBinding Texture2D $= Just textureBullet + + renderPrimitive Quads $ do + texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat) + + texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat) + + texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat) + vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat) + + +fromReal :: (Real a, Fractional b) => a -> b +fromReal = fromRational . toRational
\ No newline at end of file diff --git a/src/Texture.hs b/src/Texture.hs new file mode 100644 index 0000000..bf89cf9 --- /dev/null +++ b/src/Texture.hs @@ -0,0 +1,8 @@ +module Texture ( Texture(..) + , TextureObject + ) where + +import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) + +data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet + deriving (Eq, Ord, Show) |