(in-package :fwoar.lisp-sandbox.canvas-server)

(defvar *ws-servers* (make-array 10 :fill-pointer 0 :adjustable t))
(defvar *stopped* ())

(defun send-update (color pos)
  (wsd:send
   (elt *ws-servers* (1- (length *ws-servers*)))
   (with-output-to-string (s)
     (yason:encode (list color
                         pos)
                   s))))

(defparameter *app*
  (lambda (env)
    (cond ((string= "/ws" (getf env :request-uri))
           (let* ((ws (wsd:make-server env))
                  (idx (if *stopped*
                           (setf (aref *ws-servers*
                                       (pop *stopped*))
                                 ws)
                           (vector-push-extend ws *ws-servers*))))
             idx
             (lambda (responder)
               responder
               (wsd:start-connection ws))))
          (t
           (format *trace-output* "~&~s~%" env)
           (list 200 '(:content-type "text/html")
                 (list
                  (spinneret:with-html-string
                    (:html
                     (:body
                      (:canvas#out :width 2000 :height 2000)
                      (:script
                       (ps:ps
                         (let* ((canvas (ps:chain document
                                                  (query-selector "canvas#out")))
                                (context (ps:chain canvas
                                                   (get-context "2d")))
                                (i-d (ps:chain context
                                               (create-image-data 1 1)))
                                (ws (ps:new (-web-socket (+ "ws://"
                                                            (ps:@ location host)
                                                            "/ws")))))
                           (ps:chain ws
                                     (add-event-listener
                                      "message"
                                      (lambda (evt)
                                        (let ((data (ps:@ i-d data)))
                                          (destructuring-bind ((r g b)
                                                               (x y))
                                              (ps:chain -j-s-o-n
                                                        (parse (ps:@ evt data)))
                                            (setf (aref data 0) r
                                                  (aref data 1) g
                                                  (aref data 2) b
                                                  (aref data 3) 255)
                                            (ps:chain context
                                                      (put-image-data
                                                       i-d x y))
                                            (values))))))))))))))
           #+qwer
           (lambda )))))
(defun setup ()
  (lambda (env)
    (funcall *app* env)))