mirror of
https://github.com/janet-lang/janet
synced 2024-11-28 19:19:53 +00:00
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:
parent
ad1b50d1f5
commit
105ba5e124
52
ffitest/gtknew.janet
Normal file
52
ffitest/gtknew.janet
Normal 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))
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user