open window ✓

draw triangle ✓

app/Main.hs

@@ -0,0 +1,99 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad (unless)
+import Data.Bifunctor (Bifunctor (bimap))
+import Foreign.C (CInt)
+import SDL
+  ( Event (eventPayload),
+    EventPayload (KeyboardEvent, QuitEvent),
+    InitFlag (InitVideo),
+    InputMotion (Pressed, Released),
+    KeyboardEventData (keyboardEventKeyMotion, keyboardEventKeysym),
+    Keysym (keysymKeycode),
+    Point (P),
+    Renderer,
+    V2 (V2),
+    V4 (V4),
+    Window,
+    WindowConfig (windowGraphicsContext, windowInitialSize),
+    WindowGraphicsContext (OpenGLContext),
+    clear,
+    createRenderer,
+    createWindow,
+    defaultOpenGL,
+    defaultRenderer,
+    defaultWindow,
+    destroyWindow,
+    drawLine,
+    get,
+    initialize,
+    present,
+    quit,
+    rendererDrawColor,
+    waitEvent,
+    windowSize,
+    ($=),
+  )
+import SDL.Input.Keyboard.Codes
+
+main :: IO ()
+main = do
+  initialize [InitVideo]
+
+  window <-
+    createWindow
+      "Test"
+      defaultWindow {windowGraphicsContext = OpenGLContext defaultOpenGL, windowInitialSize = V2 800 600}
+
+  renderer <- createRenderer window (-1) defaultRenderer
+
+  loop renderer window
+
+  destroyWindow window
+
+  quit
+
+loop :: Renderer -> Window -> IO ()
+loop renderer window = waitEvent >>= _loop renderer window
+
+exitCodes :: [Keycode]
+exitCodes = [KeycodeQ, KeycodeEscape]
+
+triangle :: [(V2 Float, V2 Float)]
+triangle =
+  [ (V2 0.25 0.75, V2 0.5 0.25),
+    (V2 0.5 0.25, V2 0.75 0.75),
+    (V2 0.75 0.75, V2 0.25 0.75)
+  ]
+
+_loop :: Renderer -> Window -> Event -> IO ()
+_loop renderer window event = do
+  let stop =
+        case eventPayload event of
+          QuitEvent -> True
+          KeyboardEvent kevent -> case keyboardEventKeyMotion kevent of
+            Pressed -> False
+            Released
+              | keyof kevent `elem` exitCodes -> True
+              | otherwise -> False
+          _ -> False
+
+  rendererDrawColor renderer $= V4 255 255 255 255
+  clear renderer
+
+  rendererDrawColor renderer $= V4 0 0 0 255
+
+  size <- get $ windowSize window
+  mapM_ (uncurry (drawLine renderer) . bimap (tosdl size) (tosdl size)) triangle
+
+  present renderer
+
+  unless stop continue
+  where
+    continue = waitEvent >>= _loop renderer window
+    keyof = keysymKeycode . keyboardEventKeysym
+
+tosdl :: V2 CInt -> V2 Float -> Point V2 CInt
+tosdl size rel = P $ fmap round $ fmap fromIntegral size * rel