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

More of example 1 and ensuring thread safety executing commands

Browse Source
This commit is contained in:
Hans Dijkema
2025-11-12 20:31:39 +01:00
parent d7f9e3b7ed
commit 31aa5bfd07
3 changed files with 66 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
example1/example-1-dialog.html Normal file
View File

@@ -0,0 +1,17 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>This is test 1 Dialog</title>
</head>
<body>
<h1>Dialog test 1</h1>
<table>
<tr><th>Input 1</th><td><input type="text" id="inp1" /></td></tr>
<tr><th>Input 2</th><td><input type="text" id="inp2" /></td></tr>
<tr><th>Input 3</th><td><input type="text" id="inp3" /></td></tr>
<tr><th></th><td><button id="ok-btn">Ok</button></td></tr>
</table>
</body>
</html>

53
example1/example.rkt
View File

@@ -40,7 +40,7 @@
)) ))
)) ))
(define test-dialog% (define example-1-dialog%
(class ww-webview% (class ww-webview%
(super-new [html-file dialog-html] (super-new [html-file dialog-html]
[width 400] [width 400]
@@ -48,7 +48,7 @@
(define/override (html-loaded) (define/override (html-loaded)
(super html-loaded) (super html-loaded)
(ww-debug "html-loaded for test-dialog%") (ww-debug "html-loaded for example-1-dialog%")
(let* ((btn (send this element 'ok-btn))) (let* ((btn (send this element 'ok-btn)))
(send btn connect 'click (λ (data) (send btn connect 'click (λ (data)
(send this close))))) (send this close)))))
@@ -73,7 +73,7 @@
(let* ((dialog-btn (send this element 'app-button)) (let* ((dialog-btn (send this element 'app-button))
) )
(send dialog-btn connect 'click (λ (data) (send dialog-btn connect 'click (λ (data)
(new test-dialog% [parent this]))) (new example-1-dialog% [parent this])))
) )
(ww-debug "SETTING MENU") (ww-debug "SETTING MENU")
@@ -112,29 +112,38 @@
(send this connect-menu! 'm-start (send this connect-menu! 'm-start
(λ () (λ ()
(set! counter-thread (set! counter-thread
(thread (λ () (thread
(letrec ((f (λ () (λ ()
(when go-on-counter (letrec ((f (λ ()
(set! c-counter (+ c-counter 1)) (when go-on-counter
(send div-counter set-inner-html (format "Count = ~a" c-counter)) (set! c-counter (+ c-counter 1))
(when (and (> c-counter 0) (<= c-counter 1)) (send div-counter set-inner-html (format "Count = ~a" c-counter))
(send div-counter set-style! (css-style '((background white))))) (when (and (> c-counter 0) (<= c-counter 1))
(when (and (> c-counter 100) (<= c-counter 101)) (send div-counter set-style!
(send div-counter set-style! (css-style '((background green) (color white))))) (css-style '((background white)))))
(when (and (> c-counter 200) (<= c-counter 201)) (when (and (> c-counter 100) (<= c-counter 101))
(send div-counter set-style! (string->css-style "background: yellow; font-size: 120%;"))) (send div-counter set-style!
(when (and (> c-counter 300) (<= c-counter 301)) (css-style '((background green) (color white)))))
(send div-counter set-style! (string->css-style "color: white; background: orange; font-size: 130%;"))) (when (and (> c-counter 200) (<= c-counter 201))
(when (and (> c-counter 400) (<= c-counter 401)) (send div-counter set-style!
(send div-counter set-style! (string->css-style "color: white; background: red; font-size: 150%; font-weight: bold;"))) (css-style '((background yellow) (font-size: 120%)))))
(sleep 0.01) (when (and (> c-counter 300) (<= c-counter 301))
(f))))) (send div-counter set-style!
(set! go-on-counter #t) (css-style '((color white) (background orange) (font-size 130%)))))
(f))))))) (when (and (> c-counter 400) (<= c-counter 401))
(send div-counter set-style!
(css-style '((color white) (background red) (font-size 150%) (font-weight bold)))))
(sleep 0.01)
(f)))))
(set! go-on-counter #t)
(f)))))))
(send this connect-menu! 'm-stop (send this connect-menu! 'm-stop
(λ () (λ ()
(set! go-on-counter #f) (set! go-on-counter #f)
(set! c-counter 0))) (set! c-counter 0)))
(send this connect-menu! 'm-prefs (λ () (new example-1-dialog% [parent this])))
) )
) )

27
private/webui-wire-ipc.rkt
View File

@@ -15,6 +15,7 @@
#t #t
#f))) #f)))
;; This function only expects one character, namely \n ;; This function only expects one character, namely \n
;; In windows disable text mode on stdout/stderr of webui-wire. ;; In windows disable text mode on stdout/stderr of webui-wire.
(define (read-eol port) (define (read-eol port)
@@ -62,7 +63,8 @@
) )
(define (webui-ipc event-queuer log-processor) (define (webui-ipc event-queuer log-processor)
(let ((webui-wire-cmd (ww-get-webui-wire-command))) (let ((webui-wire-cmd (ww-get-webui-wire-command))
)
(call-with-values (call-with-values
(λ () (process webui-wire-cmd)) (λ () (process webui-wire-cmd))
(λ (args) (λ (args)
@@ -72,23 +74,30 @@
(process-stderr (cadddr args)) (process-stderr (cadddr args))
(signal-func (car (cddddr args))) (signal-func (car (cddddr args)))
) )
(let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor))) (let ((reader-thrd (process-stderr-reader process-stderr event-queuer log-processor))
(sem (make-semaphore 1))
)
(λ (cmd) (λ (cmd)
(semaphore-wait sem) ; Ensure thread safety
(displayln cmd process-stdin) (displayln cmd process-stdin)
(flush-output process-stdin) (flush-output process-stdin)
(let* ((str-length (read-string 8 process-stdout)) (let* ((str-length (read-string 8 process-stdout))
(colon (read-string 1 process-stdout))) (colon (read-string 1 process-stdout)))
;(displayln (format "len: ~a, str-length: ~a, colon: ~a" (string-length str-length) str-length colon))
(unless (and (string? colon) (unless (and (string? colon)
(string=? colon ":")) (string=? colon ":"))
(semaphore-post sem)
(error "Unexpected input from webui-wire executable")) (error "Unexpected input from webui-wire executable"))
(let* ((length (string->number str-length)) (let* ((length (string->number str-length))
(input (read-string length process-stdout)) (input (read-string length process-stdout))
) )
(read-eol process-stdout) (read-eol process-stdout)
input))))) (semaphore-post sem)
))) input)))
)
)
)
)
)
) )
) ) ; End of module