Native Integration: Platform alert dialog

Revery_Native.opam

@@ -0,0 +1,7 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "[email protected]"
+author: ["Bryan Phelps"]
+build: [
+
+]

esy.lock/index.json

@@ -1,5 +1,5 @@
 {
-  "checksum": "1d81663c61856d7ddee79cf574285e40",
+  "checksum": "172de2e0481d422d5d08539ac434ba67",
   "root": "revery@link:./package.json",
   "node": {
     "revery@link:./package.json": {
@@ -9,7 +9,7 @@
       "source": { "type": "link", "path": ".", "manifest": "package.json" },
       "overrides": [],
       "dependencies": [
-        "[email protected].1012@d41d8cd9",
+        "[email protected].1013@d41d8cd9",
         "[email protected]@d41d8cd9",
         "[email protected]@d41d8cd9", "[email protected]@d41d8cd9",
         "[email protected]@d41d8cd9", "@opam/lwt_ppx@opam:1.2.1@db1172a7",
@@ -66,14 +66,14 @@
       ],
       "devDependencies": []
     },
-    "[email protected].1012@d41d8cd9": {
-      "id": "[email protected].1012@d41d8cd9",
+    "[email protected].1013@d41d8cd9": {
+      "id": "[email protected].1013@d41d8cd9",
       "name": "reason-glfw",
-      "version": "3.2.1012",
+      "version": "3.2.1013",
       "source": {
         "type": "install",
         "source": [
-          "archive:https://registry.npmjs.org/reason-glfw/-/reason-glfw-3.2.1012.tgz#sha1:c1c4383a235a29090fd2ed6f790cd1e7ffdd17ef"
+          "archive:https://registry.npmjs.org/reason-glfw/-/reason-glfw-3.2.1013.tgz#sha1:042b0bdcde972a558c28bcfcefad0a2b1facd062"
         ]
       },
       "overrides": [],
@@ -120,7 +120,7 @@
       },
       "overrides": [],
       "dependencies": [
-        "[email protected]@d41d8cd9", "[email protected].1012@d41d8cd9",
+        "[email protected]@d41d8cd9", "[email protected].1013@d41d8cd9",
         "[email protected]@d41d8cd9",
         "[email protected]@d41d8cd9", "[email protected]@d41d8cd9",
         "[email protected]@d41d8cd9", "@opam/dune@opam:1.6.3@a7d7baed",

examples/Examples.re

@@ -35,6 +35,7 @@ let state: state = {
     {name: "Box Shadow", render: _ => Boxshadow.render()},
     {name: "Focus", render: _ => Focus.render()},
     {name: "Stopwatch", render: _ => Stopwatch.render()},
+    {name: "Native", render: w => Native.render(w)},
     {name: "Input", render: w => InputExample.render(w)},
     {name: "Radio Button", render: _ => RadioButtonExample.render()},
     {name: "Game Of Life", render: _ => GameOfLife.render()},

examples/Native.re

@@ -0,0 +1,34 @@
+open Revery.UI;
+open Revery.UI.Components;
+open Revery.Platform;
+
+module NativeExamples = {
+  let component = React.component("DefaultButtonWithCounter");
+
+  let make = (~window, ()) =>
+    component((_slots: React.Hooks.empty) => {
+      let increment = () => {
+        Dialog.alert(window, "Hello, world");
+      };
+
+      let containerStyle =
+        Style.[
+          position(`Absolute),
+          justifyContent(`Center),
+          alignItems(`Center),
+          bottom(0),
+          top(0),
+          left(0),
+          right(0),
+        ];
+
+      <View style=containerStyle>
+        <Button title="Alert" onClick=increment />
+      </View>;
+    });
+
+  let createElement = (~children as _, ~window, ()) =>
+    React.element(make(~window, ()));
+};
+
+let render = window => <NativeExamples window />;

package.json

@@ -17,17 +17,19 @@
   "esy": {
     "build": [ "dune build --root . -j4" ],
     "install": [
-      "esy-installer Revery.install", "esy-installer Revery_Core.install",
+      "esy-installer Revery.install",
+      "esy-installer Revery_Core.install",
       "esy-installer Revery_Geometry.install",
       "esy-installer Revery_Math.install",
+      "esy-installer Revery_Native.install",
       "esy-installer Revery_Shaders.install",
       "esy-installer Revery_UI.install",
       "esy-installer Revery_UI_Components.install"
     ]
   },
   "dependencies": {
     "@esy-ocaml/reason": "3.4.0",
-    "reason-glfw": "^3.2.1010",
+    "reason-glfw": "^3.2.1013",
     "reason-fontkit": "^2.0.6",
     "reason-gl-matrix": "^0.9.9302",
     "@opam/color": "^0.2.0",

src/Native/Dialog.re

@@ -0,0 +1,5 @@
+open Reglfw.Glfw;
+
+[@noalloc] external alertSupported: unit => bool = "revery_alertSupported";
+
+[@noalloc] external alert: (NativeWindow.t, string) => unit = "revery_alert";

src/Native/ReveryCocoa.h

@@ -0,0 +1,3 @@
+extern "C" {	
+   void revery_alert_cocoa(void* pWin, const char* szMessage);
+}

src/Native/ReveryWin32.h

@@ -0,0 +1,3 @@
+extern "C" {	
+   void revery_alert_win32(void *pWin, const char* szMessage);
+}

src/Native/Revery_Native.re

@@ -0,0 +1 @@
+module Dialog = Dialog;

src/Native/config/discover.ml

@@ -0,0 +1,21 @@
+type os =
+  | Windows 
+  | Mac 
+  | Linux 
+  | Unknown 
+let uname () =
+  let ic = Unix.open_process_in "uname" in
+  let uname = input_line ic in let () = close_in ic in uname
+let get_os =
+  match Sys.os_type with
+  | "Win32" -> Windows
+  | _ ->
+      (match uname () with
+       | "Darwin" -> Mac
+       | "Linux" -> Linux
+       | _ -> Unknown)
+let c_flags =
+  match get_os with | Mac -> ["-I"; "."; "-x"; "objective-c"] | _ -> []
+let flags = []
+;;Configurator.V1.Flags.write_sexp "c_flags.sexp" c_flags;
+  Configurator.V1.Flags.write_sexp "flags.sexp" flags

src/Native/config/dune

@@ -0,0 +1,3 @@
+(executable
+    (name discover)
+    (libraries dune.configurator))

src/Native/dialog.cpp

@@ -0,0 +1,41 @@
+#include <stdio.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+
+#ifdef WIN32
+  #include "ReveryWin32.h"
+#elif __APPLE__
+  #include "ReveryCocoa.h"
+#endif
+
+extern "C" {
+  CAMLprim value
+  revery_alertSupported() {
+  #ifdef WIN32
+      return Val_true;
+  #elif __APPLE__
+      return Val_true;
+  #else
+      return Val_false;
+  #endif
+  }
+
+  CAMLprim value
+  revery_alert(value vWindow, value vMessage) {
+      CAMLparam2(vWindow, vMessage);
+      const char *szMessage = String_val(vMessage);
+      void* pWin = (void *)vWindow;
+
+  #ifdef WIN32
+      revery_alert_win32(pWin, szMessage);
+  #elif __APPLE__
+      revery_alert_cocoa(pWin, szMessage);
+  #else
+      printf("WARNING - Not implemented: alert");
+  #endif
+      return Val_unit;
+  }
+}

src/Native/dialog.js

@@ -0,0 +1,9 @@
+// Provides: revery_alertSupported
+function revery_alertSupported() {
+    return true;
+}
+
+// Provides: revery_alert
+function revery_alert(win, msg) {
+    joo_global_object.alert(msg);
+}

src/Native/dialog_cocoa.c

@@ -0,0 +1,17 @@
+#ifdef __APPLE__
+#include <stdio.h>
+
+#import <Cocoa/Cocoa.h>
+
+void revery_alert_cocoa(void *pWin, const char *szMessage) {
+    NSWindow* pCocoaWin  = (NSWindow *)pWin;
+
+    NSView *view = [[NSView alloc] init];
+    NSAlert *alert = [[NSAlert alloc] init];
+    NSString *message = [NSString stringWithUTF8String:szMessage];
+    [alert addButtonWithTitle:@"Ok"];
+    [alert setMessageText:@"Alert"];
+    [alert setInformativeText:message];
+    [alert runModal];
+}
+#endif

src/Native/dialog_win32.c

@@ -0,0 +1,19 @@
+#ifdef WIN32
+
+#include <stdio.h>
+
+#include <Windows.h>
+#include <winuser.h>
+
+void
+revery_alert_win32(void *pWin, const char *szMessage) {
+    HWND hwnd = (HWND)pWin;
+
+    int msgboxId = MessageBox(
+            hwnd,
+            szMessage,
+            "Alert",
+            MB_ICONWARNING | MB_OK
+            );
+}
+#endif

src/Native/dune

@@ -0,0 +1,15 @@
+(library
+    (name Revery_Native)
+    (public_name Revery_Native)
+    (preprocess (pps lwt_ppx))
+    (library_flags (:include flags.sexp))
+    (js_of_ocaml (javascript_files dialog.js))
+    (c_names dialog_cocoa dialog_win32)
+    (cxx_names dialog)
+    (c_flags (:include c_flags.sexp))
+    (libraries reglfw))
+
+(rule
+(targets c_flags.sexp flags.sexp)
+(deps (:discover config/discover.exe))
+(action (run %{discover})))

src/Platform.re

@@ -0,0 +1,28 @@
+/**
+ * Platform.re
+ *
+ * Thin convenience wrapper over the Revery_Native module.
+ *
+ * Why a wrapper? A couple reasons:
+ * 1) Coerce the `Window.t` type to `NativeWindow.t` transparently, so it doesn't have to be handled in user-space
+ *  2) More importantly, some Platform primitives may need to be 'emulated'. For example, for X11, I'm not sure how to implement dialogs.
+ */
+open Reglfw;
+
+module Window = Revery_Core.Window;
+module Native = Revery_Native;
+
+module Dialog = {
+  let alert = (window: Window.t, message: string) =>
+    if (Native.Dialog.alertSupported()) {
+      let nativeWindow =
+        window |> (w => w.glfwWindow |> Glfw.glfwGetNativeWindow);
+      Native.Dialog.alert(nativeWindow, message);
+    } else {
+      /* TODO */
+      /* Fallback when not supported on a platform */
+      prerr_endline(
+        "WARNING: alert not supported on this platform",
+      );
+    };
+};

src/Revery.re

@@ -14,3 +14,7 @@ module UI = {
 module App = Core.App;
 module Window = Core.Window;
 module Time = Core.Time;
+
+module Platform = {
+  include Platform;
+};

src/dune

@@ -1,4 +1,4 @@
 (library
     (name Revery)
     (public_name Revery)
-    (libraries lwt lwt.unix reglfw Revery_Core Revery_Math Revery_Shaders Revery_Geometry Revery_UI Revery_UI_Components))
+    (libraries lwt lwt.unix reglfw Revery_Core Revery_Math Revery_Shaders Revery_Geometry Revery_UI Revery_UI_Components Revery_Native))