From b4c3367c63459607f0919e77998d5405634e2003 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Thu, 25 Feb 2010 02:15:26 +0100 Subject: Added texture loading --- Bindings/GLPng.chs | 158 ++++++++++++++++++++++++++++++++++++++++++++ Bindings/GLPng.hs | 189 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Bindings/GLX.chs | 1 - Bindings/GLX.hs | 125 ++++++++++++++++++----------------- HTanks.hs | 16 +++-- Level.hs | 8 +-- Render.hs | 42 +++++++----- Tank.hs | 9 +-- tex/Wood.png | Bin 0 -> 18012 bytes 9 files changed, 454 insertions(+), 94 deletions(-) create mode 100644 Bindings/GLPng.chs create mode 100644 Bindings/GLPng.hs create mode 100644 tex/Wood.png diff --git a/Bindings/GLPng.chs b/Bindings/GLPng.chs new file mode 100644 index 0000000..453bddc --- /dev/null +++ b/Bindings/GLPng.chs @@ -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 +#include + + +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/Bindings/GLPng.hs b/Bindings/GLPng.hs new file mode 100644 index 0000000..6be3b82 --- /dev/null +++ b/Bindings/GLPng.hs @@ -0,0 +1,189 @@ +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# LINE 1 "GLPng.chs" #-} +{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} +{-# LINE 2 "GLPng.chs" #-} + +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) + + + +{-# LINE 21 "GLPng.chs" #-} + +{-# LINE 22 "GLPng.chs" #-} + + +data PngInfo = PngInfo + { pngWidth :: !CUInt + , pngHeight :: !CUInt + , pngDepth :: !CUInt + , pngAlpha :: !CUInt + } deriving (Eq, Ord, Show, Typeable) + +instance Storable PngInfo where + sizeOf _ = ((16)) +{-# LINE 33 "GLPng.chs" #-} + alignment _ = alignment (undefined :: CUInt) + + peek pi = do + w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pi +{-# LINE 37 "GLPng.chs" #-} + h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pi +{-# LINE 38 "GLPng.chs" #-} + d <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pi +{-# LINE 39 "GLPng.chs" #-} + a <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) pi +{-# LINE 40 "GLPng.chs" #-} + + return (PngInfo w h d a) + + poke pi (PngInfo w h d a) = do + ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pi w +{-# LINE 45 "GLPng.chs" #-} + ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) pi h +{-# LINE 46 "GLPng.chs" #-} + ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) pi d +{-# LINE 47 "GLPng.chs" #-} + ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) pi a +{-# LINE 48 "GLPng.chs" #-} + + + + +png_NoMipmap :: CInt +png_NoMipmap = (0) +{-# LINE 54 "GLPng.chs" #-} + +png_BuildMipmap :: CInt +png_BuildMipmap = (-1) +{-# LINE 57 "GLPng.chs" #-} + +png_SimpleMipmap :: CInt +png_SimpleMipmap = (-2) +{-# LINE 60 "GLPng.chs" #-} + + +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 = (-2) +{-# LINE 74 "GLPng.chs" #-} + +png_Solid :: CInt +png_Solid = (-1) +{-# LINE 77 "GLPng.chs" #-} + +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 = (9728) +{-# LINE 93 "GLPng.chs" #-} + +gl_LINEAR :: CInt +gl_LINEAR = (9729) +{-# LINE 96 "GLPng.chs" #-} + +gl_NEAREST_MIPMAP_NEAREST :: CInt +gl_NEAREST_MIPMAP_NEAREST = (9984) +{-# LINE 99 "GLPng.chs" #-} + +gl_LINEAR_MIPMAP_NEAREST :: CInt +gl_LINEAR_MIPMAP_NEAREST = (9985) +{-# LINE 102 "GLPng.chs" #-} + +gl_NEAREST_MIPMAP_LINEAR :: CInt +gl_NEAREST_MIPMAP_LINEAR = (9986) +{-# LINE 105 "GLPng.chs" #-} + +gl_LINEAR_MIPMAP_LINEAR :: CInt +gl_LINEAR_MIPMAP_LINEAR = (9987) +{-# LINE 108 "GLPng.chs" #-} + + +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 = (10496) +{-# LINE 125 "GLPng.chs" #-} + +gl_REPEAT :: CInt +gl_REPEAT = (10497) +{-# LINE 128 "GLPng.chs" #-} + +gl_CLAMP_TO_EDGE :: CInt +gl_CLAMP_TO_EDGE = (33071) +{-# LINE 131 "GLPng.chs" #-} + +gl_CLAMP_TO_BORDER :: CInt +gl_CLAMP_TO_BORDER = (33069) +{-# LINE 134 "GLPng.chs" #-} + +gl_MIRRORED_REPEAT :: CInt +gl_MIRRORED_REPEAT = (33648) +{-# LINE 137 "GLPng.chs" #-} + + +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/Bindings/GLX.chs b/Bindings/GLX.chs index 0f31106..d5fed4d 100644 --- a/Bindings/GLX.chs +++ b/Bindings/GLX.chs @@ -30,7 +30,6 @@ import Data.Word import Foreign.C.String (withCString) import Foreign.C.Types -import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Marshal.Array (peekArray, withArray0) diff --git a/Bindings/GLX.hs b/Bindings/GLX.hs index 4f364e4..65fad11 100644 --- a/Bindings/GLX.hs +++ b/Bindings/GLX.hs @@ -33,7 +33,6 @@ import Data.Word import Foreign.C.String (withCString) import Foreign.C.Types -import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Marshal.Array (peekArray, withArray0) @@ -45,7 +44,7 @@ import Graphics.X11.Xlib.Types (Dimension, Display, Pixel, Position) -{-# LINE 45 "GLX.chs" #-} +{-# LINE 44 "GLX.chs" #-} type Drawable = XID @@ -74,55 +73,55 @@ data VisualInfo = VisualInfo instance Storable VisualInfo where sizeOf _ = ((40)) -{-# LINE 73 "GLX.chs" #-} +{-# LINE 72 "GLX.chs" #-} alignment _ = alignment (undefined :: CULong) peek vi = do visual <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) vi -{-# LINE 77 "GLX.chs" #-} +{-# LINE 76 "GLX.chs" #-} visualid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) vi -{-# LINE 78 "GLX.chs" #-} +{-# LINE 77 "GLX.chs" #-} screen <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) vi -{-# LINE 79 "GLX.chs" #-} +{-# LINE 78 "GLX.chs" #-} depth <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) vi -{-# LINE 80 "GLX.chs" #-} +{-# LINE 79 "GLX.chs" #-} viclass <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) vi -{-# LINE 81 "GLX.chs" #-} +{-# LINE 80 "GLX.chs" #-} red_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) vi -{-# LINE 82 "GLX.chs" #-} +{-# LINE 81 "GLX.chs" #-} green_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) vi -{-# LINE 83 "GLX.chs" #-} +{-# LINE 82 "GLX.chs" #-} blue_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) vi -{-# LINE 84 "GLX.chs" #-} +{-# LINE 83 "GLX.chs" #-} colormap_size <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) vi -{-# LINE 85 "GLX.chs" #-} +{-# LINE 84 "GLX.chs" #-} bits_per_rgb <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) vi -{-# LINE 86 "GLX.chs" #-} +{-# LINE 85 "GLX.chs" #-} 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 ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) vi visual -{-# LINE 92 "GLX.chs" #-} +{-# LINE 91 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) vi visualid -{-# LINE 93 "GLX.chs" #-} +{-# LINE 92 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) vi screen -{-# LINE 94 "GLX.chs" #-} +{-# LINE 93 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) vi depth -{-# LINE 95 "GLX.chs" #-} +{-# LINE 94 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) vi viclass -{-# LINE 96 "GLX.chs" #-} +{-# LINE 95 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) vi red_mask -{-# LINE 97 "GLX.chs" #-} +{-# LINE 96 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) vi green_mask -{-# LINE 98 "GLX.chs" #-} +{-# LINE 97 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) vi blue_mask -{-# LINE 99 "GLX.chs" #-} +{-# LINE 98 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) vi colormap_size -{-# LINE 100 "GLX.chs" #-} +{-# LINE 99 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) vi bits_per_rgb -{-# LINE 101 "GLX.chs" #-} +{-# LINE 100 "GLX.chs" #-} data SetWindowAttributes = SetWindowAttributes @@ -144,38 +143,38 @@ data SetWindowAttributes = SetWindowAttributes instance Storable SetWindowAttributes where sizeOf _ = ((60)) -{-# LINE 122 "GLX.chs" #-} +{-# LINE 121 "GLX.chs" #-} alignment _ = alignment (undefined :: CULong) peek swa = do background_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) swa -{-# LINE 126 "GLX.chs" #-} +{-# LINE 125 "GLX.chs" #-} background_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) swa -{-# LINE 127 "GLX.chs" #-} +{-# LINE 126 "GLX.chs" #-} border_pixmap <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) swa -{-# LINE 128 "GLX.chs" #-} +{-# LINE 127 "GLX.chs" #-} bit_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) swa -{-# LINE 129 "GLX.chs" #-} +{-# LINE 128 "GLX.chs" #-} win_gravity <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) swa -{-# LINE 130 "GLX.chs" #-} +{-# LINE 129 "GLX.chs" #-} backing_store <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) swa -{-# LINE 131 "GLX.chs" #-} +{-# LINE 130 "GLX.chs" #-} backing_planes <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) swa -{-# LINE 132 "GLX.chs" #-} +{-# LINE 131 "GLX.chs" #-} backing_pixel <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) swa -{-# LINE 133 "GLX.chs" #-} +{-# LINE 132 "GLX.chs" #-} save_under <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) swa -{-# LINE 134 "GLX.chs" #-} +{-# LINE 133 "GLX.chs" #-} event_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) swa -{-# LINE 135 "GLX.chs" #-} +{-# LINE 134 "GLX.chs" #-} do_not_propagate_mask <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) swa -{-# LINE 136 "GLX.chs" #-} +{-# LINE 135 "GLX.chs" #-} override_redirect <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) swa -{-# LINE 137 "GLX.chs" #-} +{-# LINE 136 "GLX.chs" #-} colormap <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) swa -{-# LINE 138 "GLX.chs" #-} +{-# LINE 137 "GLX.chs" #-} cursor <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) swa -{-# LINE 139 "GLX.chs" #-} +{-# LINE 138 "GLX.chs" #-} return (SetWindowAttributes background_pixmap @@ -209,33 +208,33 @@ instance Storable SetWindowAttributes where colormap cursor) = do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) swa background_pixmap -{-# LINE 172 "GLX.chs" #-} +{-# LINE 171 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) swa background_pixel -{-# LINE 173 "GLX.chs" #-} +{-# LINE 172 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) swa border_pixmap -{-# LINE 174 "GLX.chs" #-} +{-# LINE 173 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) swa bit_gravity -{-# LINE 175 "GLX.chs" #-} +{-# LINE 174 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) swa win_gravity -{-# LINE 176 "GLX.chs" #-} +{-# LINE 175 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) swa backing_store -{-# LINE 177 "GLX.chs" #-} +{-# LINE 176 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) swa backing_planes -{-# LINE 178 "GLX.chs" #-} +{-# LINE 177 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) swa backing_pixel -{-# LINE 179 "GLX.chs" #-} +{-# LINE 178 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) swa save_under -{-# LINE 180 "GLX.chs" #-} +{-# LINE 179 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) swa event_mask -{-# LINE 181 "GLX.chs" #-} +{-# LINE 180 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 44)) swa do_not_propagate_mask -{-# LINE 182 "GLX.chs" #-} +{-# LINE 181 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) swa override_redirect -{-# LINE 183 "GLX.chs" #-} +{-# LINE 182 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 52)) swa colormap -{-# LINE 184 "GLX.chs" #-} +{-# LINE 183 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) swa cursor -{-# LINE 185 "GLX.chs" #-} +{-# LINE 184 "GLX.chs" #-} nullSetWindowAttributes :: SetWindowAttributes nullSetWindowAttributes = (SetWindowAttributes 0 0 0 0 0 0 0 0 False 0 0 False 0 0) @@ -254,13 +253,13 @@ foreign import ccall unsafe "GL/glx.h XSetClassHint" setClassHint :: Display -> Window -> ClassHint -> IO () setClassHint disp wnd hint = allocaBytes ((8)) $ \p -> -{-# LINE 203 "GLX.chs" #-} +{-# LINE 202 "GLX.chs" #-} withCString (resName hint) $ \res_name -> withCString (resClass hint) $ \res_class -> do ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p res_name -{-# LINE 206 "GLX.chs" #-} +{-# LINE 205 "GLX.chs" #-} ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p res_class -{-# LINE 207 "GLX.chs" #-} +{-# LINE 206 "GLX.chs" #-} xSetClassHint disp wnd p @@ -278,35 +277,35 @@ chooseFBConfig disp sc attr = alloca $ \n -> withArray0 (fromIntegral none) (con renderType :: CInt renderType = (32785) -{-# LINE 224 "GLX.chs" #-} +{-# LINE 223 "GLX.chs" #-} rgbaBit :: CInt rgbaBit = (1) -{-# LINE 227 "GLX.chs" #-} +{-# LINE 226 "GLX.chs" #-} drawableType :: CInt drawableType = (32784) -{-# LINE 230 "GLX.chs" #-} +{-# LINE 229 "GLX.chs" #-} windowBit :: CInt windowBit = (1) -{-# LINE 233 "GLX.chs" #-} +{-# LINE 232 "GLX.chs" #-} xRenderable :: CInt xRenderable = (32786) -{-# LINE 236 "GLX.chs" #-} +{-# LINE 235 "GLX.chs" #-} doublebuffer :: CInt doublebuffer = (5) -{-# LINE 239 "GLX.chs" #-} +{-# LINE 238 "GLX.chs" #-} depthSize :: CInt depthSize = (12) -{-# LINE 242 "GLX.chs" #-} +{-# LINE 241 "GLX.chs" #-} stencilSize :: CInt stencilSize = (13) -{-# LINE 245 "GLX.chs" #-} +{-# LINE 244 "GLX.chs" #-} foreign import ccall unsafe "GL/glx.h glXGetVisualFromFBConfig" glXGetVisualFromFBConfig :: Display -> FBConfig -> IO (Ptr VisualInfo) diff --git a/HTanks.hs b/HTanks.hs index 77684e4..27b5755 100644 --- a/HTanks.hs +++ b/HTanks.hs @@ -39,10 +39,11 @@ main = do when (initialized gl) $ do currentTime <- getCurrentTime let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty} - gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0]} + gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2]} - setup 800 600 - runGame gameState $ runMain mainState $ mainLoop + runGame gameState $ do + setup 800 600 + runMain mainState mainLoop deinitGL gl @@ -90,10 +91,11 @@ simulationStep = do when (lengthsq /= 0) $ do let length = sqrt lengthsq - let dx = fromRational (round (x*1000/length)%1000000) - dy = fromRational (round (y*1000/length)%1000000) - oldtank <- lift $ gets (head . tanks) + + let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000) + dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000) + let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank} lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)} @@ -107,7 +109,7 @@ handleEvents = do handleEvent :: SomeEvent -> Main () handleEvent ev - | Just (ResizeEvent w h) <- fromEvent ev = liftIO $ resize w h + | Just (ResizeEvent w h) <- fromEvent ev = lift $ resize w h | Just (KeyPressEvent key) <- fromEvent ev = modify $ \state -> state {keyset = S.insert key (keyset state)} | Just (KeyReleaseEvent key) <- fromEvent ev = modify $ \state -> state {keyset = S.delete key (keyset state)} | Just QuitEvent <- fromEvent ev = modify $ \state -> state {run = False} diff --git a/Level.hs b/Level.hs index c18104e..c99a4b5 100644 --- a/Level.hs +++ b/Level.hs @@ -5,14 +5,14 @@ module Level ( Level(..) import Data.List data Level = Level - { floorTiles :: ![[Int]] - , objectTiles :: ![[Int]] + { levelWidth :: !Int + , levelHeight :: !Int } deriving (Show) testLevel :: Level testLevel = Level - { floorTiles = replicate 10 $ replicate 10 0 - , objectTiles = replicate 10 $ replicate 10 0 + { levelWidth = 10 + , levelHeight = 10 } \ No newline at end of file diff --git a/Render.hs b/Render.hs index ec34e78..a38e462 100644 --- a/Render.hs +++ b/Render.hs @@ -5,52 +5,64 @@ module Render ( setup import Game +import Level import Tank +import Bindings.GLPng + import Control.Monad.State import Data.Fixed import Data.Ratio -import Graphics.Rendering.OpenGL.GL (($=), GLfloat) +import Graphics.Rendering.OpenGL.GL (($=), GLfloat, GLdouble) import Graphics.Rendering.OpenGL.GL.BeginEnd (renderPrimitive, PrimitiveMode(..)) import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), viewport, Position(..), Size(..), loadIdentity, ortho) import Graphics.Rendering.OpenGL.GL.Framebuffer (clear, ClearBuffer(..)) +import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter) import Graphics.Rendering.OpenGL.GL.VertexSpec -setup :: Int -> Int -> IO () +setup :: Int -> Int -> Game () setup w h = do resize w h + (tex, info) <- liftIO $ pngBind "tex/Wood.png" NoMipmap Solid (Repeated, Repeat) (Linear', Nothing) Linear' + liftIO $ print info + -resize :: Int -> Int -> IO () +resize :: Int -> Int -> Game () resize w h = do let wn = fromIntegral w hn = fromIntegral h - aspect = wn/hn + aspect = fromReal (wn/hn) - matrixMode $= Projection - loadIdentity - ortho (-aspect) (aspect) (-1) 1 (-1) 1 + lvl <- gets level + let s = max (0.5*(fromIntegral $ levelWidth lvl)/aspect) (0.5*(fromIntegral $ levelHeight lvl)) :: GLdouble - matrixMode $= Modelview 0 - - viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) + liftIO $ do + matrixMode $= Projection + loadIdentity + ortho (-s*aspect) (s*aspect) (-s) s (-1) 1 + + matrixMode $= Modelview 0 + + viewport $= ((Position 0 0), (Size (fromIntegral w) (fromIntegral h))) render :: Game () render = do tank <- liftM head $ gets tanks - let x = toFloat . posx $ tank - y = toFloat . posy $ tank + let x = fromReal . posx $ tank + y = fromReal . posy $ tank liftIO $ do clear [ColorBuffer] - renderPrimitive Triangles $ do + renderPrimitive Quads $ do vertex $ Vertex2 (x-0.5 :: GLfloat) (y-0.5 :: GLfloat) + vertex $ Vertex2 (x-0.5 :: GLfloat) (y+0.5 :: GLfloat) vertex $ Vertex2 (x+0.5 :: GLfloat) (y+0.5 :: GLfloat) vertex $ Vertex2 (x+0.5 :: GLfloat) (y-0.5 :: GLfloat) -toFloat :: Real a => a -> GLfloat -toFloat = fromRational . toRational \ No newline at end of file +fromReal :: (Real a, Fractional b) => a -> b +fromReal = fromRational . toRational \ No newline at end of file diff --git a/Tank.hs b/Tank.hs index 54322cf..28f286c 100644 --- a/Tank.hs +++ b/Tank.hs @@ -4,8 +4,9 @@ module Tank ( Tank(..) import Data.Fixed data Tank = Tank - { posx :: !Micro - , posy :: !Micro - , dir :: !Micro - , aim :: !Micro + { posx :: !Micro + , posy :: !Micro + , dir :: !Micro + , aim :: !Micro + , speed :: !Micro } deriving Show diff --git a/tex/Wood.png b/tex/Wood.png new file mode 100644 index 0000000..84077c6 Binary files /dev/null and b/tex/Wood.png differ -- cgit v1.2.3