mostly done implementing callbacks for rgfw

This commit is contained in:
2026-01-23 20:53:37 +00:00
parent 2b383ce756
commit 238e6f8907
12 changed files with 134 additions and 36 deletions

View File

@@ -1,11 +1,11 @@
run_debug:
./build-unix-debug.sh && ./shf
run:
./build-unix.sh && ./shf
rgfw:
rgfw-debug:
./build-unix-rgfw-debug-.sh && ./shf-rgfw
glfw-debug:
./build-unix-glfw-debug.sh && ./shf-glfw
glfw:
./build-unix-glfw.sh && ./shf-glfw
tests:
mlton -const "Exn.keepHistory true" shf-tests.mlb && ./shf-tests

View File

@@ -1,7 +1,7 @@
#!/bin/sh
mlton -const 'Exn.keepHistory true' -link-opt "$(pkg-config --cflags glfw3) $(pkg-config --static --libs glfw3)" \
-export-header ffi/mlton-glfw-export.h \
shf.mlb \
shf-glfw.mlb \
ffi/glad.c \
ffi/glfw-export.c \
ffi/glfw-input.c

View File

@@ -1,8 +1,7 @@
#!/bin/sh
mlton -link-opt "$(pkg-config --cflags glfw3) $(pkg-config --static --libs glfw3)" \
-export-header ffi/mlton-glfw-export.h \
shf.mlb \
shf-glfw.mlb \
ffi/glad.c \
ffi/glfw-export.c \
ffi/gles3-export.c \
ffi/glfw-input.c

View File

@@ -1,5 +1,5 @@
#ifndef __SHF_ML_H__
#define __SHF_ML_H__
#ifndef __SHF_GLFW_ML_H__
#define __SHF_GLFW_ML_H__
/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
@@ -132,23 +132,23 @@ typedef Pointer Objptr;
#endif /* _MLTON_EXPORT_H_ */
#if !defined(PART_OF_SHF) && \
!defined(STATIC_LINK_SHF) && \
!defined(DYNAMIC_LINK_SHF)
#define PART_OF_SHF
#if !defined(PART_OF_SHF_GLFW) && \
!defined(STATIC_LINK_SHF_GLFW) && \
!defined(DYNAMIC_LINK_SHF_GLFW)
#define PART_OF_SHF_GLFW
#endif
#if defined(PART_OF_SHF)
#if defined(PART_OF_SHF_GLFW)
#define MLLIB_PRIVATE(x) PRIVATE x
#define MLLIB_PUBLIC(x) PUBLIC x
#elif defined(STATIC_LINK_SHF)
#elif defined(STATIC_LINK_SHF_GLFW)
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x) PUBLIC x
#elif defined(DYNAMIC_LINK_SHF)
#elif defined(DYNAMIC_LINK_SHF_GLFW)
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x) EXTERNAL x
#else
#error Must specify linkage for shf
#error Must specify linkage for shf_glfw
#define MLLIB_PRIVATE(x)
#define MLLIB_PUBLIC(x)
#endif
@@ -168,4 +168,4 @@ MLLIB_PUBLIC(void mltonKeyCallback (Int32 x0, Int32 x1, Int32 x2, Int32 x3);)
}
#endif
#endif /* __SHF_ML_H__ */
#endif /* __SHF_GLFW_ML_H__ */

View File

@@ -157,6 +157,10 @@ extern "C" {
#endif
MLLIB_PUBLIC(void mltonEscape ();)
MLLIB_PUBLIC(void mltonBackspace ();)
MLLIB_PUBLIC(void mltonEnter ();)
MLLIB_PUBLIC(void mltonChar (Word8 x0);)
MLLIB_PUBLIC(void mltonResize (Int32 x0, Int32 x1);)
#undef MLLIB_PRIVATE
#undef MLLIB_PUBLIC

View File

@@ -7,6 +7,7 @@
#include "RGFW.h"
#include <GLES3/gl3.h>
#include <stdbool.h>
#include <ctype.h>
#include "mlton-rgfw-export.h"
RGFW_window* createWindow(char* title, int x, int y, int width, int height) {
@@ -39,6 +40,69 @@ void keyCallback(RGFW_window* window, unsigned char key, unsigned char symbol, u
case RGFW_escape:
mltonEscape();
break;
case RGFW_backSpace:
mltonBackspace();
break;
case RGFW_enter:
mltonEnter();
break;
case RGFW_backtick:
case RGFW_0:
case RGFW_1:
case RGFW_2:
case RGFW_3:
case RGFW_4:
case RGFW_5:
case RGFW_6:
case RGFW_7:
case RGFW_8:
case RGFW_9:
case RGFW_minus:
case RGFW_equal:
case RGFW_tab:
case RGFW_space:
case RGFW_a:
case RGFW_b:
case RGFW_c:
case RGFW_d:
case RGFW_e:
case RGFW_f:
case RGFW_g:
case RGFW_h:
case RGFW_i:
case RGFW_j:
case RGFW_k:
case RGFW_l:
case RGFW_m:
case RGFW_n:
case RGFW_o:
case RGFW_p:
case RGFW_q:
case RGFW_r:
case RGFW_s:
case RGFW_t:
case RGFW_u:
case RGFW_v:
case RGFW_w:
case RGFW_x:
case RGFW_y:
case RGFW_z:
case RGFW_period:
case RGFW_comma:
case RGFW_slash:
case RGFW_bracket:
case RGFW_closeBracket:
case RGFW_semicolon:
case RGFW_apostrophe:
case RGFW_backSlash:
if (keymod == RGFW_modShift) {
mltonChar(toupper((char)key));
break;
} else {
mltonChar((char)key);
break;
}
}
}
}
@@ -47,6 +111,15 @@ void setKeyCallback() {
RGFW_setKeyCallback(keyCallback);
}
void resizeCallback(RGFW_window* window, int width, int height) {
glViewport(0, 0, width, height);
mltonResize(width, height);
}
void setResizeCallback() {
RGFW_setWindowResizedCallback(resizeCallback);
}
void pollEvents() {
RGFW_pollEvents();
}

View File

@@ -19,6 +19,17 @@ struct
val exportEscapeCallback =
_export "mltonEscape" public : (unit -> unit) -> unit;
val exportBackspaceCallback =
_export "mltonBackspace" public : (unit -> unit) -> unit;
val exportEnterCallback =
_export "mltonEnter" public : (unit -> unit) -> unit;
val exportCharCallback =
_export "mltonChar" public : (char -> unit) -> unit;
val setKeyCallback =
_import "setKeyCallback" public : unit -> unit;
val exportResizeCallback =
_export "mltonResize" public : (int * int -> unit) -> unit;
val setResizeCallback =
_import "setResizeCallback" public : unit -> unit;
end

View File

@@ -3,7 +3,7 @@ struct
fun yank string =
Rgfw.writeClipboard (string, String.size string)
fun consumeEvent (drawState, window, msg) =
fun consumeEvent (drawState, msg) =
let
open DrawMsg
@@ -14,19 +14,19 @@ struct
| YANK str => (yank str; drawState)
end
fun consumeEventsLoop (pos, msgVec, drawState, window) =
fun consumeEventsLoop (pos, msgVec, drawState) =
if pos = Vector.length msgVec then
drawState
else
let
val msg = Vector.sub (msgVec, pos)
val drawState = consumeEvent (drawState, window, msg)
val drawState = consumeEvent (drawState, msg)
in
consumeEventsLoop (pos + 1, msgVec, drawState, window)
consumeEventsLoop (pos + 1, msgVec, drawState)
end
fun consumeEvents (drawState, window) =
consumeEventsLoop (0, DrawMailbox.getMessagesAndClear (), drawState, window)
fun consumeEvents drawState =
consumeEventsLoop (0, DrawMailbox.getMessagesAndClear (), drawState)
fun loop (window, app, drawState) =
if Rgfw.shouldCloseWindow window then
@@ -40,6 +40,7 @@ struct
val app = Updater.update app
val drawState = consumeEvents drawState
val () = GlDraw.draw drawState
val () = Rgfw.swapBuffers window
in
@@ -68,17 +69,28 @@ struct
fun ioToLineGap (io, acc) = loop (io, acc, false)
end
fun escapeCallback () =
let
val () = print "73\n"
in
InputMailbox.append InputMsg.KEY_ESC
end
fun escapeCallback () = InputMailbox.append InputMsg.KEY_ESC
fun backspaceCallback () = InputMailbox.append InputMsg.KEY_BACKSPACE
fun enterCallback () = InputMailbox.append InputMsg.KEY_ENTER
fun charCallback chr =
InputMailbox.append (InputMsg.CHAR_EVENT chr)
fun resizeCallback (width, height) =
InputMailbox.append (InputMsg.RESIZE_EVENT (width, height))
fun registerCallbacks () =
let
val () = Rgfw.exportEscapeCallback escapeCallback
val () = Rgfw.exportEscapeCallback escapeCallback
val () = Rgfw.exportBackspaceCallback backspaceCallback
val () = Rgfw.exportEnterCallback enterCallback
val () = Rgfw.exportCharCallback charCallback
val () = Rgfw.setKeyCallback ()
val () = Rgfw.exportResizeCallback resizeCallback
val () = Rgfw.setResizeCallback ()
in
()
end

BIN
shf-glfw Executable file

Binary file not shown.

BIN
shf-rgfw

Binary file not shown.

View File

@@ -1,6 +1,5 @@
# To-do list
- Bind functions from RGFW (alternative back-end/window library) and have an option to use it
- Add callbacks so we can react to events. (Start by adding key callbacks.)
- Added most callbacks, including char callbacks, but I need to change the C side of the char callbacks so that symbols like [ become shifted properly.
- Bind gamepad functions from GLFW
- Modify deletion functions to use `PersistentVector.delete`
- Implement 'yj' motion and add tests for it