-

private/racket-webview-ffi.rkt

@@ -0,0 +1,196 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/define
+         ffi/unsafe/atomic
+         ffi/unsafe/os-thread
+         racket/async-channel
+         racket/runtime-path
+         racket/port
+         data/queue
+         json
+         racket/string
+         racket/path
+         )
+
+(provide rkt_create_webview
+         rkt_webview_navigate
+         rkt_webview_set_html
+         rkt_webview_valid
+         rkt_webview_run_js
+         ;rkt_webview_call_js
+         rkt_webview_pending_events
+         rkt_webview_get_event
+         rkt_webview_set_event_callback!
+         rkt_webview_clear_event_callback!
+         rkt_webview_devtools
+         rkt_webview_last_reason
+         rkt_webview_destroy_item
+         rkt_webview_item_data
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; FFI Library
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define lib-type 'release)
+
+(define-runtime-path lib-dir "lib")
+
+(define libname (let ((os (system-type 'os*)))
+                  (cond ((eq? os 'windows) (format "rktwebview.dll"))
+                        ((eq? os 'linux) (format "librktwebview.so"))
+                        (else (error (format "OS ~a not supported" os)))))
+  )
+;(set! libname "../rktwebview/build/Release/rktwebview.dll")
+(set! libname "../rktwebview/build/Release/librktwebview.so")
+(define webview-lib-file (build-path lib-dir libname))
+
+(define webview-lib (ffi-lib webview-lib-file))
+(define-ffi-definer define-rktwebview webview-lib)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Types
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define _rkt_webview_t (_cpointer 'rkt-webview-t))
+(define _char _int8)
+
+(define _result_t
+  (_enum '(oke = 0
+           error = 1
+           )
+         )
+  )
+
+(define _context_t
+  (_enum '(context-invalid = 0
+           bound-event = 1
+           window-resize = 2
+           window-move = 3
+           window-can-close = 4
+           window-closed = 5
+           )
+         )
+  )
+
+
+(define _reason_t
+  (_enum '(
+           reason_no_result_yet = -1
+           reason_oke = 0
+           reason_set_html_failed
+           reason_set_navigate_failed
+           reason_eval_js_failed
+           reason_no_devtools_on_platform
+           reason_no_delegate_for_context
+           )))
+
+(define-cstruct _rkt_item_t
+  (
+   [context _int]
+   [data _string*/utf-8]
+   )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ASync apply
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define item-queue (make-queue))
+(define callback-hash (make-hash))
+
+(define callback-box (box '()))
+
+(define (apply-async thunk)
+  (thunk))
+
+(define (std-callback id item)
+  (enqueue! item-queue (list id item)))
+
+(thread (λ ()
+          (letrec ((dispatch (λ ()
+                               (if (> (queue-length item-queue) 0)
+                                   (let* ((entry (dequeue! item-queue))
+                                          (id (car entry))
+                                          (item (cadr entry))
+                                          (cb (hash-ref callback-hash id
+                                                        (λ args #f)))
+                                          (context (rkt_item_t-context item))
+                                          (data (rkt_item_t-data item))
+                                          )
+                                     (cb context data)
+                                     (rkt_webview_destroy_item item)
+                                     (dispatch)
+                                     )
+                                   (begin
+                                     (sleep 0.05)
+                                     (dispatch))))))
+            (dispatch))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+         
+;RKTWEBVIEW_EXPORT rkt_webview_t *rkt_create_webview()
+(define-rktwebview rkt_create_webview
+  (_fun -> _rkt_webview_t))
+
+;RKTWEBVIEW_EXPORT result_t rkt_navigate(rkt_webview_t *wv, const char *url)
+(define-rktwebview rkt_webview_navigate
+  (_fun _rkt_webview_t _string/utf-8 -> _result_t))
+
+;RKTWEBVIEW_EXPORT result_t rkt_set_html(rkt_webview_t *wv, const char *html)
+(define-rktwebview rkt_webview_set_html
+  (_fun _rkt_webview_t _string/utf-8 -> _result_t))
+
+;RKTWEBVIEW_EXPORT bool rkt_webview_valid(rkt_webview_t *handle)
+(define-rktwebview rkt_webview_valid
+  (_fun _rkt_webview_t -> _int))
+
+;RKTWEBVIEW_EXPORT result_t rkt_run_js(rkt_webview_t *handle, const char *js);
+(define-rktwebview rkt_webview_run_js
+  (_fun _rkt_webview_t _string/utf-8 -> _result_t))
+
+;RKTWEBVIEW_EXPORT char *rkt_webview_call_js(rkt_webview_t *handle, const char *js);
+;(define-rktwebview rkt_webview_call_js
+;  (_fun _rkt_webview_t _string/utf-8 -> _rkt_item_t))
+
+;RKTWEBVIEW_EXPORT int rkt_webview_pending_events(rkt_webview_t *wv);
+(define-rktwebview rkt_webview_pending_events
+  (_fun _rkt_webview_t -> _int))
+
+;RKTWEBVIEW_EXPORT item_t rkt_webview_get_event(rkt_webview_t *wv);
+(define-rktwebview rkt_webview_get_event
+  (_fun _rkt_webview_t -> _rkt_item_t))
+
+;RKTWEBVIEW_EXPORT void rkt_webview_register_queue_callback(rkt_webview_t *wv, void(*cb)(item_t item));
+(define-rktwebview rkt_webview_register_queue_callback
+  (_fun _rkt_webview_t _int 
+        (_fun #:keep callback-box #:async-apply apply-async
+              _int _rkt_item_t -> _void) -> _void))
+
+(define (rkt_webview_set_event_callback! wv id cb)
+  (hash-set! callback-hash id cb)
+  (rkt_webview_register_queue_callback wv id std-callback)
+  )
+
+(define (rkt_webview_clear_event_callback! wv id)
+  (hash-remove! callback-hash id)
+  (rkt_webview_register_queue_callback wv #f))
+
+;RKTWEBVIEW_EXPORT void (item_t item)
+(define-rktwebview rkt_webview_destroy_item
+  (_fun _rkt_item_t -> _void))
+
+;RKTWEBVIEW_EXPORT result_t rkt_webview_devtools(rkt_webview_t *wv)
+(define-rktwebview rkt_webview_devtools
+  (_fun _rkt_webview_t -> _result_t))
+
+;RKTWEBVIEW_EXPORT reason_t rkt_webview_last_reason(rkt_webview_t *wv)
+(define-rktwebview rkt_webview_last_reason
+  (_fun _rkt_webview_t -> _reason_t))
+
+(define (rkt_webview_item_data item)
+  (rkt_item_t-data item))
+