aboutsummaryrefslogtreecommitdiff
path: root/Graphics
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics')
-rw-r--r--Graphics/Glyph/BufferBuilder.hs33
-rw-r--r--Graphics/Glyph/GLMath.hs14
-rw-r--r--Graphics/Glyph/Mat4.hs18
3 files changed, 32 insertions, 33 deletions
diff --git a/Graphics/Glyph/BufferBuilder.hs b/Graphics/Glyph/BufferBuilder.hs
index 43447a1..9dae0aa 100644
--- a/Graphics/Glyph/BufferBuilder.hs
+++ b/Graphics/Glyph/BufferBuilder.hs
@@ -4,19 +4,15 @@
{-# LANGUAGE MultiParamTypeClasses #-}
module Graphics.Glyph.BufferBuilder where
-import Control.Monad
import Graphics.Rendering.OpenGL
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Array
import Data.Array.Storable
-import Data.Setters
-import Debug.Trace
import qualified Data.Foldable as Fold
import Data.Sequence as Seq
import Data.Map as Map
-import Graphics.Glyph.Mat4
import Graphics.Glyph.Util
import Graphics.Glyph.GLMath
@@ -117,7 +113,7 @@ instance (Num t) => Monad (BuilderM t) where
| otherwise = Builder b1 b2
(Builder !b1 !b2) ><> leaf@(LeafBuilder !_) =
(Builder b1 (b2 ><> leaf))
- builder1 ><> builder2 = (Builder builder1 builder2)
+ builder1' ><> builder2' = (Builder builder1' builder2')
b1@(BuilderM _ ret) >>= func = b1 >> func ret
@@ -126,33 +122,33 @@ instance (Num t) => Monad (BuilderM t) where
instance Functor Builder where
fmap f (Builder b1 b2) = (Builder (fmap f b1) (fmap f b2))
- fmap f (LeafBuilder seq) = (LeafBuilder (fmap f seq))
+ fmap f (LeafBuilder seq') = (LeafBuilder (fmap f seq'))
instance Fold.Foldable Builder where
foldl f ini (Builder b1 b2) =
Fold.foldl f (Fold.foldl f ini b1) b2
- foldl f ini (LeafBuilder seq) =
- Fold.foldl f ini seq
+ foldl f ini (LeafBuilder seq') =
+ Fold.foldl f ini seq'
foldr f ini (Builder b1 b2) =
Fold.foldr f (Fold.foldr f ini b2) b1
- foldr f ini (LeafBuilder seq) =
- Fold.foldr f ini seq
+ foldr f ini (LeafBuilder seq') =
+ Fold.foldr f ini seq'
expandBuilder :: Builder a -> b -> (b -> a -> (b,[a])) -> Builder a
expandBuilder builder ini f = snd $ expandBuilder' builder ini f
where expandBuilder' :: Builder a -> b -> (b -> a -> (b,[a])) -> (b,Builder a)
- expandBuilder' (Builder builder1 builder2) ini f =
- let (snowball1,newBuilder1) = expandBuilder' builder1 ini f
- (snowball2,newBuilder2) = expandBuilder' builder2 snowball1 f in
+ expandBuilder' (Builder builder1 builder2) ini' f' =
+ let (snowball1,newBuilder1) = expandBuilder' builder1 ini' f'
+ (snowball2,newBuilder2) = expandBuilder' builder2 snowball1 f' in
(snowball2,Builder newBuilder1 newBuilder2)
- expandBuilder' (LeafBuilder seq1) ini f =
- let (seq,snow) = Fold.foldl' (\(seq', snow) datum ->
- let (snow',lst) = f snow datum in
- (seq' >< Seq.fromList lst,snow')) (Seq.empty,ini) seq1 in
- (snow,LeafBuilder seq)
+ expandBuilder' (LeafBuilder seq1) initial func =
+ let (sequ,snow) = Fold.foldl' (\(seq', snowball) datum ->
+ let (snow',lst) = func snowball datum in
+ (seq' >< Seq.fromList lst,snow')) (Seq.empty,initial) seq1 in
+ (snow,LeafBuilder sequ)
{- Add a vertex to the current builder -}
bVertex3 :: (a,a,a) -> BuilderM a ()
@@ -313,4 +309,3 @@ translating trans (BuilderM builder ret) = do
case datum of
VertexLink tup -> VertexLink $ zipWithT3 (+) tup trans
_ -> datum) ret
-translating _ x = x
diff --git a/Graphics/Glyph/GLMath.hs b/Graphics/Glyph/GLMath.hs
index cd0fd53..b1df4c5 100644
--- a/Graphics/Glyph/GLMath.hs
+++ b/Graphics/Glyph/GLMath.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -XFlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
module Graphics.Glyph.GLMath where
import Graphics.Glyph.Mat4
import qualified Graphics.Rendering.OpenGL as GL
@@ -19,6 +19,7 @@ module Graphics.Glyph.GLMath where
GL.get (uniform loc)
return (Vec3 (x,y,z)) )
(\(Vec3 (x,y,z)) -> uniform loc GL.$= Vertex3 x y z)
+ uniformv _ = undefined
instance UniformComponent a => Uniform (Vec4 a) where
uniform loc = GL.makeStateVar
@@ -27,6 +28,7 @@ module Graphics.Glyph.GLMath where
GL.get (uniform loc)
return (Vec4 (x,y,z,w)) )
(\(Vec4 (x,y,z,w)) -> uniform loc GL.$= GL.Vertex4 x y z w)
+ uniformv _ = undefined
class (Floating flT) => Vector flT b where
(<+>) :: b flT -> b flT -> b flT
@@ -83,14 +85,14 @@ module Graphics.Glyph.GLMath where
(×) = cross
lookAtMatrix :: Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat -> Mat4 GLfloat
- lookAtMatrix e@(Vec3 (ex,ey,ez)) c u =
+ lookAtMatrix e c u =
let f@(Vec3 (fx,fy,fz)) = normalize (c <-> e)
s@(Vec3 (sx,sy,sz)) = normalize (f × u)
u'@(Vec3 (ux,uy,uz)) = s × f in
Matrix4 (sx, ux, -fx, 0,
sy, uy, -fy, 0,
sz, uz, -fz, 0,
- -(s<.>e) , -(u'<.>e), (f<.>e), 1 )
+ -(s<.>e) , -(u'<.>e), f<.>e, 1 )
orthoMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Mat4 GLfloat
orthoMatrix top bot right left near far =
@@ -107,7 +109,7 @@ module Graphics.Glyph.GLMath where
res22 = - (zf + zn) / (zf - zn)
res23 = - 1
res32 = - (2 * zf * zn) / (zf - zn) in
- trace ("res22=" ++ (show res22)) $
+ trace ("res22=" ++ show res22) $
Matrix4 (res00, 0, 0, 0,
0, res11, 0, 0,
0, 0, res22, res23,
@@ -161,8 +163,8 @@ module Graphics.Glyph.GLMath where
m20,m21,m22,m23,
m30,m31,m32,m33)) vec =
let (Vec4 (v0,v1,v2,v3)) = mat -*| vec in
- (Matrix4 (m00,m01,m02,m03,
+ Matrix4 (m00,m01,m02,m03,
m10,m11,m12,m13,
m20,m21,m22,m23,
- m30+v0,m31+v1,m32+v2,m33+v3))
+ m30+v0,m31+v1,m32+v2,m33+v3)
diff --git a/Graphics/Glyph/Mat4.hs b/Graphics/Glyph/Mat4.hs
index 294871c..c1ae485 100644
--- a/Graphics/Glyph/Mat4.hs
+++ b/Graphics/Glyph/Mat4.hs
@@ -8,7 +8,7 @@ import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
-import Graphics.Rendering.OpenGL (GLfloat,Uniform(..),uniform,UniformLocation(..),makeStateVar)
+import Graphics.Rendering.OpenGL (Uniform(..),uniform,UniformLocation(..),makeStateVar)
import Graphics.Rendering.OpenGL.Raw.Core31
data Mat4 a = Matrix4 (a,a,a,a,
@@ -89,9 +89,10 @@ instance Uniform (Mat4 GLfloat) where
getter :: IO (Mat4 GLfloat)
getter = do
pid <- liftM fromIntegral getCurrentProgram
- ( allocaArray 16 $ \buf -> do
+ allocaArray 16 $ \buf -> do
glGetUniformfv pid loc buf
- fromPtr buf return )
+ fromPtr buf return
+ uniformv _ = undefined
instance Uniform (Mat3 GLfloat) where
uniform (UniformLocation loc) = makeStateVar getter setter
@@ -100,9 +101,10 @@ instance Uniform (Mat3 GLfloat) where
getter :: IO (Mat3 GLfloat)
getter = do
pid <- liftM fromIntegral getCurrentProgram
- ( allocaArray 9 $ \buf -> do
+ allocaArray 9 $ \buf -> do
glGetUniformfv pid loc buf
- fromPtr buf return )
+ fromPtr buf return
+ uniformv _ = undefined
getCurrentProgram :: IO GLint
getCurrentProgram = alloca $ glGetIntegerv gl_CURRENT_PROGRAM >> peek
@@ -206,10 +208,10 @@ transpose4 (Matrix4
(m00,m01,m02,m03,
m10,m11,m12,m13,
m20,m21,m22,m23,
- m30,m31,m32,m33 )) = (Matrix4 (m00, m10, m20, m30,
+ m30,m31,m32,m33 )) = Matrix4 (m00, m10, m20, m30,
m01, m11, m21, m31,
m02, m12, m22, m32,
- m03, m13, m23, m33))
+ m03, m13, m23, m33)
scale4 :: (Num a) => a -> Mat4 a -> Mat4 a
scale4 n (Matrix4 (m11,m12,m13,m14,m21,m22,m23,m24,m31,m32,m33,m34,m41,m42,m43,m44)) =
Matrix4 (m11*n,m12*n,m13*n,m14*n,m21*n,m22*n,m23*n,m24*n,m31*n,m32*n,m33*n,m34*n,m41*n,m42*n,m43*n,m44*n)
@@ -256,4 +258,4 @@ trunc4 (Matrix4
_ , _ , _ ,_)) = Matrix3 (m11,m12,m13,m21,m22,m23,m31,m32,m33)
toNormalMatrix :: (RealFloat a,Eq a) => Mat4 a -> Maybe (Mat3 a)
-toNormalMatrix mat = inv4 mat >>= return . trunc4 . transpose4
+toNormalMatrix mat = liftM (trunc4 . transpose4) $ inv4 mat
generated by cgit (git 2.34.1) at 2025-07-15 01:59:44 +0000