Update this ancient project to work with modern Haskell.

Thsi is a big change, particularly with the SDL library. Not all the
original functionality is restored yet, but it's pretty close.

As a part of this reworking, I have moved the project to Stack.

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