(module canvas-module
  (import globals)
  (import rooms-module)
  (export
   load-canvas))



(define (load-canvas)
  ~(begin
     (define activecolor "#FF0000")
     (define shapes '())
     (define drawwidth 10)
     (define bordercolor "#000000")
     (define borderwidth 10)
     (define selectedshape '())
     (define movableshape '())
     (define disableclick #f)
     (define selectedmode "draw")
     (define resizableid '())
     (define selectedid '())
     (define xycord '())

     (define canvas-width 600)
     (define canvas-height 400)
     ;This represents the objects that can be drawn onto the canvas on the clientside.
     (define (makeshape lid ltype lx ly lw lh lcolor lbw lbc)
       (lambda (message)
         (case message
           ((id) lid)
           ((type) ltype )
           ((x) lx)
           ((y)  ly)
           ((w)  lw)
           ((h) lh)
           ((color)lcolor)
           ((bw)  lbw)
           ((bc)  lbc)
           ((set-x!)
            (lambda (new-value)
              (set! lx new-value)  ;; do the assignment
              lx))                ;; return the new value
           ((set-y!)
            (lambda (new-value)
              (set! ly new-value)  ;; do the assignment
              ly))
           ((set-w!)
            (lambda (new-value)
              (set! lw new-value)
              lw))
           ((set-h!)
            (lambda (new-value)
              (set! lh new-value)
              lh))
           ((set-color!)
            (lambda (new-value)
              (set! lcolor new-value)
              lcolor))
           ((set-bw!)
            (lambda (new-value)
              (set! lbw new-value)
              lbw))
           ((set-bc!)
            (lambda (new-value)
              (set! lbc new-value)
              lbc))
           (else (error "Shape: Unknown message ->" message)))))




     ;***********************DRAWING FUNCTIONS************************

     (define (draw-ellipse ctx x y width height)
       (if (< width height)
           (begin
             (canvas-scale ctx 1 2)
             (canvas-arc ctx x  (/ y 2) width 0 (* Math.PI 2) 1))
           (begin
             (canvas-scale ctx 2 1)
             (canvas-arc ctx (/ x 2) y width 0 (* Math.PI 2) 1))))

     (define (iter-line-to p ctx)
       (if (not (null? p))
           (let ((np (car p)))
             (canvas-line-to ctx (car np) (cdr np))
             (iter-line-to (cdr p) ctx)))
       )

     ;Makes the path of the line
     (define (make-path-line ctx x y width path)
       (canvas-begin-path ctx)
       (canvas-close-path ctx)
       (if (null? (cdr path))
           (begin
             (iter-line-to path ctx)
             (canvas-line-to ctx x y))

           (iter-line-to path ctx))
       )

     ;Makes the path a a polynome
     (define (make-path-poly ctx x y width path)

       (canvas-begin-path ctx)
       (iter-line-to  path ctx)
       (canvas-close-path ctx)
       )

     ;Makes the path of the ellipse
     (define (make-path-ellipse ctx x y height width)
       (canvas-save ctx)
       (canvas-begin-path ctx)
       (draw-ellipse ctx x y width height)
       (canvas-close-path ctx)
       (canvas-restore ctx))

     ;Makes the path of the rectangle
     (define (make-path-rectangle ctx x y width height)
       (canvas-begin-path ctx)
       (ctx.rect x y width height)
       (canvas-close-path ctx))

     ;If we have build the path we will fill in the canvas and stroke it to draw
     (define (drawshape ctx)
       (canvas-stroke ctx)
       (canvas-fill ctx))


     ;****************SET settings at runtime*************************
     (define (initialise-settings)
       ( canvas-properties-set! (canvas-get-context (dom-get-element-by-id "activecanvas") "2d")
                                :stroke-style drawwidth
                                :fill-style activecolor
                                :line-width borderwidth;
                                :font "20pt Arial"))


     ;Will return the shape object with the corresponding id
     (define (getshape id)
       (define (iter shapes)
         (if (eq? '() shapes)
             '()
             (let ((shape (car shapes)))
               (if (eq? (shape 'id) id)
                   shape
                   (iter (cdr shapes))))))
       (iter shapes))

     ;Will remover the shape object with the corresponding id
     (define (deleteshape id)
       (define (iter shapes)
         (if (eq? '() shapes)
             '()
             (let ((shape (car shapes)))
               (if (eq? (shape 'id) id)
                   (cdr shapes)
                   (cons shape (iter (cdr shapes)))))))
       (set! shapes (iter shapes)))


     ;activates a shape based on its id
     (define (select-shape x y)
       (define (iter shapes)
         (if (equal? shapes '())
             (begin (set! disableclick #f)'())
             (let ((shape (car shapes))
                   (ctx (canvas-get-context (dom-get-element-by-id "activecanvas") "2d")))
               (case (shape 'type)
                 (("ellipse")
                  (make-path-ellipse ctx (shape 'x) (shape 'y) (shape 'w) (shape 'h)))
                 (("line")
                  (make-path-line ctx (shape 'x) (shape 'y) (shape 'w) (shape 'h)))
                 (("poly")
                  (make-path-poly ctx (shape 'x) (shape 'y) (shape 'w) (shape 'h)))
                 (("rectangle")
                  (make-path-rectangle ctx (shape 'x) (shape 'y) (shape 'w) (shape 'h)))
                 (else (cons shape(iter (cdr shapes)))))
               (if (ctx.isPointInPath x y)
                   (begin
                     (set! disableclick #t)
                     (set! selectedshape shape)
                     (cdr shapes))
                   (cons shape (iter (cdr shapes)))
                   ))
             ))
       (if (null? selectedshape)
           (set! shapes (iter shapes))
           ;If there is a shape selected we need to check if we do not reselect it otherwise it has to join the other shapes.
           (begin
             (let ((temp selectedshape))
               (set! selectedshape '())
               (iter (list temp))
               (if (null? selectedshape)
                   (set! shapes (cons temp (iter shapes)))

                   )))
           ))



     ;Clears the canvas (statical size)
     (define (canvas-clear)  (canvas-clear-rect (canvas-get-context (dom-get-element-by-id "activecanvas") "2d")  0 0 canvas-width canvas-height))


     ;This will redraw the entire canvas
     (define (redraw)
       (canvas-clear)
       (draw  shapes)
       (if (not (null? selectedshape))
           (begin
             (convertcommand selectedshape 1))))

     ;This will draw shape by shape
     (define (draw localshapes)
       (if (equal? '() localshapes)
           #t
           (let ((shape (car localshapes)))
             (convertcommand shape 0)
             (draw (cdr localshapes))
             )))

     ;This will convert the list from the server to shape objects we draw locally
     (define (convertservershapes lst)
       (define (iter loclst)
         (if (eq? '() loclst)
             '()
             (begin
               (cons (converttoshape (car loclst)) (iter(cdr loclst))))))
       (iter lst))

     ;Replace an existing shape with the new one (same id)
     (define (set-new replaceshape)
       (define (iter lshapes)
         (if (eq? lshapes '())
             '()
             (let ((shape (car lshapes)))
               (if (eq? (replaceshape 'id)(shape 'id))
                   (cons replaceshape (cdr lshapes))
                   (cons shape (iter (cdr lshapes)))))))
       (set! shapes (iter shapes))
       )



     ; We update a shape with new values from a list
     (define (change lst)
       (if (and selectedshape (eq? (selectedshape 'id) (car lst)))
           (begin
             (set! selectedshape (converttoshape lst))
             )
           (set-new (converttoshape lst))
           )
       (redraw))


     ;Make an object shape from a list given from the server
     (define (converttoshape lst)
       (apply makeshape lst)
       )

     ;we convert a command (a shape) and draw it on the canvas
     (define (convertcommand command selected)
       (let* ((ctx (canvas-get-context (dom-get-element-by-id "activecanvas") "2d") )
              (bw (command 'bw))
              (bc (command 'bc))
              (color (command 'color))
              (todraw (list (command 'x)(command 'y)(command 'w)(command 'h)))
              )
         (if (eq? 1 selected )
             (canvas-properties-set! ctx
                                     :stroke-style "yellow"
                                     :fill-style color
                                     :line-width bw)
             (canvas-properties-set! ctx
                                     :stroke-style bc
                                     :fill-style color
                                     :line-width bw))
         (if (equal? "rectangle" (command 'type))(begin (apply make-path-rectangle (cons ctx todraw))(drawshape ctx)))
         (if (equal? "ellipse" (command 'type)) (begin (apply make-path-ellipse (cons ctx todraw)) (drawshape ctx)))
         (if (equal? "poly" (command 'type)) (begin (apply make-path-poly (cons ctx todraw)) (drawshape ctx)))
         (if (equal? "line" (command 'type)) (begin
                                               (canvas-properties-set! ctx
                                                                       :stroke-style color
                                                                       :fill-style color
                                                                       :line-width bw)
                                               (apply make-path-line (cons ctx todraw)) (canvas-stroke ctx)))
         ))






     ;We update the coordinates of a complete path (for moving polynomes and lines
     (define (update-coords path x y)
       (define (iter p x y)
         (if (null? p)
             '()
             (let* ((cord (car p))
                    (inbetween (cons (+ (car cord) x) (+ (cdr cord) y))))
               (cons inbetween (update-coords (cdr p) x y)))))
       (iter path x y))

     ;This function will update the selected shape when required.
     (define (updateselected c bw bc)
       (with-hop ($change room
                          (list (selectedshape 'id)
                                (selectedshape 'type)
                                (selectedshape 'x)
                                (selectedshape 'y)
                                (selectedshape 'w)
                                (selectedshape 'h)
                                c
                                bw
                                bc)
                          )))





     (define (joinroom joinedroom)
       (set! room joinedroom)
       (let ((activecanvas (<CANVAS> :id "activecanvas"
                                     :width canvas-width;
                                     :height canvas-height;
                                     :style "border: 1px solid black"))
             (colorpicker1 "echo")
             (serverevent (lambda (x)
                            (let ((info (cdr x.value)))
                              (case (car x.value)
                                (("change")
                                 (change info ))
                                (("delete")
                                 (if (and selectedshape (eq? (selectedshape 'id) info))
                                     (set! selectedshape '())
                                     (deleteshape info)))
                                (else
                                 (set! shapes (cons (converttoshape x.value) shapes))))
                              (redraw))
                            )
                          ))



         ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

         ;Events definitions
         (define (add-click)
           (add-event-listener! activecanvas "click" (lambda (x)
                                                       ;We check if we are in the click mode
                                                       (if (and (equal? selectedmode "click") (null? selectedshape))
                                                           (let* ((toextend (getshape selectedid))
                                                                  (xcord (- (event-mouse-x x) activecanvas.offsetLeft))
                                                                  (ycord (-  (event-mouse-y x) activecanvas.offsetTop)))
                                                             (if (null? selectedid)
                                                                 (with-hop ($broadcast room   (list  "poly" xcord ycord drawwidth
                                                                                                     (list (cons (+ 1 xcord)(+ 1 ycord)))
                                                                                                     activecolor borderwidth bordercolor))
                                                                           (lambda (x)
                                                                             (set! selectedid x) ))
                                                                 ;If there is a selectedid (shape in making)
                                                                 (with-hop ($change room
                                                                                    (list (toextend 'id)(toextend 'type)(toextend 'x)
                                                                                          (toextend 'y)(toextend 'w)
                                                                                          (cons (cons xcord ycord) (toextend 'h))
                                                                                          (toextend 'color) (toextend 'bw)(toextend 'bc))
                                                                                    )))
                                                             )
                                                           (set! selectedid '())
                                                           )) 1))

         (define (add-mousedown)
           (add-event-listener! activecanvas "mousedown" (lambda (x)
                                                           ;check to select
                                                           (let ((xcord (- (event-mouse-x x) activecanvas.offsetLeft))
                                                                 (ycord (-  (event-mouse-y x) activecanvas.offsetTop)))
                                                             (select-shape xcord ycord)
                                                             (set! movableshape selectedshape)
                                                             ;(alert movableshape)
                                                             (redraw)

                                                             ;if none is selected
                                                             (if (null? selectedshape)
                                                                 (if (not disableclick)
                                                                     (let ((lst (case selectedmode
                                                                                  (("draw") (list  "line" xcord ycord drawwidth
                                                                                                   (list (cons (+ 1 xcord) (+ 1 ycord)))
                                                                                                   activecolor borderwidth bordercolor))
                                                                                  (("ellipse") (list  "ellipse" xcord ycord drawwidth
                                                                                                      drawwidth activecolor borderwidth bordercolor))
                                                                                  (("rectangle") (list  "rectangle" xcord ycord 10 10
                                                                                                        activecolor borderwidth bordercolor))
                                                                                  (else '()))))
                                                                       (if (not (null? lst))
                                                                           (with-hop ($broadcast room lst)
                                                                                     (lambda (x) (set! resizableid x)))))
                                                                     (begin
                                                                       (set! shapes (cons selectedshape shapes))
                                                                       (set! selectedshape '())
                                                                       (set! movableshape '())))
                                                                 ;if a shape was selected
                                                                 (begin (set! xycord (cons  xcord ycord))
                                                                        (set! resizableid '()))
                                                                 )))#t))




         (define (add-mousemove)
           (add-event-listener! activecanvas "mousemove" (lambda (x)
                                                           (let ((xcord (- (event-mouse-x x) activecanvas.offsetLeft))
                                                                 (ycord (-  (event-mouse-y x) activecanvas.offsetTop)))
                                                             (if (not (null? resizableid))
                                                                 (let* ((todrag (getshape resizableid))
                                                                        (lst (case (todrag 'type)
                                                                               (("rectangle")(list (- xcord (todrag 'x))
                                                                                                   (- ycord (todrag 'y))))
                                                                               (("ellipse")(list   (abs (- xcord (todrag 'x)) )
                                                                                                   (abs (- ycord (todrag 'y)) )))
                                                                               (("line")(list (todrag 'w)
                                                                                              (cons (cons xcord ycord) (todrag 'h)))))
                                                                             ))
                                                                   (with-hop ($change room
                                                                                      (append (list (todrag 'id)(todrag 'type)(todrag 'x)(todrag 'y))
                                                                                              lst (list
                                                                                                   (todrag 'color)(todrag 'bw)(todrag 'bc)))))
                                                                   )
                                                                 ;;;;;;;;;;;;;;;;;HERE IS THE CODE TO MOVE A SHAPE;;;;;;;;;;;;;;;;;
                                                                 (if (and (not (null? movableshape)) (not (null? selectedshape)))
                                                                     (let* ((offsetx (- xcord (car xycord)))
                                                                            (offsety (- ycord (cdr xycord)))
                                                                            (lst
                                                                             (if  (or (equal? (movableshape 'type)"line")
                                                                                      (equal? (movableshape 'type)"poly"))
                                                                                  (list  (- (selectedshape 'x) offsetx)
                                                                                         (- (selectedshape 'y) offsety)(selectedshape 'w)
                                                                                         (update-coords (selectedshape 'h) offsetx offsety))
                                                                                  (list   (+(selectedshape 'x) offsetx)(+(selectedshape 'y) offsety)
                                                                                          (selectedshape 'w)(selectedshape 'h))
                                                                                  )))
                                                                       (set! movableshape selectedshape)
                                                                       (with-hop ($change room
                                                                                          (append (list (selectedshape 'id)
                                                                                                        (selectedshape 'type))
                                                                                                  lst
                                                                                                  (list (selectedshape 'color)
                                                                                                        (selectedshape 'bw)
                                                                                                        (selectedshape 'bc)
                                                                                                        ))
                                                                                          ))
                                                                       (set! xycord (cons xcord ycord))
                                                                       ))))) #t))


         (define (add-mouseup)
           (add-event-listener! activecanvas "mouseup" (lambda (x)
                                                         (set! resizableid '())
                                                         (set! movableshape '()) ) #t))




         ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

         ;Now we draw the html page containg the toolbox and the canvas
         (<DIV> (<H1> "Welcome in " joinedroom ", " user)
                (<DIV> id: "toolbox"
                       (<P> "Draw Color:" (<BR>)
                            colorpicker1
                            (<COLORCHOOSER> :id "cc"
                (<INPUT> :type 'button :value "Set stroke color" :onclick (alert "click")))


                            (<INPUT> :type "text" :id "color" :value activecolor :size 8 :onkeyup (begin
                                                                                                    ; (alert this.value)
                                                                                                    (set! activecolor this.value)
                                                                                                    (updateselected activecolor (selectedshape 'bw)(selectedshape 'bc))
                                                                                                    )))

                       ;  (<P> "Draw width")
                       ;  (<INPUT> :type "text" :id "thickness" :value drawwidth :onkeyup (begin
                       ;                                                          (set! drawwidth (dom-get-element-by-id "thickness").value)
                       ;                                                         ))


                       (<P> "Border color"
                            (<INPUT> :type "text" :id "bordercolor" :value bordercolor :onkeyup (begin
                                                                                                  (set! bordercolor (dom-get-element-by-id "bordercolor").value)
                                                                                                  (updateselected (selectedshape 'color) (selectedshape 'bw) bordercolor)
                                                                                                  )))

                       (<P> "Border thickness")
                       (<INPUT> :type "text" :id "borderthickness" :value borderwidth :onkeyup(begin
                                                                                                (set! borderwidth (dom-get-element-by-id "borderthickness"))
                                                                                                (updateselected (selectedshape 'color) borderwidth (selectedshape 'bc))
                                                                                                ))

                       (<P> "Draw mode"
                            (<SELECT> :onchange (set! selectedmode this.value)
                                      (<OPTION> :value "draw" "draw" )
                                      (<OPTION> :value "click" "click" )
                                      (<OPTION> :value "rectangle" "rectangle")
                                      (<OPTION> :value "ellipse" "ellipse")
                                      ))

                       (<P> "Other: " (<BR>)
                            (<INPUT> :type "button" :value "delete active" :onclick  (if (not (eq? '() selectedshape)) (with-hop ($deleteshape room ( selectedshape 'id)))))
                            (<INPUT> :type "button" :value "end poly" :onclick  (if (not (eq? '() selectedid)) (set! selectedid '())))



                            (<INPUT> :type "text" :id "savename" :value "")
                            (<INPUT> :type "button" :value "savestate" :onclick
                                     (let ((newname (dom-get-element-by-id "savename").value))
                                       (if (not (equal? "" newname))
                                           (with-hop ($savestate newname room)
                                                     (lambda (x)
                                                       (if (eq? x $FALSE)
                                                           (begin
                                                             (alert "name allready exists"))
                                                           (alert "state succesfully saved"))
                                                       ))
                                           (alert "please give in a name"))))
                            ))
                ;Toolbox end, starting canvas
                (<DIV> :id "canvas"
                       activecanvas
                       (add-click)
                       (add-mousedown)
                       (add-mousemove)
                       (add-mouseup)
                       (add-event-listener! room "server" serverevent #f)
                       )


                (<INPUT> :type "button"
                         :value "quit room"
                         :onclick (begin
                                    ;this gives an error in safari
                                    ;    (remove-event-listener! room "server" serverevent #f)

                                    (with-hop ($removeuserfromroom user room))
                                    ;   (alert room user)
                                    (set! room '())
                                    (set! selectedshape '())
                                    (set! shapes '())
                                    (set! selectedmode "draw")
                                    (show-welcome)
                                    ))
                )))


     (define (show-room joinedroom) (begin
                                      (innerHTML-set! (dom-get-element-by-id "body") (joinroom joinedroom))
                                      (with-hop ($getcontentfromserver joinedroom) (lambda (x)
                                                                                     (if (not (equal? "()" x))
                                                                                         (begin
                                                                                           (set! shapes (convertservershapes x))
                                                                                           (redraw)
                                                                                           )
                                                                                         ))
                                                )))))


(define id 1)

(define(get-id)
  (let ((temp id))
    (set! id (+ id 1))
    temp))


(define-service (change roomname lst)
  (tprint "we change " lst)
  (changeonserver roomname lst)
  (hop-event-broadcast! roomname (cons "change" lst)))

(define-service (deleteshape roomname shapeid)
  (tprint "we delete " shapeid)
  (deleteonserver roomname shapeid)
  (hop-event-broadcast! roomname (cons "delete" shapeid)))

(define-service (broadcast roomname proc)
  (let* ((newid (get-id))
         (msg (cons  newid proc))
         )
    (tprint roomname " broadcasts " msg )
    (findandaddcontent! roomname msg)
    (hop-event-broadcast! roomname msg)
    newid))