checkpoint (seem to have encountered an FFI bug?)

build-unix-rgfw-debug-.sh

@@ -1,5 +1,5 @@
 #!/bin/sh
 mlton -const 'Exn.keepHistory true' -link-opt "-lX11 -lXrandr -lGL" \
-  -export-header ffi/export.h \
+  -export-header ffi/mlton-rgfw-export.h \
   shf-rgfw.mlb \
   ffi/rgfw-export.c

ffi/mlton-rgfw-export.h

@@ -0,0 +1,169 @@
+#ifndef __SHF_RGFW_ML_H__
+#define __SHF_RGFW_ML_H__
+
+/* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_MLTYPES_H_
+#define _MLTON_MLTYPES_H_
+
+/* We need these because in header files for exported SML functions, 
+ * types.h is included without cenv.h.
+ */
+#if (defined (_AIX) || defined (__hpux__) || defined (__OpenBSD__))
+#include <inttypes.h>
+#elif (defined (__sun__))
+#include <sys/int_types.h>
+#else
+#include <stdint.h>
+#endif
+
+/* ML types */
+typedef unsigned char PointerAux __attribute__ ((may_alias));
+typedef PointerAux* Pointer;
+#define Array(t) Pointer
+#define Ref(t) Pointer
+#define Vector(t) Pointer
+
+typedef int8_t Int8_t;
+typedef int8_t Int8;
+typedef int16_t Int16_t;
+typedef int16_t Int16;
+typedef int32_t Int32_t;
+typedef int32_t Int32;
+typedef int64_t Int64_t;
+typedef int64_t Int64;
+typedef float Real32_t;
+typedef float Real32;
+typedef double Real64_t;
+typedef double Real64;
+typedef uint8_t Word8_t;
+typedef uint8_t Word8;
+typedef uint16_t Word16_t;
+typedef uint16_t Word16;
+typedef uint32_t Word32_t;
+typedef uint32_t Word32;
+typedef uint64_t Word64_t;
+typedef uint64_t Word64;
+
+typedef Int8_t WordS8_t;
+typedef Int8_t WordS8;
+typedef Int16_t WordS16_t;
+typedef Int16_t WordS16;
+typedef Int32_t WordS32_t;
+typedef Int32_t WordS32;
+typedef Int64_t WordS64_t;
+typedef Int64_t WordS64;
+
+typedef Word8_t WordU8_t;
+typedef Word8_t WordU8;
+typedef Word16_t WordU16_t;
+typedef Word16_t WordU16;
+typedef Word32_t WordU32_t;
+typedef Word32_t WordU32;
+typedef Word64_t WordU64_t;
+typedef Word64_t WordU64;
+
+typedef WordU8_t Char8_t;
+typedef WordU8_t Char8;
+typedef WordU16_t Char16_t;
+typedef WordU16_t Char16;
+typedef WordU32_t Char32_t;
+typedef WordU32_t Char32;
+
+typedef Vector(Char8_t) String8_t;
+typedef Vector(Char8_t) String8;
+typedef Vector(Char16_t) String16_t;
+typedef Vector(Char16_t) String16;
+typedef Vector(Char32_t) String32_t;
+typedef Vector(Char32_t) String32;
+
+typedef Int32_t Bool_t;
+typedef Int32_t Bool;
+typedef String8_t NullString8_t;
+typedef String8_t NullString8;
+
+typedef void* CPointer;
+typedef Pointer Objptr;
+
+#endif /* _MLTON_MLTYPES_H_ */
+
+/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a HPND-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_EXPORT_H_
+#define _MLTON_EXPORT_H_
+
+/* ------------------------------------------------- */
+/*                      Symbols                      */
+/* ------------------------------------------------- */
+
+/* An external symbol is something not defined by the module
+ * (executable or library) being built. Rather, it is provided
+ * from a library dependency (dll, dylib, or shared object).
+ *
+ * A public symbol is defined in this module as being available
+ * to users outside of this module. If building a library, this 
+ * means the symbol will be part of the public interface.
+ * 
+ * A private symbol is defined within this module, but will not
+ * be made available outside of it. This is typically used for
+ * internal implementation details that should not be accessible.
+ */
+
+#if defined(_WIN32) || defined(_WIN64) || defined(__CYGWIN__)
+#define EXTERNAL __declspec(dllimport)
+#define PUBLIC   __declspec(dllexport)
+#define PRIVATE
+#else
+#define EXTERNAL __attribute__((visibility("default")))
+#define PUBLIC   __attribute__((visibility("default")))
+#define PRIVATE  __attribute__((visibility("hidden")))
+#endif
+
+#endif /* _MLTON_EXPORT_H_ */
+
+#if !defined(PART_OF_SHF_RGFW) && \
+    !defined(STATIC_LINK_SHF_RGFW) && \
+    !defined(DYNAMIC_LINK_SHF_RGFW)
+#define PART_OF_SHF_RGFW
+#endif
+
+#if defined(PART_OF_SHF_RGFW)
+#define MLLIB_PRIVATE(x) PRIVATE x
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(STATIC_LINK_SHF_RGFW)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) PUBLIC x
+#elif defined(DYNAMIC_LINK_SHF_RGFW)
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x) EXTERNAL x
+#else
+#error Must specify linkage for shf_rgfw
+#define MLLIB_PRIVATE(x)
+#define MLLIB_PUBLIC(x)
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+MLLIB_PUBLIC(void mltonEscape ();)
+
+#undef MLLIB_PRIVATE
+#undef MLLIB_PUBLIC
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __SHF_RGFW_ML_H__ */

ffi/rgfw-export.c

@@ -7,6 +7,7 @@
 #include "RGFW.h"
 #include <GLES3/gl3.h>
 #include <stdbool.h>
+#include "mlton-rgfw-export.h"
 
 RGFW_window* createWindow(char* title, int x, int y, int width, int height) {
   return RGFW_createWindow(title, x, y, width, height, RGFW_windowCenter | RGFW_windowOpenGL);
@@ -16,7 +17,7 @@ void closeWindow(RGFW_window* window) {
   RGFW_window_close(window);
 }
 
-bool shouldCloseWindow(RGFW_window* window) {
+Bool shouldCloseWindow(RGFW_window* window) {
   if (RGFW_window_shouldClose(window)) {
     return true;
   } else {
@@ -32,6 +33,22 @@ void writeClipboard(char* string, int stringSize) {
   RGFW_writeClipboard(string, stringSize);
 }
 
+void keyCallback(RGFW_window* window, unsigned char key, unsigned char symbol, unsigned char keymod, unsigned char repeated, unsigned char pressed) {
+  if (pressed || repeated) {
+    if (key == RGFW_escape) {
+      mltonEscape();
+    }
+  }
+}
+
+void setKeyCallback() {
+  RGFW_setKeyCallback(keyCallback);
+}
+
+void pollEvents() {
+  RGFW_pollEvents();
+}
+
 // OpenGL constants used below
 unsigned int VERTEX_SHADER = GL_VERTEX_SHADER;
 unsigned int FRAGMENT_SHADER = GL_FRAGMENT_SHADER;

ffi/rgfw-import.sml

@@ -10,7 +10,15 @@ struct
   val shouldCloseWindow =
     _import "shouldCloseWindow" public : window -> bool;
   val swapBuffers =
-    _import "swapBuffers" public reentrant : window -> unit;
+    _import "swapBuffers" public : window -> unit;
+  val pollEvents =
+    _import "pollEvents" public reentrant : unit -> unit;
+
   val writeClipboard =
     _import "writeClipboard" public : string * int -> unit;
+
+  val exportEscapeCallback =
+    _export "mltonEscape" public : (unit -> unit) -> unit;
+  val setKeyCallback =
+    _import "setKeyCallback" public : unit -> unit;
 end

shell/rgfw-loop.sml

@@ -33,8 +33,10 @@ struct
       Rgfw.closeWindow window
     else
       let
-        val _ = Gles3.clearColor (0.89, 0.89, 0.89, 1.0)
+        val () = Gles3.clearColor (0.89, 0.89, 0.89, 1.0)
-        val _ = Gles3.clear ()
+        val () = Gles3.clear ()
+
+        val () = Rgfw.pollEvents ()
 
         val app = Updater.update app
 
@@ -66,6 +68,21 @@ 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 registerCallbacks () =
+    let
+      val () = Rgfw.exportEscapeCallback escapeCallback 
+      val () = Rgfw.setKeyCallback ()
+    in
+      ()
+    end
+
   fun main () =
     let
       val window = Rgfw.createWindow ("shf", 0, 0, 1920, 1080)
@@ -74,7 +91,9 @@ struct
       (* load file intol gap buffer and create initial app *)
       val io = TextIO.openIn "temp.txt"
       val lineGap = ioToLineGap (io, LineGap.empty)
-      val _ = TextIO.closeIn io
+      val () = TextIO.closeIn io
+
+      val () = registerCallbacks ()
 
       val app = AppType.init (lineGap, 1920, 1080, Time.now ())
       val drawState = GlDraw.create ()