#lang racket/base

(require "racket-webview.rkt"
         racket/class
         simple-ini/class
         "wv-element.rkt"
         "wv-input.rkt"
         "wv-settings.rkt"
         "rgba.rkt"
         net/url
         net/sendurl
         racket/string
         )

(provide wv-window%
         (all-from-out "wv-element.rkt")
         (all-from-out "wv-input.rkt")
         (all-from-out "rgba.rkt")
         (all-from-out "wv-settings.rkt")
         webview-version
         root-file-not-found-handler
         )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Administration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define default-x (let ((dx 100))
                    (λ ()
                      (set! dx (+ dx 25))
                      dx)))
(define default-y (let ((dy 100))
                    (λ ()
                      (set! dy (+ dy 25))
                      dy)))
                      
(define default-w (λ () 800))
(define default-h (λ () 600))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Classes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define wv-window%
  (class object%

    (init-field [parent #f]
                [wv-context (if (eq? parent #f)
                                (error "wv context is mandatory")
                                (get-field wv-context parent))]
                [html-path   (error "html path is mandatory")]
                [settings    (send wv-context settings (string->symbol (format "~a" html-path)))]
                [title "Racket Webview Window"]
                [width #f]
                [height #f]
                [x #f]
                [y #f]
                )

    (define wv #f)

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Administration
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define/public (context)
      wv-context)

    (define/public (win-context)
      (string->symbol (format "~a" html-path)))

    (define element-hash (make-weak-hash))

    (define/public (info)
      (let ((h (make-hash)))
        (hash-set! h 'wv-context (context))
        (hash-set! h 'wv wv)
        (hash-set! h 'html-path html-path)
        (hash-set! h 'elements element-hash)
        h))

    (define/public (element id . type*)
      (let ((elem (hash-ref element-hash id #f))
            (type (if (null? type*) #f (car type*))))
        (when (eq? elem #f)
          (when (eq? type #f)
            (let ((js-type (webview-call-js wv
                                            (format
                                             (string-append
                                              "{ let el = document.getElementById('~a');\n"
                                              "  let a = el.getAttribute('type');\n"
                                              "  if (a === null) {\n"
                                              "    return false;\n"
                                              "  } else {\n"
                                              "    return a;\n"
                                              "  }\n"
                                              "}")
                                             id))))
              (set! type (if (eq? js-type #f)
                             #f
                             (string->symbol (string-downcase js-type))))
              )
            )
          (let ((cl (cond
                      ((eq? type 'text) wv-input/text%)
                      ((eq? type 'date) wv-input/date%)
                      ((eq? type 'time) wv-input/time%)
                      ((eq? type 'datetime-local) wv-input/datetime%)
                      ((eq? type 'range) wv-input/range%)
                      ((eq? type 'number) wv-input/number%)
                      ((eq? type 'checkbox) wv-input/check%)
                      ((eq? type 'radio) wv-input/radio%)
                      ((eq? type 'color) wv-input/color%)
                      (else wv-element%)
                      )))
            (set! elem (new cl [window this] [element-id id]))
            (hash-set! element-hash id elem))
          )
        elem
        )
      )
        
    (define (connect! id type event callback)
      (let ((elem (element id type)))
        (send elem add-event-callback! event callback)
        )
      )

    (define (disconnect! id event)
      (let ((elem (hash-ref element-hash id #f)))
        (unless (eq? elem #f)
          (send elem remove-event-callback! event)
          (when (= (send elem event-callback-count) 0)
            (hash-remove! element-hash id))
          )
        )
      )

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Events
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define (event-handler wv evt)
      (let ((event (hash-ref evt 'event 'unknown-event))
            )
        (displayln evt)
        (cond
        ((eq? event 'resize)
         (send this resized (hash-ref evt 'w) (hash-ref evt 'h)))
        ((eq? event 'move)
         (send this moved (hash-ref evt 'x) (hash-ref evt 'y)))
        ((eq? event 'page-loaded)
         (send this page-loaded (hash-ref evt 'oke)))
        ((or (eq? event 'show) (eq? event 'hide) (eq? event 'maximize))
         (send this window-state-changed (webview-window-state wv)))
        ((eq? event 'can-close?)
         (when (send this can-close?)
           (send this close)))
        ((eq? event 'closed)
         (send this closed))
        ((eq? event 'js-evt)
         (let* ((je (hash-copy (hash-ref evt 'js-evt)))
                (e (make-hash)))
           (hash-set! e 'evt (string->symbol (hash-ref je 'evt)))
           (hash-set! e 'id (string->symbol (hash-ref je 'id "nil")))
           (hash-set! e 'data (hash-ref je 'js_evt (make-hash)))
           (hash-set! e 'event 'js-evt)
           (when (eq? (send this js-event e) 'wv-unhandled-js-event)
             (displayln (format "Unhandled javascript event: ~a" e)))
           ))
        ((eq? event 'navigation-request)
         (let ((type (string->symbol (hash-ref evt 'type)))
               (url (string->url (hash-ref evt 'url))))
           (send this navigation-request type url)))
        ((or (eq? event 'file-save-ok)
             (eq? event 'file-open-ok)
             (eq? event 'choose-dir-ok))
         (let ((file (hash-ref evt 'choosen))
               (dir (hash-ref evt 'dir))
               (filter (webview-filter->exts (hash-ref evt 'filter))))
           (send this file-dialog-done 'ok file dir filter)))
        ((or (eq? event 'file-save-cancel)
             (eq? event 'file-open-cancel)
             (eq? event 'choose-dir-cancel))
         (send this file-dialog-done 'canceled #f #f #f))
        ((or (eq? event 'msgbox-ok)
             (eq? event 'msgbox-cancel)
             (eq? event 'msgbox-yes)
             (eq? event 'msgbox-no))
         (send this message-done event))
        (else
         (displayln (format "Unhandled event: ~a (~a)" event evt)))
        ))
      )
         
    (define/public (moved xx yy)
      (set! x xx)
      (set! y yy)
      (send settings set! 'x x)
      (send settings set! 'y y)
      )

    (define/public (resized w h)
      (set! width w)
      (set! height h)
      (send settings set! 'width w)
      (send settings set! 'height h)
      )

    (define/public (window-state-changed st)
      #t
      )

    (define/public (page-loaded oke)
      #t)

    (define/public (can-close?)
      #t)

    (define/public (closed)
      #t)

    (define/public (js-event js-event)
      (let* ((evt (hash-ref js-event 'evt))
             (id (hash-ref js-event 'id))
             (el (hash-ref element-hash id #f))
             )
        (if (eq? el #f)
          'wv-unhandled-js-event
          (send el dispatch-event evt (hash-ref js-event 'data (make-hash))))
        )
      )

    (define/public (navigation-request type url)
      (let ((u (url->string url)))
        (if (string-prefix? u (send wv-context base-url))
            (begin
              (webview-set-url! wv url)
              'internal)
            (begin
              (send-url u)
              'external)
            )
        )
      )

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Commands
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define/public (add-class! selector-or-id cl)
      (webview-add-class! wv selector-or-id cl)
      this)

    (define/public (remove-class! selector-or-id cl)
      (webview-remove-class! wv selector-or-id cl)
      this)

    (define/public (set-menu! menu)
      (webview-set-menu! wv menu)
      this)

    (define/public (connect-menu! id callback)
      (send this bind! (string->symbol (format "~a" id)) 'menu-item-choosen
            (λ (el evt data)
              (callback))))
    
    (define/public (devtools)
      (webview-devtools wv)
      this)
    
    (define/public (move x y)
      (webview-move wv x y)
      this)

    (define/public (resize w h)
      (webview-resize wv w h)
      this)

    (define/public (close)
      (webview-close wv)
      this)

    (define/public (bind! selector events callback)
      (let ((items (webview-bind! wv selector events))
            (events* (if (symbol? events) (list events) events)))
        (map (λ (item)
                    (let ((id (car item))
                          (type (string->symbol (string-downcase (caddr item))))
                          )
                      (for-each (λ (evt)
                                  (connect! id type evt callback))
                                events*)
                      (hash-ref element-hash id)
                      ))
                  items)
        )
      )

    (define/public (unbind! selector events)
      (let ((items (webview-unbind! wv selector events))
            (events* (if (symbol? events) (list events) events))
            )
        (for-each (λ (item)
                    (let ((id (car item)))
                      (for-each (λ (evt)
                                  (send this disconnect! id evt))
                                events*)
                      ))
                  items)
        items
        )
      )

    (define/public (set-title! title)
      (webview-set-title! wv title))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Files / Directories
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define __file_dialog_cc__ #f)

    (define/public (file-dialog-done flag file dir filter)
      (__file_dialog_cc__ (list flag file dir filter))
      )

    (define/public (choose-dir title base-dir)
      (unless (eq? __file_dialog_cc__ #f)
        (error "Cannot display more than one file/directory dialog"))
      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
             (r (webview-choose-dir wv title bd)))
        (if (eq? r 'oke)
            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
              (if (void? r)
                  'showing
                  (begin
                    (set! __file_dialog_cc__ #f)
                    (if (eq? (car r ) 'ok)
                        (cadr r)
                        #f))))
            #f)
        )
      )

    (define/public (file-open title base-dir filters)
      (unless (eq? __file_dialog_cc__ #f)
        (error "Cannot display more than one file/directory dialog"))
      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
             (r (webview-file-open wv title bd filters)))
        (if (eq? r 'oke)
            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
              (if (void? r)
                  'showing
                  (begin
                    (set! __file_dialog_cc__ #f)
                    (if (eq? (car r) 'ok)
                        (cdr r)
                        #f))
                  )
              )
            #f)
        )
      )

    (define/public (file-save title base-dir filters)
      (unless (eq? __file_dialog_cc__ #f)
        (error "Cannot display more than one file/directory dialog"))
      (let* ((bd (if (eq? base-dir #f) (find-system-path 'home-dir) base-dir))
             (r (webview-file-save wv title bd filters)))
        (if (eq? r 'oke)
            (let ((r (call/cc (λ (c) (set! __file_dialog_cc__ c)))))
              (if (void? r)
                  'showing
                  (begin
                    (set! __file_dialog_cc__ #f)
                    (if (eq? (car r) 'ok)
                        (cdr r)
                        #f))
                  )
              )
            #f)
        )
      )
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Messagebox
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define __msg_box_cc__ #f)

    (define/public (message-done evt)
      (__msg_box_cc__ evt)
      )

    (define/public (message type title message #:sub [submessage ""])
      (unless (eq? __msg_box_cc__ #f)
        (error "Cannot display more than one message box"))
      (let ((r (webview-messagebox wv type title message #:sub submessage)))
        (if (eq? r 'oke)
            (let ((r (call/cc (λ (c) (set! __msg_box_cc__ c)))))
              (if (void? r)
                  'showing
                  (begin
                    (set! __msg_box_cc__ #f)
                    r)))
            #f)
        )
      )
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Construction
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (define/public (init-size)
      (let ((x* (send settings get 'x (if (eq? x #f) (default-x) x)))
            (y* (send settings get 'y (if (eq? y #f) (default-y) y)))
            (w* (send settings get 'width (if (eq? width #f) (default-w) width)))
            (h* (send settings get 'height (if (eq? height #f) (default-h) height)))
            )
        (send this move x* y*)
        (send this resize w* h*)
        )
      )

    (super-new)
    
    (begin
      ;; Create window
      (write (list wv-context html-path event-handler parent))
      (newline)
      (let ((wv-parent (if (eq? parent #f) #f (hash-ref (send parent info) 'wv))))
        (set! wv (webview-create
                  (send wv-context context)
                  html-path
                  event-handler
                  #:parent wv-parent)))

      ;; Set title
      (send this set-title! title)
      
      ;; Move and resize window to settings
      (send this init-size)
      )
    )
  )



(define (root-file-not-found-handler standard-file . not-found-handler)
  (letrec ((handler 
            (λ (file base-path path)
              (if (string=? file "/")
                  (handler standard-file base-path (build-path base-path standard-file))
                  (if (string=? file "/index.html")
                      (if (file-exists? path)
                          path
                          (handler standard-file base-path (build-path base-path standard-file)))
                      (if (file-exists? path)
                          path
                          (if (null? not-found-handler)
                              path
                              ((car not-found-handler) file base-path path)
                              )
                          )
                      )
                  )
              )
            ))
    handler)
  )