From 93bee37b83bbd88f2a7542415cd960e72ac3868e Mon Sep 17 00:00:00 2001 From: mtgmonkey Date: Tue, 16 Dec 2025 11:14:40 +0100 Subject: [PATCH] key callbacks, tidy --- CHANGELOG.md | 36 +++++++++++- flake.nix | 4 +- hs-rgfw.cabal | 48 ++++++++------- lib/RGFW.hsc | 158 +++++++++++++++++++++++++++++++++++++++++++++++++- src/Main.hs | 15 +++++ 5 files changed, 234 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0baa6ab..5a2f1c4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,41 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/) ### Added - support for Windows -- support for actually doing anything +- native Wayland support + +### Removed + +- `C'u8` as an alias to `CChar` + +## [0.2.2] -- 2025-12-16 + +### Added + +- enums `RGFW_keymod` and `RGFW_key` as `CUChar` aliases + - all variants bound as constants +- `C'RGFW_bool` as `CUChar` alias. 0 is true, else is false +- new callback + - `RGFW_keyfunc` +- various new methods in `RGFW.hsc` + - `RGFW_window_setShouldClose` + - `RGFW_pollEvents` + - `RGFW_setKeyCallback` +- key callback functionallity in demo application + - `esc` closes the window + +### Changed + +- modularized `hs-rgfw.cabal` for the sake of tidiness + +### Deprecated + +- `C'u8` as a type alias to `CChar` + - such declarations are needed in C but not in Haskell + - `CUChar` is the preferable type for cross-platform later + +### Fixed + +- correctly inherit `version` in `flake.nix` ## [0.2.1] -- 2025-12-16 diff --git a/flake.nix b/flake.nix index a184775..f26658e 100644 --- a/flake.nix +++ b/flake.nix @@ -8,7 +8,7 @@ self, ... }: let - version = "0.2.1"; + version = "0.2.2"; package = { mkDerivation, base, @@ -23,7 +23,7 @@ }: mkDerivation { pname = "hs-rgfw"; - version = "0.2.0"; + inherit version; src = ./.; libraryHaskellDepends = [ base diff --git a/hs-rgfw.cabal b/hs-rgfw.cabal index 88c37ba..f4f1d79 100644 --- a/hs-rgfw.cabal +++ b/hs-rgfw.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hs-rgfw -version: 0.2.1 +version: 0.2.2 homepage: https://git.mtgmonkey.net/Andromeda/hs-rgfw license: BSD-3-Clause license-file: LICENSE @@ -13,35 +13,41 @@ extra-doc-files: CHANGELOG.md common warnings ghc-options: -Wall +common buildc + include-dirs: + include, + include/RGFW + c-sources: include/RGFW_HS.c + install-includes: + RGFW_HS.c +common pkgconfig + pkgconfig-depends: + gl, + x11, + xcursor, + xrandr, + xi +common default-language + default-language: Haskell2010 library - import: warnings + import: + warnings, + buildc, + pkgconfig, + default-language exposed-modules: RGFW build-depends: base >=4.18, bindings-DSL <1000 - pkgconfig-depends: - gl, - x11, - xcursor, - xrandr, - xi hs-source-dirs: lib - include-dirs: include/RGFW - default-language: Haskell2010 executable hs-rgfw - import: warnings + import: + warnings, + buildc, + pkgconfig, + default-language main-is: Main.hs build-depends: base >=4.18, hs-rgfw - pkgconfig-depends: - gl, - x11, - xcursor, - xrandr, - xi hs-source-dirs: src - include-dirs: include - c-sources: include/RGFW_HS.c - install-includes: RGFW_HS.h - default-language: Haskell2010 diff --git a/lib/RGFW.hsc b/lib/RGFW.hsc index 90bef54..24d3132 100644 --- a/lib/RGFW.hsc +++ b/lib/RGFW.hsc @@ -5,12 +5,19 @@ import Foreign.Ptr #strict_import #include +-- | DEPRECATED, please use a CUChar instead. #synonym_t u8 , CChar +#synonym_t RGFW_bool , CUChar + +-------------------------------------------------------------------------------- +-- OPAQUE TYPES +-------------------------------------------------------------------------------- #opaque_t RGFW_window -#ccall RGFW_createWindow , CString -> CInt -> CInt -> CInt -> CInt -> CUInt -> IO (Ptr ) - +-------------------------------------------------------------------------------- +-- ENUMS +-------------------------------------------------------------------------------- #synonym_t RGFW_windowFlags , CUInt #num RGFW_windowNoBorder #num RGFW_windowNoResize @@ -32,6 +39,151 @@ import Foreign.Ptr #num RGFW_windowEGL #num RGFW_windowedFullscreen -#ccall RGFW_window_shouldClose , Ptr -> IO CUChar +#synonym_t RGFW_keymod , CUChar +#num RGFW_modCapsLock +#num RGFW_modNumLock +#num RGFW_modControl +#num RGFW_modAlt +#num RGFW_modShift +#num RGFW_modSuper +#num RGFW_modScrollLock +#synonym_t RGFW_key , CUChar +#num RGFW_keyNULL +#num RGFW_escape +#num RGFW_backtick +#num RGFW_0 +#num RGFW_1 +#num RGFW_2 +#num RGFW_3 +#num RGFW_4 +#num RGFW_5 +#num RGFW_6 +#num RGFW_7 +#num RGFW_8 +#num RGFW_9 +#num RGFW_minus +#num RGFW_equals +#num RGFW_backSpace +#num RGFW_tab +#num RGFW_space +#num RGFW_a +#num RGFW_b +#num RGFW_c +#num RGFW_d +#num RGFW_e +#num RGFW_f +#num RGFW_g +#num RGFW_h +#num RGFW_i +#num RGFW_j +#num RGFW_k +#num RGFW_l +#num RGFW_m +#num RGFW_n +#num RGFW_o +#num RGFW_p +#num RGFW_q +#num RGFW_r +#num RGFW_s +#num RGFW_t +#num RGFW_u +#num RGFW_v +#num RGFW_w +#num RGFW_x +#num RGFW_y +#num RGFW_z +#num RGFW_period +#num RGFW_comma +#num RGFW_slash +#num RGFW_bracket +#num RGFW_closeBracket +#num RGFW_semicolon +#num RGFW_apostrophe +#num RGFW_backSlash +#num RGFW_return +#num RGFW_enter +#num RGFW_delete +#num RGFW_F1 +#num RGFW_F2 +#num RGFW_F3 +#num RGFW_F4 +#num RGFW_F5 +#num RGFW_F6 +#num RGFW_F7 +#num RGFW_F8 +#num RGFW_F9 +#num RGFW_F10 +#num RGFW_F11 +#num RGFW_F12 +#num RGFW_F13 +#num RGFW_F14 +#num RGFW_F15 +#num RGFW_F16 +#num RGFW_F17 +#num RGFW_F18 +#num RGFW_F19 +#num RGFW_F20 +#num RGFW_F21 +#num RGFW_F22 +#num RGFW_F23 +#num RGFW_F24 +#num RGFW_F25 +#num RGFW_capsLock +#num RGFW_shiftL +#num RGFW_controlL +#num RGFW_altL +#num RGFW_superL +#num RGFW_shiftR +#num RGFW_controlR +#num RGFW_altR +#num RGFW_superR +#num RGFW_up +#num RGFW_down +#num RGFW_left +#num RGFW_right +#num RGFW_insert +#num RGFW_menu +#num RGFW_end +#num RGFW_home +#num RGFW_pageUp +#num RGFW_pageDown +#num RGFW_numLock +#num RGFW_kpSlash +#num RGFW_kpMultiply +#num RGFW_kpPlus +#num RGFW_kpMinus +#num RGFW_kpEqual +#num RGFW_kp1 +#num RGFW_kp2 +#num RGFW_kp3 +#num RGFW_kp4 +#num RGFW_kp5 +#num RGFW_kp6 +#num RGFW_kp7 +#num RGFW_kp8 +#num RGFW_kp9 +#num RGFW_kp0 +#num RGFW_kpPeriod +#num RGFW_kpReturn +#num RGFW_scrollLock +#num RGFW_printScreen +#num RGFW_pause +#num RGFW_world1 +#num RGFW_world2 +#num RGFW_keyLast + +-------------------------------------------------------------------------------- +-- FUNCTIONS : WINDOWING +-------------------------------------------------------------------------------- +#ccall RGFW_createWindow , CString -> CInt -> CInt -> CInt -> CInt -> CUInt -> IO (Ptr ) +#ccall RGFW_window_shouldClose , Ptr -> IO CUChar #ccall RGFW_window_swapBuffers_OpenGL , Ptr -> IO () +#ccall RGFW_window_setShouldClose , Ptr -> CUChar -> IO () + +-------------------------------------------------------------------------------- +-- FUNCTIONS : EVENTS +-------------------------------------------------------------------------------- +#ccall RGFW_pollEvents , IO () +#callback RGFW_keyfunc , Ptr -> CUChar -> CUChar -> CUChar -> CUChar -> CUChar -> IO () +#ccall RGFW_setKeyCallback , -> IO 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 ()