Events callback toegevoegd.

racket-webview-qt.rkt

@@ -4,7 +4,9 @@
          ffi/unsafe/define
          ffi/unsafe/atomic
          ffi/unsafe/os-thread
+         ffi/unsafe/os-async-channel
          ffi/unsafe/cvector
+         ffi/unsafe/custodian
          racket/async-channel
          racket/runtime-path
          racket/port
@@ -515,6 +517,12 @@
 (rkt_webview_env (list->cvector rkt_env _string/utf-8))
 (rkt_webview_init)
 
+(define events-channel (make-os-async-channel))
+
+(define (event-callback num)
+  (os-async-channel-put events-channel num))
+
+(rkt_webview_register_evt_callback event-callback)
 
 ;(set! quiet-call (start-event-processing))
 (define evt-cb-hash (make-hash))
@@ -523,6 +531,7 @@
 ;; TODO Make this more semaphore like..
 ;; EG callback from library.
 
+#|
 (define (start-event-processing)
   (thread (λ ()
             (letrec ((f (λ ()
@@ -558,6 +567,37 @@
               (f)))
           )
   )
+|#
+
+(define (start-event-processing)
+   (thread (λ ()
+     (letrec
+         ((f
+           (λ ()
+             (let ((waiting (sync events-channel)))
+               (set! waiting (rkt_webview_events_waiting))
+               ;(displayln (format "Events waiting: ~a" waiting))
+               (while (> waiting 0)
+                      (let* ((rkt-evt (rkt_webview_get_event)))
+                        (if (eq? rkt-evt #f)
+                            (displayln (format "Unexpected: event = nullptr"))
+                            (let* ((data (rkt_data_t-data rkt-evt))
+                                   (e (union-ref data 1))
+                                   (wv (rkt_evt_t-w e))
+                                   (evt (cast (rkt_evt_t-evt e)
+                                                             _pointer
+                                                             _string*/utf-8))
+                                   )
+                              (rkt_webview_free_data rkt-evt)
+                              (let ((cb (hash-ref evt-cb-hash wv #f)))
+                                (unless (eq? cb #f)
+                                  (cb evt))))))
+                      (set! waiting (- waiting 1))
+                      )
+               )
+             (f))
+           ))
+       (f)))))
 
 (define evt-processing-thread (start-event-processing))
 
@@ -575,6 +615,7 @@
 
 (define rkt-wv-store (make-hash))
 
+#|
 (define (rkt-process-events handle)
   (if (> (queue-length (rkt-wv-evt-queue handle)) 0)
       (let ((evt (dequeue! (rkt-wv-evt-queue handle))))
@@ -592,45 +633,44 @@
         )
       'done)
   )
-
+|#
 
 (define (rkt-webview-new-context boilerplate-js server-cert)
-  (rkt_webview_new_context boilerplate-js server-cert))
+  (let ((r (rkt_webview_new_context boilerplate-js server-cert)))
+    r))
 
 (define (rkt-webview-create context parent evt-callback close-callback)
   (let* ((evt-queue (make-queue))
          (parent-win (if (eq? parent #f) 0 (rkt-wv-win parent)))
          )
     (let ((wv (rkt_webview_create context parent-win)))
-      (hash-set! evt-cb-hash wv (λ (evt) (enqueue! evt-queue evt)))
+      ;(λ (evt) (enqueue! evt-queue evt)))
-;                                  (λ (rkt-evt)
+
-;                                    (let* ((e (union-ref (rkt_data_t-data rkt-evt) 1))
-;                                           (evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
-;                                      (rkt_webview_free_data rkt-evt)   ; Free event data ASAP
-;                                      (enqueue! evt-queue evt)
-;                                      )))))
       (let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
-        (thread (λ ()
+        (hash-set! evt-cb-hash wv (λ (evt) (evt-callback handle evt)))
-                  (sleep 0.01)
+        ;(thread (λ ()
-                  (letrec ((f (λ ()
+        ;          (sleep 0.01)
-                              (let ((r (rkt-process-events handle)))
+        ;          (letrec ((f (λ ()
-                                (if (eq? r 'quit)
+        ;                      (let ((r (rkt-process-events handle)))
-                                    (begin
+        ;                        (if (eq? r 'quit)
-                                      (set-rkt-wv-valid! handle #f)
+        ;                            (begin
-                                      (info-webview "Quitting event loop")
+        ;                              (set-rkt-wv-valid! handle #f)
-                                      'done)
+        ;                              (info-webview "Quitting event loop")
-                                    (begin
+        ;                              'done)
-                                      ;(displayln "Waiting for events.")
+        ;                            (begin
-                                      (sleep 0.01)
+        ;                              ;(displayln "Waiting for events.")
-                                      (f)))))))
+        ;                              (sleep 0.01)
-                    (f))))
+        ;                              (f)))))))
+        ;            (f))))
         (hash-set! rkt-wv-store (rkt-wv-win handle) handle)
         handle))))
 
 (define (rkt-webview-close handle)
   (rkt_webview_close (rkt-wv-win handle))
-  (enqueue! (rkt-wv-evt-queue handle) 'quit)
+  ;(enqueue! (rkt-wv-evt-queue handle) 'quit)
+  (set-rkt-wv-valid! handle #f)
   (hash-remove! evt-cb-hash (rkt-wv-win handle))
+  (hash-remove! rkt-wv-store (rkt-wv-win handle))
   ((rkt-wv-close-callback handle))
   #t)