From 105ba5e12466b0864b8f8fc64fcf7f89f96a2383 Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Sun, 12 Jun 2022 18:48:47 -0500
Subject: [PATCH] Add ffi/context and ffi/defbind helpers.

Wrap the very bare-bones FFI library to be a bit more
useful out of the box.
---
 ffitest/gtknew.janet | 52 ++++++++++++++++++++++++++++++++++++++++++++
 src/boot/boot.janet  | 40 ++++++++++++++++++++++++++++++++++
 2 files changed, 92 insertions(+)
 create mode 100644 ffitest/gtknew.janet

diff --git a/ffitest/gtknew.janet b/ffitest/gtknew.janet
new file mode 100644
index 00000000..358d4f35
--- /dev/null
+++ b/ffitest/gtknew.janet
@@ -0,0 +1,52 @@
+(ffi/context "/usr/lib/libgtk-3.so")
+
+(ffi/defbind
+  gtk-application-new :ptr
+  "Add docstrings as needed."
+  [a :ptr b :uint])
+
+(ffi/defbind
+  g-signal-connect-data :ulong
+  [a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
+
+(ffi/defbind
+  g-application-run :int
+  [a :ptr b :int c :ptr])
+
+(ffi/defbind
+  gtk-application-window-new :ptr
+  [a :ptr])
+
+(ffi/defbind
+  gtk-button-new-with-label :ptr
+  [a :ptr])
+
+(ffi/defbind
+  gtk-container-add :void
+  [a :ptr b :ptr])
+
+(ffi/defbind
+  gtk-widget-show-all :void
+  [a :ptr])
+
+(ffi/defbind
+  gtk-button-set-label :void
+  [a :ptr b :ptr])
+
+(def cb (ffi/trampoline :default))
+
+(defn on-active
+  [app]
+  (def window (gtk-application-window-new app))
+  (def btn (gtk-button-new-with-label "Click Me!"))
+  (g-signal-connect-data btn "clicked" cb
+                         (fn [btn] (gtk-button-set-label btn "Hello World"))
+                         nil 1)
+  (gtk-container-add window btn)
+  (gtk-widget-show-all window))
+
+(defn main
+  [&]
+  (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
+  (g-signal-connect-data app "activate" cb on-active nil 1)
+  (g-application-run app 0 nil))
diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index 0b28cc91..e886746b 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -3608,6 +3608,46 @@
       (ev/call (fn [] (net/accept-loop s handler))))
     s))
 
+###
+###
+### FFI Extra
+###
+###
+
+(compwhen (dyn 'ffi/native)
+
+  (defdyn *ffi-context*" Current native library for ffi/bind and other settings")
+
+  (defn- default-mangle
+    [name &]
+    (string/replace-all "-" "_" name))
+
+  (defn ffi/context
+    "Set the path of the dynamic library to implictly bind, as well
+     as other global state for ease of creating native bindings."
+    [native-path &named map-symbols]
+    (def lib (ffi/native native-path))
+    (default map-symbols default-mangle)
+    (setdyn *ffi-context*
+            {:native lib
+             :map-symbols map-symbols}))
+
+  (defmacro ffi/defbind
+    "Generate bindings for native functions in a convenient manner."
+    [name ret-type & body]
+    (def meta (slice body 0 -2))
+    (def arg-pairs (partition 2 (last body)))
+    (def formal-args (map 0 arg-pairs))
+    (def type-args (map 1 arg-pairs))
+    (def ctx (dyn *ffi-context*))
+    (def raw-symbol ((get ctx :map-symbols default-mangle) name))
+    (def ffi-mod (get ctx :native))
+    (def ptr (assert (ffi/lookup ffi-mod raw-symbol) "failed to find symbol"))
+    (def computed-type-args (eval ~[,;type-args]))
+    (def sig (ffi/signature :default ret-type ;computed-type-args))
+    ~(defn ,name ,;meta [,;formal-args]
+       (,ffi/call ,ptr ,sig ,;formal-args))))
+
 ###
 ###
 ### Flychecking