blob: 67f745e6332d31420510010676a31bbdd44f4af2 (
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
{-# LANGUAGE CApiFFI #-}
module Main (main) where
import Data.Bits (shiftL, (.|.))
import Foreign
import Foreign.C.String
import Foreign.C.Types
--------------------------------------------------------------------------------
-- main
--------------------------------------------------------------------------------
main :: IO ()
main = do
window <- withCString "a window" (\name ->
rgfwCreateWindow
name
0
0
800
600
$ mkWindowFlags
[ WindowNoResize
, WindowOpenGL
, WindowFullscreen
]
)
let loop ctr = do
shouldClose <- rgfwWindowShouldClose window
if 0 /= shouldClose
then return shouldClose
else loop $ ctr + 1
exitCode <- loop 0
putStrLn $ show exitCode
return ()
--------------------------------------------------------------------------------
-- Haskell-ier abstractions
--------------------------------------------------------------------------------
data WindowFlags
= WindowNoBorder
| WindowNoResize
| WindowAllowDND
| WindowHideMouse
| WindowFullscreen
| WindowTransparent
| WindowCenter
| WindowRawMouse
| WindowScaleToMonitor
| WindowHide
| WindowMaximize
| WindowCenterCursor
| WindowFloating
| WindowFocusOnShow
| WindowMinimize
| WindowFocus
| WindowOpenGL
| WindowEGL
| WindowedFullscreen
mkWindowFlags :: [WindowFlags] -> RGFWwindowFlags
mkWindowFlags [] = 0
mkWindowFlags (flag:flags) =
let
shift =
case flag of
WindowNoBorder -> 0
WindowNoResize -> 1
WindowAllowDND -> 2
WindowHideMouse -> 3
WindowFullscreen -> 4
WindowTransparent -> 5
WindowCenter -> 6
WindowRawMouse -> 7
WindowScaleToMonitor -> 8
WindowHide -> 9
WindowMaximize -> 10
WindowCenterCursor -> 11
WindowFloating -> 12
WindowFocusOnShow -> 13
WindowMinimize -> 14
WindowFocus -> 15
WindowOpenGL -> 17
WindowEGL -> 18
_ -> 19 -- TODO fix this silent error, implement windowedFullscreen
in
(shiftL 1 shift) .|. (mkWindowFlags flags)
--------------------------------------------------------------------------------
-- directly from RFGW.h
--------------------------------------------------------------------------------
-- RGFWindow
data RGFWwindow
-- ptr
type RGFWwindowPtr = Ptr RGFWwindow
-- flags to create
type RGFWwindowFlags = Word32
type RGFWbool = CUInt
foreign import capi "lib/RGFW_HS.h RGFW_createWindow" rgfwCreateWindow
:: Ptr CChar
-> CInt
-> CInt
-> CInt
-> CInt
-> RGFWwindowFlags
-> IO RGFWwindowPtr
foreign import capi "lib/RGFW_HS.h RGFW_window_shouldClose" rgfwWindowShouldClose
:: RGFWwindowPtr
-> IO RGFWbool
|
