mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +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:
		
							
								
								
									
										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)))) |       (ev/call (fn [] (net/accept-loop s handler)))) | ||||||
|     s)) |     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 | ### Flychecking | ||||||
|   | |||||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose