589 lines
21 KiB
Racket
589 lines
21 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/unsafe/atomic
|
|
racket/async-channel
|
|
racket/runtime-path
|
|
racket/port
|
|
data/queue
|
|
json
|
|
racket/string
|
|
racket/path
|
|
"mimetypes.rkt"
|
|
)
|
|
|
|
(provide webui-new-window
|
|
webui-show
|
|
webui-bind
|
|
webui-wait-async
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FFI Library
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define lib-type 'release)
|
|
|
|
(define-runtime-path lib-dir "lib")
|
|
|
|
(define libname (let ((os (system-type 'os*)))
|
|
(cond ((eq? os 'windows) (format "dll/webui-2-~a.dll" lib-type))
|
|
(else (error (format "OS ~a not supported" os)))))
|
|
)
|
|
|
|
(define webui-lib-file (build-path lib-dir libname))
|
|
|
|
|
|
(define webui-lib (ffi-lib webui-lib-file))
|
|
(define-ffi-definer define-webui webui-lib)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Types
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define _size_t _int64)
|
|
|
|
(define _webui_config_t
|
|
(_enum '(show-wait-connection = 0
|
|
ui-event-blocking
|
|
folder-monitor
|
|
multi-client
|
|
use-cookies
|
|
asynchronous-response
|
|
)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Handling events
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
(define-cstruct _Webui_event_t
|
|
(
|
|
[win _size_t]
|
|
[event_type _size_t]
|
|
[element _string/utf-8]
|
|
[event_number _size_t]
|
|
[bind_id _size_t]
|
|
[client_id _size_t]
|
|
[connection_id _size_t]
|
|
[cookies _string/utf-8]
|
|
))
|
|
|
|
(define-struct webui-evt
|
|
(win event-type element event-number bind-id client-id connection-id cookies
|
|
(data #:mutable))
|
|
#:transparent
|
|
)
|
|
|
|
; ---------------------------------------------------------------------------
|
|
; Thread-safe queue — dispatches C callbacks onto a Racket thread
|
|
; async-channel is safe to put to from any OS thread (including WebUI's
|
|
; WebSocket threads) and never allocates inside a GC atomic section.
|
|
; ---------------------------------------------------------------------------
|
|
|
|
;(define callback-queue (make-async-channel))
|
|
|
|
(define (enqueue-callback thunk)
|
|
; This does not work, as C memory will already be deallocated when the racket thread handles
|
|
; the callback.
|
|
;(async-channel-put callback-queue thunk))
|
|
(thunk))
|
|
|
|
; Any C callback created from a Racket procedure via (_fun #:keep callback-store ...)
|
|
; is stored here, making it a permanent GC root. Without this, Racket CS's moving
|
|
; GC can collect/relocate the trampoline between webui_interface_bind and invocation.
|
|
(define callback-store (box '()))
|
|
|
|
;(void
|
|
; (thread (lambda ()
|
|
; (let loop ()
|
|
; ((async-channel-get callback-queue))
|
|
; (loop)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Handling of bind events.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define bind-event-queue (make-queue))
|
|
(define bind-event-sem (make-semaphore))
|
|
(define bind-callbacks (make-hash))
|
|
|
|
(define (handle-bind-event c-evt-ptr)
|
|
(let ((evt (make-webui-evt
|
|
(Webui_event_t-win c-evt-ptr)
|
|
(Webui_event_t-event_type c-evt-ptr)
|
|
(Webui_event_t-element c-evt-ptr)
|
|
(Webui_event_t-event_number c-evt-ptr)
|
|
(Webui_event_t-bind_id c-evt-ptr)
|
|
(Webui_event_t-client_id c-evt-ptr)
|
|
(Webui_event_t-connection_id c-evt-ptr)
|
|
(Webui_event_t-cookies c-evt-ptr)
|
|
#f
|
|
)))
|
|
(let ((count (webui_get_count c-evt-ptr)))
|
|
(when (> count 0)
|
|
(set-webui-evt-data! evt (webui_get_string_at c-evt-ptr 0))))
|
|
(enqueue! bind-event-queue evt)
|
|
;(semaphore-post bind-event-sem) ; In atomic mode no synchronization events
|
|
; must be triggered.
|
|
; As this is atomic mode, enqueue! will not interfere with dequeue!
|
|
)
|
|
)
|
|
|
|
(define bind-event-dispatcher
|
|
(thread (λ ()
|
|
(letrec ((dispatch-loop
|
|
(λ ()
|
|
;(semaphore-wait bind-event-sem)
|
|
(when (> (queue-length bind-event-queue) 0)
|
|
(displayln (queue->list bind-event-queue))
|
|
(let* ((evt (dequeue! bind-event-queue))
|
|
(data (webui-evt-data evt))
|
|
(win (webui-evt-win evt))
|
|
(event-number (webui-evt-event-number evt)))
|
|
(with-handlers ([exn:fail? (λ (e)
|
|
(displayln
|
|
(format "Event dispatching failed for: ~a" data))
|
|
(displayln
|
|
(format "Exception: ~a" e))
|
|
(webui_interface_set_response win event-number "")
|
|
)])
|
|
(let* ((bind-evt (with-input-from-string data read-json))
|
|
(id (hash-ref bind-evt 'id #f))
|
|
(sel (hash-ref bind-evt 'selector 'any))
|
|
(event (hash-ref bind-evt 'evt #f))
|
|
(callback-id (string->symbol (format "sel-~a-~a" sel event)))
|
|
(cbs (hash-ref bind-callbacks win #f)))
|
|
(cond
|
|
([eq? cbs #f]
|
|
(error (format "No callbacks registered for window: ~a" win)))
|
|
(else
|
|
(let ((evt-handler (hash-ref cbs callback-id #f)))
|
|
(cond
|
|
([eq? evt-handler #f]
|
|
(error (format "No callback registered for: ~a" callback-id)))
|
|
(else
|
|
(let ((result (evt-handler win id bind-evt)))
|
|
(webui_interface_set_response win event-number
|
|
(if (and result (not (void? result)))
|
|
(format "~a" result)
|
|
""))))))))))))
|
|
(unless (> (queue-length bind-event-queue) 0)
|
|
(sleep 0.1))
|
|
(dispatch-loop))))
|
|
(dispatch-loop))))
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Log applier
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define timer-display (λ displ #t))
|
|
|
|
(define debug-log (make-queue))
|
|
|
|
(define (log-applier thunk)
|
|
(start-atomic)
|
|
(thunk)
|
|
(end-atomic)
|
|
)
|
|
|
|
(define (do-log level message data)
|
|
(enqueue! debug-log (list level (timer-display #f)
|
|
(bytes-copy message))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Serving virtual files...
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define file-handler-queue (make-queue))
|
|
(define file-handler-sem (make-semaphore))
|
|
(define file-handler-file-providers (make-hash))
|
|
|
|
(define (file-handler-callback win filename length-ptr)
|
|
(let ((fn (format "~a" filename)))
|
|
(enqueue! file-handler-queue (list win fn (timer-display #f)))
|
|
;(semaphore-post file-handler-sem)
|
|
#f ; return NULL and later set the data via async response
|
|
))
|
|
|
|
(define (make-reply file)
|
|
(if (file-exists? file)
|
|
(cond ((or (string-suffix? file ".html")
|
|
(string-suffix? file ".htm")
|
|
)
|
|
(let* ((size (file-size file))
|
|
(fin (open-input-file file))
|
|
(str (read-string size fin)))
|
|
(let ((reply (string->bytes/utf-8
|
|
(string-append
|
|
"HTTP/1.1 200 OK\r\n"
|
|
"Content-Type: text/html\r\n"
|
|
(format "Content-Length: ~a\r\n\r\n" size)
|
|
str))))
|
|
(close-input-port fin)
|
|
(displayln (format "Returning http response of ~a bytes" (bytes-length reply)))
|
|
(list #t (bytes-length reply) reply)))
|
|
)
|
|
(else (let* ((size (file-size file))
|
|
(ext (substring (bytes->string/utf-8
|
|
(path-get-extension file)) 1))
|
|
(fin (open-input-file file))
|
|
(bytes (read-bytes size fin)))
|
|
(let* ((hdr (string-append
|
|
"HTTP/1.1 200 OK\r\n"
|
|
(format "Content-Type: ~a\r\n" (ext->mimetype ext))
|
|
(format "Content-Length: ~a\r\n\r\n" size)
|
|
))
|
|
(reply (bytes-append (string->bytes/utf-8 hdr) bytes))
|
|
)
|
|
(close-input-port fin)
|
|
(displayln (format "Returning http response of ~a bytes" (bytes-length reply)))
|
|
(list #t (bytes-length reply) reply)))
|
|
)
|
|
)
|
|
(begin
|
|
(displayln (format "File ~a does not exist" file))
|
|
(list #f 0 ""))
|
|
)
|
|
)
|
|
|
|
(define file-handler-dispatcher
|
|
(thread
|
|
(λ ()
|
|
(letrec ((dispatch-loop
|
|
(λ ()
|
|
;(semaphore-wait file-handler-sem)
|
|
(when (> (queue-length file-handler-queue) 0)
|
|
(timer-display)
|
|
(displayln (queue->list file-handler-queue))
|
|
(let* ((req (dequeue! file-handler-queue))
|
|
(win (car req))
|
|
(req-filename (cadr req))
|
|
(filename ((hash-ref file-handler-file-providers win) req-filename))
|
|
(time (caddr req))
|
|
(reply (make-reply filename)))
|
|
(displayln (format "http-req: ~a at ~a" filename time))
|
|
(let ((valid-reply (car reply))
|
|
(length (cadr reply))
|
|
(content (caddr reply)))
|
|
(if valid-reply
|
|
(webui_interface_set_response_file_handler win content length)
|
|
(webui_interface_set_response_file_handler win #f 0))
|
|
)
|
|
))
|
|
(unless (> (queue-length file-handler-queue) 0)
|
|
(sleep 0.1))
|
|
(dispatch-loop))
|
|
))
|
|
(dispatch-loop))
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; FFI functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define _int-pointer (_ptr i _int))
|
|
|
|
(define _Webui_Bind_Callback
|
|
(_fun #:keep callback-store #:async-apply enqueue-callback
|
|
_Webui_event_t-pointer -> _void))
|
|
|
|
(define _Webui_FileHandler_Callback
|
|
(_fun #:keep callback-store #:async-apply enqueue-callback
|
|
_string/utf-8 _int-pointer -> _pointer))
|
|
|
|
(define _Webui_FileHandlerWin_Callback
|
|
(_fun #:keep callback-store #:async-apply enqueue-callback
|
|
_size_t _string/utf-8 _int-pointer -> _pointer))
|
|
|
|
;WEBUI_EXPORT bool webui_wait_async(void);
|
|
(define-webui webui_wait_async (_fun -> _int))
|
|
|
|
;WEBUI_EXPORT size_t webui_new_window(void);
|
|
(define-webui webui_new_window (_fun -> _size_t))
|
|
|
|
;WEBUI_EXPORT size_t webui_bind(size_t window, const char* element, void (*func)(webui_event_t* e));
|
|
(define-webui webui_bind (_fun _size_t _string/utf-8 _Webui_Bind_Callback -> _size_t))
|
|
|
|
;WEBUI_EXPORT bool webui_show(size_t window, const char* content);
|
|
(define-webui webui_show (_fun _size_t _string/utf-8 -> _int))
|
|
|
|
;WEBUI_EXPORT bool webui_show_browser(size_t window, const char* content, size_t browser);
|
|
(define-webui webui_show_browser (_fun _size_t _string/utf-8 _size_t -> _int))
|
|
|
|
;WEBUI_EXPORT bool webui_show_wv(size_t window, const char* content);
|
|
(define-webui webui_show_wv (_fun _size_t _string/utf-8 -> _int))
|
|
|
|
;WEBUI_EXPORT void webui_exit(void);
|
|
(define-webui webui_exit (_fun -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_destroy(size_t window);
|
|
(define-webui webui_destroy (_fun _size_t -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_close(size_t window);
|
|
(define-webui webui_close (_fun _size_t -> _void))
|
|
|
|
;WEBUI_EXPORT bool webui_set_root_folder(size_t window, const char* path);
|
|
(define-webui webui_set_root_folder (_fun _size_t _string/utf-8 -> _int))
|
|
|
|
;WEBUI_EXPORT void webui_run(size_t window, const char* script);
|
|
(define-webui webui_run (_fun _size_t _string/utf-8 -> _void))
|
|
|
|
;WEBUI_EXPORT size_t webui_get_count(webui_event_t* e);
|
|
(define-webui webui_get_count (_fun _Webui_event_t-pointer -> _size_t))
|
|
|
|
;WEBUI_EXPORT long long int webui_get_int_at(webui_event_t* e, size_t index);
|
|
(define-webui webui_get_int_at (_fun _Webui_event_t-pointer _size_t -> _int64))
|
|
|
|
;WEBUI_EXPORT double webui_get_float_at(webui_event_t* e, size_t index);
|
|
(define-webui webui_get_float_at (_fun _Webui_event_t-pointer _size_t -> _double))
|
|
|
|
;WEBUI_EXPORT const char* webui_get_string_at(webui_event_t* e, size_t index);
|
|
(define-webui webui_get_string_at (_fun _Webui_event_t-pointer _size_t -> _string/utf-8))
|
|
|
|
;WEBUI_EXPORT void webui_set_file_handler(size_t window, const void* (*handler)(const char* filename, int* length));
|
|
(define-webui webui_set_file_handler
|
|
(_fun _size_t _Webui_FileHandler_Callback -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_set_file_handler_window(size_t window, const void* (*handler)(size_t window, const char* filename, int* length));
|
|
(define-webui webui_set_file_handler_window
|
|
(_fun _size_t _Webui_FileHandlerWin_Callback -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_interface_set_response_file_handler(size_t window, const void* response, int length);
|
|
(define-webui webui_interface_set_response_file_handler
|
|
(_fun _size_t _bytes _int -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_interface_set_response(size_t window, size_t event_number, const char* response);
|
|
(define-webui webui_interface_set_response
|
|
(_fun _size _size _string/utf-8 -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_set_config(webui_config option, bool status);
|
|
(define-webui webui_set_config
|
|
(_fun _webui_config_t _int -> _void))
|
|
|
|
;WEBUI_EXPORT void webui_set_logger(void (*func)(size_t level, const char* log, void* user_data), void *user_data);
|
|
(define-webui webui_set_logger
|
|
(_fun
|
|
(_fun #:keep callback-store #:async-apply enqueue-callback
|
|
_size_t _bytes/nul-terminated _pointer -> _void)
|
|
_pointer -> _void))
|
|
|
|
;WEBUI_EXPORT const char* webui_start_server(size_t window, const char* content);
|
|
(define-webui webui_start_server
|
|
(_fun _size_t _string/utf-8 -> _string/utf-8))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Configure
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(webui_set_config 'asynchronous-response 1)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Async Wait loop as co-routine
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define run-async-thread #f)
|
|
(define log-fh (open-output-file "test.log" #:exists 'replace))
|
|
|
|
(define (add-to-log)
|
|
(if (> (queue-length debug-log) 0)
|
|
(begin
|
|
(display (dequeue! debug-log) log-fh)
|
|
(add-to-log))
|
|
(flush-output log-fh)))
|
|
|
|
(define (logger)
|
|
(thread (λ ()
|
|
(letrec ((f (λ ()
|
|
(add-to-log)
|
|
(sleep 0.1)
|
|
(f))))
|
|
(f)
|
|
)))
|
|
)
|
|
|
|
(define log-thread (logger))
|
|
|
|
(define (finish-log)
|
|
(kill-thread log-thread)
|
|
(add-to-log)
|
|
(close-output-port log-fh))
|
|
|
|
|
|
(define (run-async-wait)
|
|
(when (or (eq? run-async-thread #f)
|
|
(not (thread-running? run-async-thread)))
|
|
(set! run-async-thread
|
|
(thread (λ ()
|
|
(letrec ((wait-loop
|
|
(λ ()
|
|
(let ((r (webui_wait_async))) ; Returns true if windows are open
|
|
(when (eq? r #t)
|
|
(sleep 0.1)
|
|
(wait-loop))))))
|
|
(wait-loop)))
|
|
#:pool #f
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (webui-new-window)
|
|
(let ((win (webui_new_window)))
|
|
;(webui_bind win "" queue-webui-event)
|
|
(webui_bind win "web_ui_wire_handle_event" handle-bind-event)
|
|
win))
|
|
|
|
(define (webui-show win html)
|
|
(webui_show win html)
|
|
(run-async-wait)
|
|
)
|
|
|
|
(define (webui-show-browser win html)
|
|
(webui_show_browser win html 1)
|
|
(run-async-wait)
|
|
)
|
|
|
|
(define (webui-show-wv win html)
|
|
(webui_show_wv win html)
|
|
(run-async-wait)
|
|
)
|
|
|
|
|
|
(define (webui-run win js)
|
|
(webui_run win js))
|
|
|
|
(define (webui-set-config option status)
|
|
(webui_set_config option status))
|
|
|
|
(define (webui-bind win selector event callback)
|
|
(let ((sel (if (symbol? selector)
|
|
(format "#~a" selector)
|
|
selector))
|
|
(evt (if (symbol? event)
|
|
(format "~a" event)
|
|
event))
|
|
)
|
|
(webui-run win
|
|
(string-append "window._web_wire_bind_evt_ids("
|
|
(format "~a" win)
|
|
", '"
|
|
sel
|
|
"', '"
|
|
evt
|
|
"');"
|
|
))
|
|
(let ((cbs (hash-ref bind-callbacks win (make-hash))))
|
|
(hash-set! cbs (string->symbol (format "sel-~a-~a" sel event)) callback)
|
|
(hash-set! bind-callbacks win cbs))
|
|
)
|
|
)
|
|
|
|
(define (webui-set-file-handler-window win callback)
|
|
(hash-set! file-handler-file-providers win callback)
|
|
(webui_set_file_handler_window win file-handler-callback))
|
|
|
|
(define (webui-register-move-callback win callback)
|
|
(let ((cbs (hash-ref bind-callbacks win (make-hash))))
|
|
(hash-set! cbs (string->symbol "sel-global-window-move") callback)
|
|
(hash-set! bind-callbacks win cbs))
|
|
)
|
|
|
|
(define (webui-register-resize-callback win callback)
|
|
(let ((cbs (hash-ref bind-callbacks win (make-hash))))
|
|
(hash-set! cbs (string->symbol "sel-global-window-resize") callback)
|
|
(hash-set! bind-callbacks win cbs))
|
|
)
|
|
|
|
(define (webui-register-onload-callback win callback)
|
|
(let ((cbs (hash-ref bind-callbacks win (make-hash))))
|
|
(hash-set! cbs (string->symbol "sel-global-html-loaded") callback)
|
|
(hash-set! bind-callbacks win cbs))
|
|
)
|
|
|
|
(define (webui-wait-async)
|
|
(webui_wait_async))
|
|
|
|
(define (webui-close win)
|
|
(webui_close win))
|
|
|
|
(define (webui-destroy win)
|
|
(webui_destroy win)
|
|
(hash-remove! bind-callbacks win)
|
|
)
|
|
|
|
(define (webui-start-server win url)
|
|
(webui_start_server win url))
|
|
|
|
(define (webui-exit)
|
|
(webui_exit))
|
|
|
|
(define (webui-set-root-folder win path)
|
|
(let ((p (if (path? path) (path->string path) path)))
|
|
(webui_set_root_folder win p)))
|
|
|
|
(define (timer)
|
|
(let ((ms (current-milliseconds)))
|
|
(λ displ
|
|
(let* ((dms (- (current-milliseconds) ms))
|
|
(s (exact->inexact (/ dms 1000))))
|
|
(when (null? displ)
|
|
(displayln (format "~a" s)))
|
|
s))))
|
|
|
|
;(webui_set_logger do-log #f)
|
|
|
|
(define win #f)
|
|
(define (test)
|
|
(let ((tm (timer)))
|
|
(set! timer-display tm)
|
|
(tm)
|
|
(set! win (webui-new-window))
|
|
(tm)
|
|
(webui-set-root-folder win "c:/devel/racket/racket-webui")
|
|
(tm)
|
|
(webui-set-file-handler-window win
|
|
(λ (req-file)
|
|
(let ((file
|
|
(format "c:/devel/racket/racket-webui~a" req-file)))
|
|
(displayln (format "file: ~a" file))
|
|
file)))
|
|
(tm)
|
|
(webui-register-onload-callback
|
|
win
|
|
(λ (win id data)
|
|
(webui-bind win "button" 'click
|
|
(λ (win id data)
|
|
(displayln (format "~a: ~a" id data)))
|
|
)
|
|
)
|
|
)
|
|
(tm)
|
|
(webui-register-move-callback win (λ (win id data)
|
|
(displayln data)))
|
|
(webui-register-resize-callback win (λ (win id data)
|
|
(displayln data)))
|
|
(tm)
|
|
;(displayln (webui-start-server win "test.html"))
|
|
(tm)
|
|
(webui-show-browser win "test.html")
|
|
;(webui-show-wv win "test.html")
|
|
(tm)
|
|
)
|
|
)
|
|
|
|
|
|
(define (test-close)
|
|
(webui-close win)
|
|
;(webui-destroy win) ;;; Hmm. Crashes in debug mode
|
|
)
|
|
|