#lang racket/base

(require ffi/unsafe
         ffi/unsafe/define
         ffi/unsafe/atomic
         ffi/unsafe/os-thread
         racket/async-channel
         racket/runtime-path
         racket/port
         data/queue
         json
         racket/string
         racket/path
         )

(provide rkt-wv
         rkt-wv-win
         
         rkt-webview-create
         rkt-webview-close
         rkt-webview-set-url!
         rkt-webview-set-html!
         rkt-webview-run-js
         rkt-webview-move
         rkt-webview-resize
         rkt-webview-exit
         rkt-webview-valid?
         rkt-webview-open-devtools
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FFI Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define lib-type 'release)

(define-runtime-path lib-dir "../lib")

(define libname (let ((os (system-type 'os*)))
                  (cond ((eq? os 'windows) (format "rktwebview.dll"))
                        ((eq? os 'linux) (format "librktwebview.so"))
                        (else (error (format "OS ~a not supported" os)))))
  )
;(set! libname "../rktwebview/build/Release/rktwebview.dll")
;(set! libname "../rktwebview/build/Release/librktwebview.so")
(set! libname "../rktwebview_qt/build/Release/librktwebview_qt.so")
(define webview-lib-file (build-path lib-dir libname))

(define webview-lib (ffi-lib webview-lib-file))
(define-ffi-definer define-rktwebview webview-lib)

(define callback-box (box '()))
(define (applier thunk)
  (thunk))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Types / Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-cstruct _rkt_evt_t
  ([w _int]
   [evt _pointer]
   ))

;RKTWEBVIEW_QT_EXPORT void rkt_webview_init(int &argc, char **argv);
(define-rktwebview rkt_webview_init
  (_fun -> _void))

;RKTWEBVIEW_QT_EXPORT void rkt_webview_process_events(int for_ms);
(define-rktwebview rkt_webview_process_events
  (_fun _int -> _void))

;RKTWEBVIEW_QT_EXPORT int rkt_webview_create(int parent);
(define-rktwebview rkt_webview_create
  (_fun _int (_fun #:keep callback-box #:async-apply applier
                   _rkt_evt_t-pointer -> _void) -> _int))

;RKTWEBVIEW_QT_EXPORT void rkt_webview_close(int wv);
(define-rktwebview rkt_webview_close
  (_fun _int -> _void))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_url(int wv, const char *url);
(define-rktwebview rkt_webview_set_url
  (_fun _int _string/utf-8 -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_set_html(int wv, const char *html);
(define-rktwebview rkt_webview_set_html
  (_fun _int _string/utf-8 -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_run_js(int wv, const char *js);
(define-rktwebview rkt_webview_run_js
  (_fun _int _string/utf-8 -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_open_devtools(int wv);
(define-rktwebview rkt_webview_open_devtools
  (_fun _int -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_destroy_event(rkt_event_t e);
(define-rktwebview rkt_webview_destroy_event
  (_fun _rkt_evt_t-pointer -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_move(rktwebview_t w, int x, int y);
(define-rktwebview rkt_webview_move
  (_fun _int _int _int -> _int))

;RKTWEBVIEW_QT_EXPORT result_t rkt_webview_resize(rktwebview_t w, int width, int height);
(define-rktwebview rkt_webview_resize
  (_fun _int _int _int -> _int))

;RKTWEBVIEW_QT_EXPORT bool rkt_webview_valid(rktwebview_t wv);
(define-rktwebview rkt_webview_valid
  (_fun _int -> _int))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialize and start library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define process-events #t)

(define (stop-event-processing)
  (set! process-events #f))

(define (start-event-processing)
  (thread (λ ()
            (letrec ((f (λ ()
                          (rkt_webview_process_events 1)
                          (sleep 0.001)
                          (if process-events
                              (f)
                              (begin
                                (displayln "Stopping event processing")
                                'done)))))
              (f)))))

(rkt_webview_init)
(start-event-processing)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided features
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct rkt-wv
  (win evt-queue callback [valid #:mutable])
  #:transparent
  )

(define rkt-wv-store (make-hash))

(define (rkt-process-events handle)
  (if (> (queue-length (rkt-wv-evt-queue handle)) 0)
      (let ((e (dequeue! (rkt-wv-evt-queue handle))))
        (if (symbol? e)
            (if (eq? e 'quit)
                (begin
                  (hash-remove! rkt-wv-store (rkt-wv-win handle))
                  'quit)
                (rkt-process-events handle))
            (let ((evt (cast (rkt_evt_t-evt e) _pointer _string*/utf-8)))
              ((rkt-wv-callback handle) handle evt)
              (rkt_webview_destroy_event e)
              (rkt-process-events handle)))
        )
      'done))

(define (rkt-webview-create parent evt-callback)
  (let ((evt-queue (make-queue)))
    (let ((wv (rkt_webview_create parent
                                  (λ (rkt-evt)
                                    (enqueue! evt-queue rkt-evt)))))
      (let ((handle (make-rkt-wv wv evt-queue evt-callback #t)))
        (thread (λ ()
                  (sleep 1)
                  (letrec ((f (λ ()
                              (let ((r (rkt-process-events handle)))
                                (if (eq? r 'quit)
                                    (begin
                                      (set-rkt-wv-valid! handle #f)
                                      (displayln "Quitting event loop")
                                      'done)
                                    (begin
                                      ;(displayln "Waiting for events.")
                                      (sleep 0.01)
                                      (f)))))))
                    (f))))
        (hash-set! rkt-wv-store (rkt-wv-win handle) handle)
        handle))))

(define (rkt-webview-close handle)
  (rkt_webview_close (rkt-wv-win handle))
  (enqueue! (rkt-wv-evt-queue handle) 'quit)
  #t)

(define (rkt-webview-set-url! wv url)
  (rkt_webview_set_url (rkt-wv-win wv) url))

(define (rkt-webview-set-html! wv html)
  (rkt_webview_set_html (rkt-wv-win wv) html))

(define (rkt-webview-run-js wv js)
  (rkt_webview_run_js (rkt-wv-win wv) js))

(define (rkt-webview-resize wv w h)
  (rkt_webview_resize (rkt-wv-win wv) w h))

(define (rkt-webview-move wv x y)
  (rkt_webview_move (rkt-wv-win wv) x y))

(define (rkt-webview-open-devtools wv)
  (rkt_webview_open_devtools (rkt-wv-win wv)))

(define (rkt-webview-valid? wv)
  (if (eq? (rkt-wv-valid wv) #f)
      #f
      (if (= (rkt_webview_valid wv) 0)
          #f
          #t)))

(define (rkt-webview-exit)
  (let ((open-windows (hash->list rkt-wv-store)))
    (for-each (λ (kv)
                (let ((win (car kv))
                      (handle (cdr kv)))
                  (rkt-webview-close handle)))
              open-windows))
  (stop-event-processing))