196 lines
6.2 KiB
Racket
196 lines
6.2 KiB
Racket
#lang racket/base
|
|
|
|
(require "racket-webview-ffi.rkt"
|
|
"utils.rkt"
|
|
web-server/servlet
|
|
web-server/servlet-env
|
|
web-server/http
|
|
net/url
|
|
racket/runtime-path
|
|
racket/file
|
|
racket/string
|
|
racket/path
|
|
racket/port
|
|
json
|
|
)
|
|
|
|
(provide webview-create
|
|
webview-devtools
|
|
webview-has-events?
|
|
webview-event-count
|
|
webview-get-event
|
|
webview-set-event-callback!
|
|
webview-clear-event-callback!
|
|
webview-bind
|
|
webview-run-js
|
|
;webview-call-js
|
|
)
|
|
|
|
(define current-servlet-port 8083)
|
|
(define current-window-nr 1)
|
|
|
|
(define-runtime-path js-path "js")
|
|
|
|
(define (default-boilerplate-js)
|
|
(let ((file (build-path js-path "boilerplate.js")))
|
|
(file->string file)))
|
|
|
|
(define-struct wv
|
|
(handle port window-nr
|
|
[file-getter #:mutable]
|
|
[boilerplate-js #:mutable]
|
|
[webserver-thread #:mutable]))
|
|
|
|
(define (process-html wv-handle path out)
|
|
(let ((html (file->string path))
|
|
(boilerplate-js (wv-boilerplate-js wv-handle)))
|
|
(set! html (string-replace html "<head>"
|
|
(string-append "<head>" "\n"
|
|
"<script>" "\n"
|
|
boilerplate-js "\n"
|
|
"</script>" "\n")))
|
|
(display html out)))
|
|
|
|
(define (process-file wv-handle ext path out)
|
|
(let ((content (file->bytes path)))
|
|
(write bytes out)))
|
|
|
|
(define (web-serve wv-handle req)
|
|
(let* ((path (url->string (request-uri req)))
|
|
(file-getter (wv-file-getter wv-handle)))
|
|
(let* ((file-to-serve (build-path (file-getter path)))
|
|
(ext-bytes (path-get-extension file-to-serve))
|
|
(ext (if (eq? ext-bytes #f) #f
|
|
(string->symbol (string-downcase (substring (bytes->string/utf-8 ext-bytes) 1)))))
|
|
)
|
|
(if (file-exists? file-to-serve)
|
|
(response/output
|
|
(λ (out)
|
|
(if (or (eq? ext 'html) (eq? ext 'htm))
|
|
(process-html wv-handle file-to-serve out)
|
|
(process-file wv-handle ext file-to-serve out))
|
|
))
|
|
(response/output
|
|
#:code 404
|
|
(λ (out)
|
|
(displayln (format "~a not found" path) out)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (start-web-server h)
|
|
(thread (λ ()
|
|
(serve/servlet
|
|
(λ (req) (web-serve h req))
|
|
#:listen-ip "127.0.0.1"
|
|
#:port (wv-port h)
|
|
#:command-line? #t
|
|
#:servlet-path ""
|
|
#:stateless? #t
|
|
;#:launch-browser #f
|
|
#:servlet-regexp #rx""))))
|
|
|
|
(define (webview-create file-getter #:boilerplate-js [bj (default-boilerplate-js)])
|
|
(let* ((wv (rkt_create_webview))
|
|
(h (make-wv wv current-servlet-port current-window-nr file-getter bj #f))
|
|
(base-req (format "http://127.0.0.1:~a"
|
|
(wv-port h)))
|
|
)
|
|
(set-wv-webserver-thread! h (start-web-server h))
|
|
(rkt_webview_navigate (wv-handle h) base-req)
|
|
(set! current-servlet-port (+ current-servlet-port 1))
|
|
(set! current-window-nr (+ current-window-nr 1))
|
|
h))
|
|
|
|
(define (webview-devtools wv)
|
|
(rkt_webview_devtools (wv-handle wv)))
|
|
|
|
(define (webview-parse-event evt)
|
|
(let ((wv-d0 (with-input-from-string evt read-json)))
|
|
;(displayln wv-d0)
|
|
(let ((wv-d1 (with-input-from-string (hash-ref wv-d0 'data) read-json)))
|
|
;(displayln wv-d1)
|
|
(let ((wv-d2 (with-input-from-string (car wv-d1) read-json)))
|
|
;(displayln wv-d2)
|
|
wv-d2))))
|
|
|
|
(define (webview-set-event-callback! wv cb)
|
|
(rkt_webview_set_event_callback! (wv-handle wv) (wv-window-nr wv)
|
|
(λ (context data)
|
|
(let ((e (webview-parse-event data)))
|
|
(cb context e)))))
|
|
|
|
(define (webview-clear-event-callback! wv)
|
|
(rkt_webview_clear_event_callback! (wv-handle wv) (wv-window-nr wv)))
|
|
|
|
|
|
(define (webview-get-event wv)
|
|
(if (> (rkt_webview_pending_events (wv-handle wv)) 0)
|
|
(let ((item (rkt_webview_get_event (wv-handle wv))))
|
|
(let ((data (rkt_webview_item_data item)))
|
|
(rkt_webview_destroy_item item)
|
|
(let ((wv-d0 (with-input-from-string data read-json)))
|
|
;(displayln wv-d0)
|
|
(let ((wv-d1 (with-input-from-string (hash-ref wv-d0 'data) read-json)))
|
|
;(displayln wv-d1)
|
|
(let ((wv-d2 (with-input-from-string (car wv-d1) read-json)))
|
|
;(displayln wv-d2)
|
|
wv-d2
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f)
|
|
)
|
|
|
|
(define (webview-has-events? wv)
|
|
(>= (rkt_webview_pending_events (wv-handle wv)) 1)
|
|
)
|
|
|
|
(define (webview-event-count wv)
|
|
(rkt_webview_pending_events (wv-handle wv)))
|
|
|
|
(define (webview-bind wv selector event)
|
|
(let ((sel (if (symbol? selector)
|
|
(format "#~a" selector)
|
|
selector))
|
|
(evt (format "~a" event)))
|
|
(rkt_webview_run_js (wv-handle wv)
|
|
(format "window._web_wire_bind_evt_ids(~a, '~a', '~a')"
|
|
(wv-window-nr wv) sel evt))))
|
|
|
|
(define (webview-run-js wv js)
|
|
(rkt_webview_run_js (wv-handle wv) js))
|
|
|
|
;(define (webview-call-js wv js)
|
|
; (let ((result (rkt_webview_call_js (wv-handle wv) js)))
|
|
; result))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; testing
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-runtime-path example-path "example")
|
|
|
|
(define (file-getter file)
|
|
(displayln (format "file-getter: ~a" file))
|
|
(let ((f (if (string=? file "/") "index.html" file)))
|
|
(when (string-prefix? f "/")
|
|
(set! f (substring f 1)))
|
|
(let ((p (build-path example-path f)))
|
|
(displayln p)
|
|
p)))
|
|
|
|
(define (test)
|
|
(let ((h (webview-create file-getter)))
|
|
(displayln (webview-has-events? h))
|
|
|
|
(while (not (webview-has-events? h))
|
|
(displayln "Waiting...")
|
|
(sleep 1))
|
|
(let ((evt (webview-get-event h)))
|
|
(when (string=? (hash-ref evt 'evt) "html-loaded")
|
|
(webview-bind h "button" "click")))
|
|
h)) |