hans/racket-webview
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Events callback toegevoegd.

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-10 23:50:02 +02:00
parent c01274c7bd
commit 7d2d3e0bd2
1 changed files with 64 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

88
racket-webview-qt.rkt
View File

@@ -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)))
; (λ (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)
; )))))
;(λ (evt) (enqueue! evt-queue evt)))
(let ((handle (make-rkt-wv wv evt-queue evt-callback #t close-callback)))
(thread (λ ()
(sleep 0.01)
(letrec ((f (λ ()
(let ((r (rkt-process-events handle)))
(if (eq? r 'quit)
(begin
(set-rkt-wv-valid! handle #f)
(info-webview "Quitting event loop")
'done)
(begin
;(displayln "Waiting for events.")
(sleep 0.01)
(f)))))))
(f))))
(hash-set! evt-cb-hash wv (λ (evt) (evt-callback handle evt)))
;(thread (λ ()
; (sleep 0.01)
; (letrec ((f (λ ()
; (let ((r (rkt-process-events handle)))
; (if (eq? r 'quit)
; (begin
; (set-rkt-wv-valid! handle #f)
; (info-webview "Quitting event loop")
; 'done)
; (begin
; ;(displayln "Waiting for events.")
; (sleep 0.01)
; (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)