summaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: 4ed0199d2ee3ba42dd12fd3e06163e129a9c5b99 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
module Main (main) where

import Foreign.C.String (withCString)
import Foreign.C.Types
import Foreign.Ptr

import RGFW

--------------------------------------------------------------------------------
-- main
--------------------------------------------------------------------------------

main :: IO ()
main = do
  window <- withCString "window <3" (\name ->
    c'RGFW_createWindow 
      name
      0
      0
      800
      600
      $ sum
        [ c'RGFW_windowNoResize
        , c'RGFW_windowOpenGL
        , 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 ()