key callbacks, tidy

1 files changed, 15 insertions, 0 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 7dcf9c3..4ed0199 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,6 +1,8 @@
 module Main (main) where
 
 import Foreign.C.String (withCString)
+import Foreign.C.Types
+import Foreign.Ptr
 
 import RGFW
 
@@ -23,14 +25,27 @@ main = do
         , c'RGFW_windowedFullscreen
         ]
     )
+  keyfuncPtr <- mk'RGFW_keyfunc keyfunc
+  c'RGFW_setKeyCallback keyfuncPtr
   putStrLn $ show window
   let loop ctr = do
         shouldClose <- c'RGFW_window_shouldClose window
         if 0 /= shouldClose
         then return shouldClose
         else do
+          c'RGFW_pollEvents
           c'RGFW_window_swapBuffers_OpenGL window
           loop $ ctr + 1
   exitCode <- loop (0 :: Integer)
   putStrLn $ show exitCode
+  freeHaskellFunPtr keyfuncPtr
   return ()
+
+type RGFW_keyfunc = Ptr C'RGFW_window -> C'RGFW_key -> CUChar -> C'RGFW_keymod -> C'RGFW_bool -> C'RGFW_bool -> IO ()
+
+keyfunc :: RGFW_keyfunc
+keyfunc window key sym mod repeat pressed = do
+  if key == c'RGFW_escape && mod == 0 then do
+    c'RGFW_window_setShouldClose window 1
+  else
+    return ()