(import (scheme base)
        (chicken port)
        (chicken irregex)
        (chicken time posix)
        srfi-123
        srfi-69
        srfi-48
        srfi-18
        intarweb
        spiffy
        awful
        (awful sse)
        sxml-transforms)

;; Game
(define games (make-hash-table))

(define (init-game-table)
  (let ((game (make-hash-table)))
    game))

;; Webserver stuff
 (define (add-sse-resource! sse-path sse-proc vhost-root-path client-path)
   (add-resource! sse-path
		              (or vhost-root-path (root-path))
		              (lambda (#!optional given-path)
		                (let ((accept (header-values 'accept
						                                     (request-headers (current-request)))))
		                  ;; If client's EventSource (JS code) requested SSE page...
		                  (if (memq 'text/event-stream accept)
			                    ;;...complete handshake & keep connection alive with 'sse-proc'.
                          (lambda ()
			                      (with-headers '((content-type text/event-stream)
					                                  (cache-control no-cache)
					                                  (connection keep-alive))
					                                (lambda ()
					                                  (write-logged-response)
					                                  (sse-proc))))
			                    (redirect-to client-path))))
		              'GET
		              #f))

(define (pagescript sse-path color)
  #<#EOF
  eventsource ssevent from #{sse-path}

    on unlockMessage as string
      if it is "#{color}"
        set #board.data-locked to 'false'
      end
    end

  end
EOF
  )

(define (render-sxml sxml)
  (with-output-to-string
    (lambda ()
      (SXML->HTML sxml))))

(define (board sse-path color)
  (let ()
      `(div (@ (id "content")
               (class "row"))
            (div (@ (id "leftbank")
                    (class "col-2 m-0")))
            (div (@ (id "board")
                    (data-locked ,(if (eqv? color "white") "true" "false"))
                    (class "col-8 m-0 p-0")))
            (div (@ (id "rightbank")
                    (class "col-2 m-0"))))))

(define (game-proc code)
  (print "Returning sse-proc")
  (lambda ()
    (let loop ()
      (send-sse-data (render-positions)
       id: (seconds->string) event: "boardChange")
      (thread-sleep! 2)
      (loop))))

(define (init-game code)
  (let ((game (or (and (hash-table-exists? games code)
                       (~ games code))
                  #f))
        (sse-path (string-append "/sse-" code))
        (sse-proc (game-proc code)))
    (print "Game:" game)
    (if game
        (board sse-path "white")
        (let ((game (init-game-table)))
          (print "Initialized game to " game ", adding SSE resource.")
          (set! (~ game 'sse-proc) (add-sse-resource! sse-path sse-proc #f sse-path))
          (set! (~ game 'code) code)
          (set! (~ games code) game)
          (board sse-path "yellow")))))

(define-page "/start-game"
  (lambda ()
    (let ((gamecode ($ 'gamecode as-string)))
      (init-game gamecode))))

(define-page "/"
  (lambda ()
    (lambda ()
      (send-static-file "resources/html/coinage.html")))
  no-template: #t)

(define-page "/css/coinage.css"
  (lambda ()
    (lambda ()
      (send-static-file "resources/css/coinage.css"))))

(define-page (irregex "/images/.*")
  (lambda (file)
    (print "Trying to fetch file " file "...")
    (lambda ()
      (print "Fetching " file "...")
      (send-static-file (string-append "resources" file)))))