aboutsummaryrefslogtreecommitdiff
path: root/Graphics
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics')
-rw-r--r--Graphics/Glyph/BufferBuilder.hs14
-rw-r--r--Graphics/Glyph/GlyphObject.hs38
-rw-r--r--Graphics/Glyph/Mat4.hs11
-rw-r--r--Graphics/Glyph/Textures.hs6
4 files changed, 53 insertions, 16 deletions
diff --git a/Graphics/Glyph/BufferBuilder.hs b/Graphics/Glyph/BufferBuilder.hs
index e9606de..4800d3d 100644
--- a/Graphics/Glyph/BufferBuilder.hs
+++ b/Graphics/Glyph/BufferBuilder.hs
@@ -7,7 +7,6 @@ import Graphics.Rendering.OpenGL
import Foreign.Storable
import Foreign.Ptr
import Data.Array.Storable
-import Data.Setters
import Debug.Trace
import qualified Data.Foldable as Fold
import Data.Sequence as Seq
@@ -56,7 +55,17 @@ instance Show (CompiledBuild x) where
show (CompiledBuild stride enabled n _) =
"[CompiledBuild stride="++!stride++" enabled"++!enabled++" n="++!n++"]"
-instance (Num t) => Monad (Builder t) where
+instance Functor (Builder t) where
+ fmap f b = b >>= (return . f)
+
+instance Applicative (Builder t) where
+ pure = return
+ (<*>) afn aa = do
+ fn <- afn
+ a <- aa
+ return (fn a)
+
+instance Monad (Builder t) where
(Builder lst1 _) >> (Builder lst2 ret) = Builder (lst2 >< lst1) ret
BuildError str >> _ = BuildError str
_ >> BuildError str = BuildError str
@@ -65,7 +74,6 @@ instance (Num t) => Monad (Builder t) where
BuildError str >>= _ = BuildError str
return = Builder empty
- fail = BuildError
{- Add a vertex to the current builder -}
bVertex3 :: (a,a,a) -> Builder a ()
diff --git a/Graphics/Glyph/GlyphObject.hs b/Graphics/Glyph/GlyphObject.hs
index 8a3fe4a..239007d 100644
--- a/Graphics/Glyph/GlyphObject.hs
+++ b/Graphics/Glyph/GlyphObject.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
module Graphics.Glyph.GlyphObject (
- GlyphObject,
+ GlyphObject(..),
getBufferObject,
getCompiledData,
getVertexAttribute,
@@ -30,7 +30,6 @@ module Graphics.Glyph.GlyphObject (
import Graphics.Glyph.BufferBuilder
import Graphics.Glyph.Util
import Graphics.Rendering.OpenGL
-import Data.Setters
import Control.Monad
import Control.Applicative
@@ -53,7 +52,6 @@ data GlyphObject a = GlyphObject {
primitiveMode :: PrimitiveMode
}
-$(declareSetters ''GlyphObject)
getBufferObject :: GlyphObject a -> BufferObject
getBufferObject = bufferObject
@@ -84,6 +82,36 @@ getTeardownRoutine = teardownRoutine
getPrimitiveMode :: GlyphObject a -> PrimitiveMode
getPrimitiveMode = primitiveMode
+setBufferObject :: GlyphObject a -> BufferObject -> GlyphObject a
+setBufferObject o a = o { bufferObject = a }
+
+setCompiledData :: GlyphObject a -> (CompiledBuild GLfloat) -> GlyphObject a
+setCompiledData o a = o { compiledData = a }
+
+setVertexAttribute :: GlyphObject a -> AttribLocation -> GlyphObject a
+setVertexAttribute o a = o { vertexAttribute = a }
+
+setNormalAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
+setNormalAttribute o a = o { normalAttribute = a }
+
+setColorAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
+setColorAttribute o a = o { colorAttribute = a }
+
+setTextureAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
+setTextureAttribute o a = o { textureAttribute = a }
+
+setResources :: GlyphObject a -> a -> GlyphObject a
+setResources o a = o { resources = a }
+
+setSetupRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ())) -> GlyphObject a
+setSetupRoutine o a = o { setupRoutine = a }
+
+setTeardownRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ())) -> GlyphObject a
+setTeardownRoutine o a = o { teardownRoutine = a }
+
+setPrimitiveMode :: GlyphObject a -> PrimitiveMode -> GlyphObject a
+setPrimitiveMode o a = o { primitiveMode = a }
+
newGlyphObject :: Builder GLfloat x ->
AttribLocation ->
Maybe AttribLocation ->
@@ -101,10 +129,10 @@ newGlyphObject builder vertAttr normAttr colorAttr textureAttr res setup tear mo
return $ GlyphObject buffer compiled vertAttr normAttr colorAttr textureAttr res setup tear mode
prepare :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-prepare a b = setSetupRoutine (Just b) a
+prepare a b = a { setupRoutine = (Just b) }
teardown :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-teardown a b = setTeardownRoutine (Just b) a
+teardown a b = a { teardownRoutine = Just b }
instance Drawable (GlyphObject a) where
draw obj@(GlyphObject bo co vAttr nAttr cAttr tAttr _ setup tearDown p) = do
diff --git a/Graphics/Glyph/Mat4.hs b/Graphics/Glyph/Mat4.hs
index 546baa2..6581126 100644
--- a/Graphics/Glyph/Mat4.hs
+++ b/Graphics/Glyph/Mat4.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
module Graphics.Glyph.Mat4 where
import Control.Monad
@@ -9,7 +9,8 @@ import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL
-import Graphics.Rendering.OpenGL.Raw.Core31
+import Graphics.GL.Compatibility30
+-- import Graphics.Rendering.OpenGL.Raw.Core31
data Mat4 a = Matrix (a,a,a,a,
a,a,a,a,
@@ -50,7 +51,7 @@ instance (Storable t) => StorableMatrix t Mat3 where
instance Uniform (Mat4 GLfloat) where
uniform (UniformLocation loc) = makeStateVar getter setter
where setter mat = toPtr mat $ \ptr ->
- glUniformMatrix4fv loc 1 (fromIntegral gl_FALSE) ptr
+ glUniformMatrix4fv loc 1 (fromIntegral GL_FALSE) ptr
getter :: IO (Mat4 GLfloat)
getter = do
pid <- liftM fromIntegral getCurrentProgram
@@ -61,7 +62,7 @@ instance Uniform (Mat4 GLfloat) where
instance Uniform (Mat3 GLfloat) where
uniform (UniformLocation loc) = makeStateVar getter setter
where setter mat = toPtr mat $ \ptr ->
- glUniformMatrix3fv loc 1 (fromIntegral gl_FALSE) ptr
+ glUniformMatrix3fv loc 1 (fromIntegral GL_FALSE) ptr
getter :: IO (Mat3 GLfloat)
getter = do
pid <- liftM fromIntegral getCurrentProgram
@@ -70,7 +71,7 @@ instance Uniform (Mat3 GLfloat) where
fromPtr buf return )
getCurrentProgram :: IO GLint
-getCurrentProgram = alloca $ glGetIntegerv gl_CURRENT_PROGRAM >> peek
+getCurrentProgram = alloca $ \ptr -> glGetIntegerv GL_CURRENT_PROGRAM ptr >> peek ptr
instance (Show a) => Show (Mat4 a) where
show IdentityMatrix =
diff --git a/Graphics/Glyph/Textures.hs b/Graphics/Glyph/Textures.hs
index 7e86d2a..55b18fc 100644
--- a/Graphics/Glyph/Textures.hs
+++ b/Graphics/Glyph/Textures.hs
@@ -3,9 +3,9 @@ module Graphics.Glyph.Textures where
import Data.Array.Storable
import Data.Word
-import Graphics.Rendering.OpenGL.Raw.Core31
import Graphics.Rendering.OpenGL
import Control.Monad
+import Graphics.GL.Compatibility30
data Pixels =
PixelsRGB (Int,Int) (StorableArray Int Word8) |
@@ -32,8 +32,8 @@ attachPixelsToTexture pixels tex =
withStorableArray (pixelsArray pixels) $ \ptr -> do
textureBinding Texture2D $= Just tex
case pixels of
- PixelsRGB (w,h) _ -> glTexImage2D gl_TEXTURE_2D 0 3 (f w) (f h) 0 gl_RGB gl_UNSIGNED_BYTE ptr
- PixelsRGBA (w,h) _ -> glTexImage2D gl_TEXTURE_2D 0 4 (f w) (f h) 0 gl_RGBA gl_UNSIGNED_BYTE ptr
+ PixelsRGB (w,h) _ -> glTexImage2D GL_TEXTURE_2D 0 3 (f w) (f h) 0 GL_RGB GL_UNSIGNED_BYTE ptr
+ PixelsRGBA (w,h) _ -> glTexImage2D GL_TEXTURE_2D 0 4 (f w) (f h) 0 GL_RGBA GL_UNSIGNED_BYTE ptr
where f = fromIntegral
generated by cgit (git 2.34.1) at 2026-02-21 13:52:57 +0000