2 files changed, 55 insertions(+), 160 deletions(-)

M app/Main.hs
M cattrap.cabal

@@ 1,5 1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import System.Environment (getArgs)
 import Text.XML.Light.Input (parseXMLDoc)
 import qualified Text.XML.Light.Types as X
 import Data.Maybe (fromJust, fromMaybe)


@@ 17,19 19,23 @@ import Stylist.Tree (StyleTree(..))
 import Stylist (PropertyParser(..))
 import Data.CSS.Syntax.Tokens (Token(..), tokenize)
 
-import Graphics.UI.GLUT
-import Graphics.GL.Core32
-
-import Foreign.Ptr (castPtr, nullPtr)
-import Foreign.Storable (Storable(..))
-import Foreign.Marshal.Array (withArrayLen, allocaArray, peekArray)
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Utils (with)
-import Foreign.C.String (withCString)
+import SDL hiding (rotate)
+import Foreign.C.Types (CInt)
+import Data.Function (fix)
+import Control.Monad (unless)
 
 main :: IO ()
 main = do
-    (progname, args) <- getArgsAndInitialize
+    SDL.initializeAll
+
+    let wcfg = defaultWindow {
+            windowInitialSize = V2 640 480,
+            windowResizable = True
+          }
+    w <- createWindow "CatTrap" wcfg
+    renderer <- createRenderer w (-1) defaultRenderer
+
+    args <- getArgs
     source <- readFile $ case args of
         (filename:_) -> filename
         [] -> "styletree.xml"


@@ 37,30 43,19 @@ main = do
     let styles = xml2styles temp xml
     let layout = finalizeCSS' placeholderFont styles
 
-    w <- createWindow progname
-
-    vertexShader <- compileOGLShader vertexSource GL_VERTEX_SHADER
-    fragmentShader <- compileOGLShader fragmentSource GL_FRAGMENT_SHADER
-    shader <- compileOGLProgram [] [vertexShader, fragmentShader]
-    glDetachShader shader vertexShader
-    glDetachShader shader fragmentShader
-    glDeleteShader vertexShader
-    glDeleteShader fragmentShader
+    fix $ \loop -> do
+        events <- fmap eventPayload <$> pollEvents
+        rendererDrawColor renderer $= V4 255 255 255 255
+        clear renderer
 
-    displayCallback $= do
-        clear [ ColorBuffer ]
-        Size x y <- get windowSize
+        V2 x y <- get $ windowSize w
         let (display:_) = boxLayout zeroBox {
             B.size = B.Size (fromIntegral x) (fromIntegral y)
           } layout False
+        renderDisplay renderer display
 
-        glUseProgram shader
-        attribScale <- withCString "windowsize" $ glGetUniformLocation shader
-        glUniform3f attribScale (realToFrac x) (realToFrac y) 1
-
-        renderDisplay shader display
-        flush
-    mainLoop
+        present renderer
+        unless (QuitEvent `elem` events) loop
 
 xml2styles :: CSSBox Nil -> X.Element -> StyleTree (CSSBox Nil)
 xml2styles parent el = StyleTree {


@@ 78,138 73,38 @@ instance PropertyParser Nil where
     inherit _ = Nil
     longhand _ _ _ _ = Nothing
 
-renderDisplay :: Eq a => GLuint -> LayoutItem Double Double ((Double, Double), a)
+renderDisplay :: Renderer -> LayoutItem Double Double ((Double, Double), Nil)
         -> IO ()
-renderDisplay shader display = do
+renderDisplay renderer display = do
     let ((x, y), _) = layoutGetInner display
     let box = layoutGetBox display
-    attribColour <- withCString "fill" $ glGetUniformLocation shader
-
-    glUniform3f attribColour 1 0 0
-    drawBox x y (B.width box) (B.height box)
-    glUniform3f attribColour 0 1 0
-    drawBox (x + B.left (B.margin box)) (y + B.top (B.margin box))
-            (B.width box - B.left (B.margin box) - B.right (B.margin box))
-            (B.height box - B.top (B.margin box) - B.bottom (B.margin box))
-    glUniform3f attribColour 0 0 1
-    drawBox (x + B.left (B.margin box) + B.left (B.border box))
-            (y + B.top (B.margin box) + B.top (B.border box))
-            (B.inline (B.size box) + B.left (B.padding box) + B.right (B.padding box))
-            (B.block (B.size box) + B.top (B.padding box) + B.bottom (B.padding box))
-    glUniform3f attribColour 1 1 0
-    drawBox (x + B.left (B.margin box) + B.left (B.border box) + B.left (B.padding box))
-            (y + B.top (B.margin box) + B.top (B.border box) + B.top (B.padding box))
-            (B.inline $ B.size box) (B.block $ B.size box)
-
-    mapM (renderDisplay shader) $ layoutGetChilds display
+
+    rendererDrawColor renderer $= V4 255 0 0 255
+    drawBox renderer x y (B.width box) (B.height box)
+    rendererDrawColor renderer $= V4 0 255 0 255
+    drawBox renderer
+        (x + B.left (B.margin box)) (y + B.top (B.margin box))
+        (B.width box - B.left (B.margin box) - B.right (B.margin box))
+        (B.height box - B.top (B.margin box) - B.bottom (B.margin box))
+    rendererDrawColor renderer $= V4 0 0 255 255
+    drawBox renderer
+        (x + B.left (B.margin box) + B.left (B.border box))
+        (y + B.top (B.margin box) + B.top (B.border box))
+        (B.inline (B.size box) + B.left (B.padding box) + B.right (B.padding box))
+        (B.block (B.size box) + B.top (B.padding box) + B.bottom (B.padding box))
+    rendererDrawColor renderer $= V4 255 255 0 255
+    drawBox renderer
+        (x + B.left (B.margin box) + B.left (B.border box) + B.left (B.padding box))
+        (y + B.top (B.margin box) + B.top (B.border box) + B.top (B.padding box))
+        (B.inline $ B.size box) (B.block $ B.size box)
+
+    mapM (renderDisplay renderer) $ layoutGetChilds display
     return ()
 
-drawBox x y width height = do
-    buf <- withPointer $ glGenBuffers 1
-    glBindBuffer GL_ARRAY_BUFFER buf
-    glBufferData' GL_ARRAY_BUFFER [
-        x, y, 0,
-        x + width, y, 0,
-        x, y + height, 0,
-
-        x + width, y, 0,
-        x + width, y + height, 0,
-        x, y + height, 0
-      ] GL_STATIC_DRAW
-
-    glEnableVertexAttribArray 0
-    glBindBuffer GL_ARRAY_BUFFER buf
-    glVertexAttribPointer 0 3 GL_FLOAT GL_FALSE 0 nullPtr
-
-    glDrawArrays GL_TRIANGLES 0 6
-    glDisableVertexAttribArray 0
-
-withPointer cb = alloca $ \ret' -> do
-    cb ret'
-    peek ret'
-
-glBufferData' _ [] _ = return ()
-glBufferData' target dat usage =
-    withArrayLen (map realToFrac dat :: [Float]) $ \len dat' -> do
-        glBufferData target (toEnum $ len*sizeOf (head dat)) (castPtr dat') usage
-
-compileOGLShader :: String -> GLenum -> IO GLuint
-compileOGLShader src shType = do
-  shader <- glCreateShader shType
-  if shader == 0
-    then error "Could not create shader"
-    else do
-      success <-do
-        withCString (src) $ \ptr ->
-          with ptr $ \ptrptr -> glShaderSource shader 1 ptrptr nullPtr
-
-        glCompileShader shader
-        with (0 :: GLint) $ \ptr -> do
-          glGetShaderiv shader GL_COMPILE_STATUS ptr
-          peek ptr
-
-      if success == GL_FALSE
-        then do
-          err <- do
-            infoLog <- with (0 :: GLint) $ \ptr -> do
-                glGetShaderiv shader GL_INFO_LOG_LENGTH ptr
-                logsize <- peek ptr
-                allocaArray (fromIntegral logsize) $ \logptr -> do
-                    glGetShaderInfoLog shader logsize nullPtr logptr
-                    peekArray (fromIntegral logsize) logptr
-
-            return $ unlines [ "Could not compile shader:"
-                             , src
-                             , map (toEnum . fromEnum) infoLog
-                             ]
-          error err
-        else return shader
-
-compileOGLProgram :: [(String, Integer)] -> [GLuint] -> IO GLuint
-compileOGLProgram attribs shaders = do
-  (program, success) <- do
-     program <- glCreateProgram
-     forM_ shaders (glAttachShader program)
-     forM_ attribs
-       $ \(name, loc) ->
-         withCString name
-           $ glBindAttribLocation program
-           $ fromIntegral loc
-     glLinkProgram program
-
-     success <- with (0 :: GLint) $ \ptr -> do
-       glGetProgramiv program GL_LINK_STATUS ptr
-       peek ptr
-     return (program, success)
-
-  if success == GL_FALSE
-  then with (0 :: GLint) $ \ptr -> do
-    glGetProgramiv program GL_INFO_LOG_LENGTH ptr
-    logsize <- peek ptr
-    infoLog <- allocaArray (fromIntegral logsize) $ \logptr -> do
-      glGetProgramInfoLog program logsize nullPtr logptr
-      peekArray (fromIntegral logsize) logptr
-    error $ unlines
-          [ "Could not link program"
-          , map (toEnum . fromEnum) infoLog
-          ]
-  else do
-    forM_ shaders glDeleteShader
-    return program
-
-vertexSource = unlines [
-    "#version 330 core",
-    "layout(location = 0) in vec3 vertexPositionModelSpace;",
-    "uniform vec3 windowsize;",
-    "void main() {",
-    "gl_Position.xyz = vertexPositionModelSpace/windowsize - 1;",
-    "gl_Position.y = -gl_Position.y;",
-    "gl_Position.w = 1.0;",
-    "}"
-  ]
-fragmentSource = unlines [
-    "#version 330 core",
-    "uniform vec3 fill;",
-    "out vec3 colour;",
-    "void main() { colour = fill; }"
-  ]
+drawBox :: Renderer -> Double -> Double -> Double -> Double -> IO ()
+drawBox renderer x y width height = do
+    fillRect renderer $ Just $ Rectangle
+        (P $ V2 (c x) (c y)) (V2 (c width) (c height))
+
+c :: (Enum a, Enum b) => a -> b
+c = toEnum . fromEnum

@@ 43,7 43,7 @@ executable cattrap
   main-is:             Main.hs
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.12 && <4.16, cattrap, xml, text, css-syntax, stylist-traits, GLUT, gl
+  build-depends:       base >=4.12 && <4.16, cattrap, xml, text, css-syntax, stylist-traits, sdl2 >= 2.5.4
   hs-source-dirs:      app
   default-language:    Haskell2010