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.

7 files changed, 272 insertions, 140 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
 
 
diff --git a/Hw8.hs b/Hw8.hs
index 1d257ae..d977ff1 100644
--- a/Hw8.hs
+++ b/Hw8.hs
@@ -1,23 +1,27 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, OverloadedStrings, ViewPatterns #-}
 module Main where 
 
+import Data.Monoid
+import Text.Printf
 import Control.Applicative
 import Control.Monad
-import GHC.Exts
+import GHC.Exts hiding (Vec4)
 
-import Data.Setters
+import SDL.Vect
+import SDL (($=))
+import SDL.Image
 import Data.Maybe
 import Data.Word
 
 import Debug.Trace
 
 import Graphics.Rendering.OpenGL as GL
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.UI.SDL as SDL
+import qualified SDL
 import Graphics.Glyph.GLMath
 import Graphics.Glyph.Mat4
+import Graphics.GL.Compatibility30
 
-import Graphics.UI.SDL.Image
+-- import Graphics.UI.SDL.Image
 import Graphics.Glyph.Textures
 import Graphics.Glyph.Shaders
 import Graphics.Glyph.Util
@@ -26,7 +30,7 @@ import Graphics.Glyph.GlyphObject
 
 import Control.DeepSeq
 import System.Exit
-import System.Random
+import System.Random hiding (uniform)
 
 import Debug.Trace
 import Foreign.Storable
@@ -90,8 +94,6 @@ data Resources = Resources {
     dTime :: GLfloat
 } deriving (Show)
 
-$(declareSetters ''Resources)
-
 makeTexture :: IO TextureObject
 makeTexture = do
     texobj <- liftM head $ genObjectNames 1
@@ -214,7 +216,7 @@ makeResources =
             Resources
                 <$> glo
                 <*> backDrop
-                <*> liftM (setPrimitiveMode Points) satelites
+                <*> liftM (\s -> s {primitiveMode = Points}) satelites
                 <*> moon
                 <*> (makeTexture >>= genRandomTexture)
                 <*> (load ("textures/earth.png") >>= textureFromSurface)
@@ -265,26 +267,24 @@ setupLighting mvMat res lu =
             _ -> putStrLn "Normal matrix could not be computed"
 
 
-setupTexturing :: TextureData -> UniformLocation -> Int -> IO ()
-setupTexturing (TextureData _ to) tu unit = do
+setupTexturing :: String -> TextureData -> UniformLocation -> Int -> IO ()
+setupTexturing v (TextureData _ to) tu unit = do
     texture Texture2D $= Enabled
     activeTexture $= TextureUnit (fromIntegral unit)
     textureBinding Texture2D $= Just to
     uniform tu $= Index1 (fromIntegral unit::GLint)
-    printErrors "setupTexturing"
 
 
-display :: SDL.Surface -> Resources -> IO Resources
-display surf res = do
+display :: SDL.Window -> Resources -> IO Resources
+display win res = do
     clear [ColorBuffer, DepthBuffer]
     clearColor $= Color4 0.3 0.3 0.3 1.0
-    SDL.flip surf
 
     depthFunc $= Nothing
     draw $ prepare (backDrop res) $ \obj -> do
                 let (prg,uni) = (getResources obj)
                 currentProgram $= Just prg
-                setupTexturing (spaceTex res) uni 0
+                setupTexturing "space" (spaceTex res) uni 0
 
     currentProgram $= Just (program res)
     let (_,_,ph) = eyeLocation res
@@ -304,12 +304,12 @@ display surf res = do
                 uniform (timeU uniforms) $= Index1 (resTime res)
                 setupMvp mvMatrix res
                 setupLighting  mvMatrix res (lightU res)
-                setupTexturing (bumpMap res) (textureU uniforms) 0
-                setupTexturing (earthTex res) (earthU uniforms) 1
-                setupTexturing (cloudsTex res) (cloudsU uniforms) 2
-                setupTexturing (lightsTex res) (lightsU uniforms) 3
-                setupTexturing (resTexture res) (randomU uniforms) 4
-                setupTexturing (winterTex res) (winterU uniforms) 5
+                setupTexturing "bump" (bumpMap res) (textureU uniforms) 0
+                setupTexturing "earth" (earthTex res) (earthU uniforms) 1
+                setupTexturing "clouds" (cloudsTex res) (cloudsU uniforms) 2
+                setupTexturing "lights" (lightsTex res) (lightsU uniforms) 3
+                setupTexturing "res" (resTexture res) (randomU uniforms) 4
+                setupTexturing "winter" (winterTex res) (winterU uniforms) 5
 
     draw $ prepare (moon res) $ \glo -> do
             let (prog, texU, lU, mvMatU, pMatU, timeUn,dxUn,dyUn) = getResources glo
@@ -321,7 +321,7 @@ display surf res = do
             uniform timeUn $= Index1 time
             uniform dxUn $= Index1 (1.0/w::GLfloat)
             uniform dyUn $= Index1 (1.0/w::GLfloat)
-            setupTexturing (moonTex res) texU 0
+            setupTexturing "moon" (moonTex res) texU 0
             setupLighting mvMatrix res lU
             
     blend $= Enabled
@@ -334,79 +334,120 @@ display surf res = do
             uniform pMatU $= pMatrix res
             uniform timeUn $= Index1 time
             setupLighting mvMatrix res light
-            setupTexturing (resTexture res) texU 0
+            setupTexturing "res" (resTexture res) texU 0
 
-    SDL.glSwapBuffers
+    -- SDL.glSwapBuffers
+    SDL.glSwapWindow win
     return res
 
 digestEvents :: Resources -> IO Resources
-digestEvents args = do
-    ev <- SDL.pollEvent
-    case ev of
-        SDL.NoEvent -> return args
-        VideoResize w h -> reshape (w,h) args >>= digestEvents
-        KeyDown (Keysym SDLK_ESCAPE _ _) -> exitSuccess
-        KeyDown (Keysym SDLK_RIGHT _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,1,0)) args
-        KeyDown (Keysym SDLK_LEFT _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,-1,0)) args
-        KeyUp (Keysym SDLK_LEFT _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,1,0)) args
-        KeyUp (Keysym SDLK_RIGHT _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,-1,0)) args
-
-        KeyDown (Keysym SDLK_UP _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0, 1)) args
-        KeyDown (Keysym SDLK_DOWN _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0,-1)) args
-        KeyUp (Keysym SDLK_UP _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0,-1)) args
-        KeyUp (Keysym SDLK_DOWN _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0, 1)) args
-
-        KeyDown (Keysym SDLK_w _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (-0.1,0,0)) args
-        KeyDown (Keysym SDLK_s _ _) -> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0.1,0,0)) args
-        KeyUp (Keysym SDLK_w _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0.1,0,0)) args
-        KeyUp (Keysym SDLK_s _ _)-> 
-            digestEvents $ setDifEyeLocation (difEyeLocation args +++ (-0.1,0,0)) args
-
-        KeyDown (Keysym SDLK_n _ _) ->
-            digestEvents $ (Prelude.flip setUseNoise args.not.useNoise) args
-
-        KeyDown (Keysym SDLK_EQUALS _ _) ->
-            digestEvents $ setDTime (dTime args + 0.1) args
-
-        KeyDown (Keysym SDLK_MINUS _ _) ->
-            digestEvents $ setDTime (dTime args - 0.1) args
-
-        Quit -> exitSuccess
-        _ -> digestEvents args
-    where
-        (+++) = zipWithT3 (+)
+digestEvents res = do
+   evs <- SDL.pollEvents
+   let (quit, res') =
+         foldl (\(q, res) ev ->
+          case ev of
+            SDL.QuitEvent -> (True, res)
+            SDL.KeyboardEvent e ->
+              (\(q, f) -> (q, f res)) $
+              (q, case (SDL.keyboardEventKeyMotion e, SDL.keysymScancode (SDL.keyboardEventKeysym e)) of
+                    (SDL.Pressed, SDL.ScancodeW) -> diff $ set3 0.2
+                    (SDL.Released, SDL.ScancodeW) -> diff $ set3 0
+
+                    (SDL.Pressed, SDL.ScancodeA) -> diff $ set2 (-0.2)
+                    (SDL.Released, SDL.ScancodeA) -> diff $ set2 0
+
+                    (SDL.Pressed, SDL.ScancodeS) -> diff $ set3 (-0.2)
+                    (SDL.Released, SDL.ScancodeS) -> diff $ set3 0
+
+                    (SDL.Pressed, SDL.ScancodeD) -> diff $ set2 0.2
+                    (SDL.Released, SDL.ScancodeD) -> diff $ set2 0
+
+                    (SDL.Pressed, SDL.ScancodeI) -> diff $ set1 (-0.1)
+                    (SDL.Released, SDL.ScancodeI) -> diff $ set1 0
+
+                    (SDL.Pressed, SDL.ScancodeK) -> diff $ set1 0.1
+                    (SDL.Released, SDL.ScancodeK) -> diff $ set1 0
+                    _ -> id)
+            _ -> (q, res)) (False, res) (map SDL.eventPayload evs)
+
+   when quit $
+    exitSuccess
+
+   return res'
+
+   where
+     diff tup res = res { difEyeLocation = tup (difEyeLocation res)}
+     set1 x (_, y, z) = (x, y, z)
+     set2 y (x, _, z) = (x, y, z)
+     set3 z (x, y, _) = (x, y, z)
+     (+++) = zipWithT3 (+)
+
+    -- ev <- SDL.pollEvent
+    -- return args
+    -- case ev of
+    --     SDL.NoEvent -> return args
+    --     VideoResize w h -> reshape (w,h) args >>= digestEvents
+    --     KeyDown (Keysym SDLK_ESCAPE _ _) -> exitSuccess
+    --     KeyDown (Keysym SDLK_RIGHT _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,1,0)) args
+    --     KeyDown (Keysym SDLK_LEFT _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,-1,0)) args
+    --     KeyUp (Keysym SDLK_LEFT _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,1,0)) args
+    --     KeyUp (Keysym SDLK_RIGHT _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,-1,0)) args
+
+    --     KeyDown (Keysym SDLK_UP _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0, 1)) args
+    --     KeyDown (Keysym SDLK_DOWN _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0,-1)) args
+    --     KeyUp (Keysym SDLK_UP _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0,-1)) args
+    --     KeyUp (Keysym SDLK_DOWN _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0,0, 1)) args
+
+    --     KeyDown (Keysym SDLK_w _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (-0.1,0,0)) args
+    --     KeyDown (Keysym SDLK_s _ _) -> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0.1,0,0)) args
+    --     KeyUp (Keysym SDLK_w _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (0.1,0,0)) args
+    --     KeyUp (Keysym SDLK_s _ _)-> 
+    --         digestEvents $ setDifEyeLocation (difEyeLocation args +++ (-0.1,0,0)) args
+
+    --     KeyDown (Keysym SDLK_n _ _) ->
+    --         digestEvents $ (Prelude.flip setUseNoise args.not.useNoise) args
+
+    --     KeyDown (Keysym SDLK_EQUALS _ _) ->
+    --         digestEvents $ setDTime (dTime args + 0.1) args
+
+    --     KeyDown (Keysym SDLK_MINUS _ _) ->
+    --         digestEvents $ setDTime (dTime args - 0.1) args
+
+    --     Quit -> exitSuccess
+    --     _ -> digestEvents args
+    -- where
+    --     (+++) = zipWithT3 (+)
 
 reshape :: (Int, Int) -> Resources -> IO Resources
 reshape (w, h) args = do
     let size = Size (fromIntegral w) (fromIntegral h)
     let pMatrix' = perspectiveMatrix 50 (fromIntegral w / fromIntegral h) 0.1 100
     viewport $=(Position 0 0, size)
-    _ <- SDL.setVideoMode w h 32 [SDL.OpenGL, SDL.Resizable, SDL.DoubleBuf]
-    return $ setPMatrix pMatrix' args
+    -- _ <- SDL.setVideoMode w h 32 [SDL.OpenGL, SDL.Resizable, SDL.DoubleBuf]
+    return $ args { pMatrix = pMatrix' }
 
 bindSurfaceToTexture :: SDL.Surface -> TextureObject -> IO TextureData
 bindSurfaceToTexture surf to = do
     textureBinding Texture2D $= Just to
-    bbp <- liftM fromIntegral (pixelFormatGetBytesPerPixel $ surfaceGetPixelFormat surf)
-    ptr <- surfaceGetPixels surf
-    glTexImage2D gl_TEXTURE_2D 0 bbp (w surf) (h surf) 0 (if bbp == 3 then gl_RGB else gl_RGBA) gl_UNSIGNED_BYTE ptr
-    return $ TextureData (w surf, h surf) to
-    where 
-          w :: (Integral a) => SDL.Surface -> a
-          w = fromIntegral . surfaceGetWidth
-          h :: (Integral a) => SDL.Surface -> a
-          h = fromIntegral . surfaceGetHeight
+    bbp <- return 3 -- liftM fromIntegral (pixelFormatGetBytesPerPixel $ SDL.surfacePixels surf)
+    ptr <- SDL.surfacePixels surf
+    (V2 w h) <- SDL.surfaceDimensions surf
+
+    glTexImage2D GL_TEXTURE_2D 0 bbp (fi w) (fi h) 0 (if bbp == 3 then GL_RGB else GL_RGBA) GL_UNSIGNED_BYTE ptr
+    return $ TextureData (fi w, fi h) to
+  where fi :: (Integral a, Integral b) => a -> b
+        fi = fromIntegral
 
 textureFromSurface :: SDL.Surface -> IO TextureData
 textureFromSurface surf = makeTexture >>= (bindSurfaceToTexture surf >=> return)
@@ -430,21 +471,33 @@ genRandomTexture to =
 
 main :: IO ()
 main = do
-        let _printError = get errors >>= mapM_ (putStrLn . ("GL: "++) . show)
-        let size@(w,h) = (640, 480)
-    
-        SDL.init [SDL.InitEverything]
-
-        _ <- SDL.setVideoMode w h 32 [SDL.OpenGL, SDL.Resizable, SDL.DoubleBuf]
-        screen <- SDL.getVideoSurface
-        resources <- makeResources
-        reshape size resources >>= mainloop screen
-
-    where mainloop screen resources =
-            digestEvents resources >>= display screen >>= (mainloop screen . updateResources)
-          (+++) = zipWithT3 (+)
-          updateResources res =
-            setEyeLocation (zipWithT3 (+) (eyeLocation res) (difEyeLocation res)) $
-            setResTime ( resTime res + (dTime res) ) res
+  SDL.initialize [SDL.InitVideo]
+  SDL.HintRenderScaleQuality $= SDL.ScaleLinear
+  renderQuality <- SDL.get SDL.HintRenderScaleQuality
+  when (renderQuality /= SDL.ScaleLinear) $
+    putStrLn "Warning: Linear texture filtering not enabled!"
+
+  putStrLn "1"
+  window <-
+    SDL.createWindow
+      "SDL / OpenGL Example"
+      SDL.defaultWindow {SDL.windowInitialSize = V2 1920 1080,
+                         SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL}
+  putStrLn "2"
+  SDL.showWindow window
+  putStrLn "3"
+
+  _ <- SDL.glCreateContext window
+  resources <- makeResources
+  reshape (1920, 1080) resources >>= mainloop window
+
+  where mainloop win resources =
+          digestEvents resources >>= display win >>= (mainloop win . updateResources)
+        (+++) = zipWithT3 (+)
+        updateResources res =
+          res {
+              resTime = ( resTime res + (dTime res) ),
+              eyeLocation = zipWithT3 (+) (eyeLocation res) (difEyeLocation res)
+            }
 
 
diff --git a/jora2470_hw8.cabal b/jora2470_hw8.cabal
deleted file mode 100644
index fbc9041..0000000
--- a/jora2470_hw8.cabal
+++ /dev/null
@@ -1,25 +0,0 @@
--- Initial jora2470_hw2.cabal generated by cabal init.  For further 
--- documentation, see http://haskell.org/cabal/users-guide/
-
---enable-library-profiling and/or
---enable-executable-profiling.
-name:                homework8
-version:             0.1.0.0
--- synopsis:            
--- description:         
--- license:             
-license-file:        LICENSE
-author:              Josh Rahm
-maintainer:          joshuarahm@gmail.com
--- copyright:           
--- category:            
-build-type:          Simple
-cabal-version:       >=1.8
-
-executable jora2470_hw8
-  main-is: Hw8.hs
-  extensions: FlexibleInstances
-  ghc-options: -rtsopts
- -- ghc-options: -prof -osuf h_o
-  -- other-modules:       
-  build-depends:       setters, base, OpenGL, bytestring, array, SDL, random, OpenGLRaw, AC-Angle, deepseq, containers, SDL-image
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..1d67190
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,67 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/2.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor