Add ffi/context and ffi/defbind helpers.

Wrap the very bare-bones FFI library to be a bit more
useful out of the box.
This commit is contained in:
Calvin Rose 2022-06-12 18:48:47 -05:00
parent ad1b50d1f5
commit 105ba5e124
2 changed files with 92 additions and 0 deletions

52
ffitest/gtknew.janet Normal file
View File

@ -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))

View File

@ -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