Working on.

Signed-off-by: Hans Dijkema <hans@dijkewijk.nl>
This commit is contained in:
2025-10-27 10:40:01 +01:00
parent 694d6777e9
commit 799b003729
5 changed files with 262 additions and 112 deletions

View File

@@ -73,21 +73,26 @@
(will-register webwire-will
handle (λ (handle)
(webwire-destroy handle))))
(start-gui-processing)
handle))
#:c-id webwire_new)
(define-libwebui-wire webwire-current
(_fun -> (handle : _webui-handle/null)
-> (begin
(unless (eq? handle #f)
(will-register webwire-will
handle (λ (handle)
(webwire-destroy handle))))
(webwire-destroy handle)))
(start-gui-processing)
)
handle))
#:c-id webwire_current)
(define-libwebui-wire webwire-destroy
(_fun _webui-handle/null -> _void)
(_fun _webui-handle/null -> _void
-> (stop-gui-processing))
#:c-id webwire_destroy)
(define-libwebui-wire webwire-command
@@ -149,7 +154,7 @@
#:c-id webwire_status_string)
(define-libwebui-wire webwire-process-gui
(_fun _webui-handle/null -> _void)
(_fun _webui-handle/null -> _bool)
#:c-id webwire_process_gui)
@@ -263,13 +268,32 @@
; Make sure GUI Events are processed (e.g. for linux - gtk main loop)
(void (thread (λ ()
(let loop ()
(begin
(sleep 0.05)
(webwire-process-gui #f)
;(displayln 'process-gui-ok)
(loop)))
)
)
)
(define gui-processing-thread #f)
(define gui-processing-go-on #f)
(define (start-gui-processing)
(when (eq? gui-processing-thread #f)
(set! gui-processing-go-on #t)
(set! gui-processing-thread (thread (λ ()
(begin
(displayln "gui processing starts")
(letrec ((loop (λ ()
(sleep 0.05)
(let ((processed (webwire-process-gui #f)))
(when (or gui-processing-go-on processed)
(loop))))))
(loop))
(displayln "gui processing stops")
(set! gui-processing-thread #f)))))
)
)
(define (stop-gui-processing)
(void (thread (λ ()
(display "waiting 5 seconds")
(sleep 5)
(displayln "stopping gui processing")
(set! gui-processing-go-on #f)))))