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%
(super-new [html-file dialog-html]
[width 400]
@@ -48,7 +48,7 @@
(define/override (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)))
(send btn connect 'click (λ (data)
(send this close)))))
@@ -73,7 +73,7 @@
(let* ((dialog-btn (send this element 'app-button))
)
(send dialog-btn connect 'click (λ (data)
(new test-dialog% [parent this])))
(new example-1-dialog% [parent this])))
)
(ww-debug "SETTING MENU")
@@ -112,30 +112,39 @@
(send this connect-menu! 'm-start
(λ ()
(set! counter-thread
(thread (λ ()
(letrec ((f (λ ()
(when go-on-counter
(set! c-counter (+ c-counter 1))
(send div-counter set-inner-html (format "Count = ~a" c-counter))
(when (and (> c-counter 0) (<= c-counter 1))
(send div-counter set-style! (css-style '((background white)))))
(when (and (> c-counter 100) (<= c-counter 101))
(send div-counter set-style! (css-style '((background green) (color white)))))
(when (and (> c-counter 200) (<= c-counter 201))
(send div-counter set-style! (string->css-style "background: yellow; font-size: 120%;")))
(when (and (> c-counter 300) (<= c-counter 301))
(send div-counter set-style! (string->css-style "color: white; background: orange; font-size: 130%;")))
(when (and (> c-counter 400) (<= c-counter 401))
(send div-counter set-style! (string->css-style "color: white; background: red; font-size: 150%; font-weight: bold;")))
(sleep 0.01)
(f)))))
(set! go-on-counter #t)
(f)))))))
(thread
(λ ()
(letrec ((f (λ ()
(when go-on-counter
(set! c-counter (+ c-counter 1))
(send div-counter set-inner-html (format "Count = ~a" c-counter))
(when (and (> c-counter 0) (<= c-counter 1))
(send div-counter set-style!
(css-style '((background white)))))
(when (and (> c-counter 100) (<= c-counter 101))
(send div-counter set-style!
(css-style '((background green) (color white)))))
(when (and (> c-counter 200) (<= c-counter 201))
(send div-counter set-style!
(css-style '((background yellow) (font-size: 120%)))))
(when (and (> c-counter 300) (<= c-counter 301))
(send div-counter set-style!
(css-style '((color white) (background orange) (font-size 130%)))))
(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
(λ ()
(set! go-on-counter #f)
(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
#f)))
;; This function only expects one character, namely \n
;; In windows disable text mode on stdout/stderr of webui-wire.
(define (read-eol port)
@@ -62,7 +63,8 @@
)
(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
(λ () (process webui-wire-cmd))
(λ (args)
@@ -72,23 +74,30 @@
(process-stderr (cadddr 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)
(semaphore-wait sem) ; Ensure thread safety
(displayln cmd process-stdin)
(flush-output process-stdin)
(let* ((str-length (read-string 8 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)
(string=? colon ":"))
(string=? colon ":"))
(semaphore-post sem)
(error "Unexpected input from webui-wire executable"))
(let* ((length (string->number str-length))
(input (read-string length process-stdout))
)
(read-eol process-stdout)
input)))))
)))
(read-eol process-stdout)
(semaphore-post sem)
input)))
)
)
)
)
)
)
)
) ; End of module