(import scheme)
(import (chicken base))
(import (chicken bitwise))
(import (chicken flonum))
(import (prefix glfw3 glfw:))
(import (prefix epoxy gl:))
(import (prefix nuklear-glfw3-opengl2 nk:))
(import (prefix nuklear nk:))
(import (srfi 1))

(define width 800)
(define height 600)

(glfw:init)
(glfw:make-window width height "Node Editor")
(glfw:make-context-current (glfw:window))
(set!-values (width height) (glfw:get-window-size (glfw:window)))

(define ctx (nk:init (glfw:window)))
(nk:init-default-font ctx)

(define bg (nk:make-color 0.1 0.18 0.24 1.0))
(define dark-gray (nk:rgb->color 50 50 50))
(define light-gray (nk:rgb->color 100 100 100))

(define max-id (make-parameter 0))

(define-record node id name bounds color in-count out-count)
(define-record link in-id in-slot out-id out-slot in out)
(define-record linking active? node in-id in-slot)
(define-record node-editor initialized? nodes links bounds selected show-grid? scrolling linking)

(define (node-editor-find editor id)
  (let ((nodes (node-editor-nodes editor)))
    (find (lambda (node) (= (node-id node) id)) nodes)))

(define (node-editor-add! editor name bounds color in-count out-count)
  (let ((node (make-node (max-id) name bounds color in-count out-count))
        (nodes (node-editor-nodes editor)))
    (max-id (add1 (max-id)))
    (node-editor-nodes-set! editor (append nodes (list node)))))

(define (node-editor-link! editor in-id in-slot out-id out-slot)
  (let ((link (make-link in-id in-slot out-id out-slot #f #f))
        (links (node-editor-links editor)))
    (node-editor-links-set! editor (cons link links))))

(define (node-editor-reshuffle! editor id)
  (let ((nodes (node-editor-nodes editor)))
    (receive (front back) (break (lambda (node) (= (node-id node) id)) nodes)
     (node-editor-nodes-set! editor (append front (cdr back) (list (car back)))))))

(define (node-editor-init! editor)
  (node-editor-add! editor "Source" (nk:make-rect 40 10 180 220) (nk:rgb->color 255 0 0) 0 1)
  (node-editor-add! editor "Source" (nk:make-rect 40 260 180 220) (nk:rgb->color 0 255 0) 0 1)
  (node-editor-add! editor "Combine" (nk:make-rect 400 100 180 220) (nk:rgb->color 0 0 255) 2 2)
  (node-editor-link! editor 0 0 2 0)
  (node-editor-link! editor 1 0 2 1)
  (node-editor-show-grid?-set! editor #t))

(define editor (make-node-editor #f '() '() #f #f #f (nk:make-vec2 0 0)
                                 (make-linking #f #f #f #f)))

(define ->flag bitwise-ior)
(define (fpmod x y) (fp- x (fp* (fpfloor (fp/ x y)) y)))

(let loop ()
  (when (and (not (glfw:window-should-close (glfw:window))))
    (glfw:poll-events)
    (nk:new-frame)

    (when (not (node-editor-initialized? editor))
      (node-editor-init! editor)
      (node-editor-initialized?-set! editor #t))

    (when (nk:window-begin ctx "NodeEdit"
                           (nk:make-rect 0 0 800 600)
                           (->flag nk:window/border nk:window/no-scrollbar
                                   nk:window/movable nk:window/closable))
      (let ((node #f)
            (input (nk:context-input ctx))
            (canvas (nk:window-canvas ctx))
            (total-space (nk:window-content-region ctx))
            (size (nk:layout-space-bounds ctx))
            (updated #f))
        (nk:layout-space-begin ctx nk:layout/static (nk:rect-h total-space)
                               (length (node-editor-nodes editor)))
        (when (node-editor-show-grid? editor)
          ;; display grid
          (let ((grid-size 32.0))
            (do ((x (fpmod (- (nk:rect-x size)
                              (nk:vec2-x (node-editor-scrolling editor)))
                           grid-size)
                    (+ x grid-size)))
                ((> x (nk:rect-w size)))
              (nk:stroke-line
               canvas (+ x (nk:rect-x size)) (nk:rect-y size)
               (+ x (nk:rect-x size)) (+ (nk:rect-y size) (nk:rect-h size))
               1.0 dark-gray))
            (do ((y (fpmod (- (nk:rect-y size)
                              (nk:vec2-y (node-editor-scrolling editor)))
                           grid-size)
                    (+ y grid-size)))
                ((> y (nk:rect-h size)))
              (nk:stroke-line
               canvas (nk:rect-x size) (+ y (nk:rect-y size))
               (+ (nk:rect-x size) (nk:rect-w size))
               (+ y (nk:rect-y size)) 1.0 dark-gray))))

        ;; execute each node as a movable group
        (for-each
         (lambda (it)
           ;; calculate scrolled node window position and size
           (let* ((bounds (node-bounds it))
                  (scrolling (node-editor-scrolling editor))
                  (rect (nk:make-rect (- (nk:rect-x bounds) (nk:vec2-x scrolling))
                                      (- (nk:rect-y bounds) (nk:vec2-y scrolling))
                                      (nk:rect-w bounds)
                                      (nk:rect-h bounds))))
             (nk:layout-space-push ctx rect))

           ;; execute node window
           (when (nk:group-begin ctx (node-name it)
                                 (->flag nk:window/movable nk:window/no-scrollbar
                                         nk:window/border nk:window/title))
             ;; always have last selected node on top
             (set! node (nk:window-panel ctx))
             (let ((nodes (node-editor-nodes editor)))
               (when (and (nk:input-mouse-clicked? input nk:button/left (nk:panel-bounds node))
                          (not (and (not (= (node-id it) (node-id (car nodes))))
                                    (nk:input-mouse-clicked? input nk:button/left
                                                             (nk:layout-space-rect-to-screen ctx (nk:panel-bounds node)))))
                          (not (= (node-id it) (node-id (last nodes)))))
                 (set! updated it)))

             ;; node content
             (nk:layout-row-dynamic ctx 25 1)
             (let ((color (node-color it)))
               (nk:button-color ctx color)
               (nk:color-r-set! color (nk:property-int ctx "#R:" 0 (nk:color-r color) 255 1 1))
               (nk:color-g-set! color (nk:property-int ctx "#G:" 0 (nk:color-g color) 255 1 1))
               (nk:color-b-set! color (nk:property-int ctx "#B:" 0 (nk:color-b color) 255 1 1))
               (nk:color-a-set! color (nk:property-int ctx "#A:" 0 (nk:color-a color) 255 1 1)))
             (nk:group-end ctx))

           ;; node connector and linking
           (let* ((bounds (nk:layout-space-rect-to-local ctx (nk:panel-bounds node)))
                  (scrolling (node-editor-scrolling editor)))
             (nk:rect-x-set! bounds (+ (nk:vec2-x scrolling) (nk:rect-x bounds)))
             (nk:rect-y-set! bounds (+ (nk:vec2-y scrolling) (nk:rect-y bounds)))
             (node-bounds-set! it bounds)
             )

           (let* ((in-count (node-in-count it))
                  (out-count (node-out-count it))
                  (height (nk:rect-h (nk:panel-bounds node)))
                  (in-space (/ height (add1 in-count)))
                  (out-space (/ height (add1 out-count))))

             ;; output connector
             (let loop ((i 0))
               (when (< i out-count)
                 (let* ((x (- (+ (nk:rect-x (nk:panel-bounds node)) (nk:rect-w (nk:panel-bounds node))) 4))
                        (y (+ (nk:rect-y (nk:panel-bounds node)) (* out-space (add1 i))))
                        (w 8)
                        (h 8)
                        (circle (nk:make-rect x y w h)))
                   (nk:fill-circle canvas circle light-gray)

                   ;; start linking process
                   (when (nk:input-mouse-click-down-in-rect? input nk:button/left circle #t)
                     (let ((linking (node-editor-linking editor)))
                       (linking-active?-set! linking #t)
                       (linking-node-set! linking it)
                       (linking-in-id-set! linking (node-id it))
                       (linking-in-slot-set! linking i)

                       ;; draw curve from linked node slot to mouse position
                       (when (and (linking-active? linking)
                                  (= (node-id (linking-node linking)) (node-id it))
                                  (= (linking-in-slot linking) i))
                         (let* ((l0 (nk:make-vec2 (+ (nk:rect-x circle) 3)
                                                  (+ (nk:rect-y circle) 3)))
                                (l0-x (nk:vec2-x l0))
                                (l0-y (nk:vec2-y l0))
                                (l1 (nk:mouse-position (nk:input-mouse input)))
                                (l1-x (nk:vec2-x l1))
                                (l1-y (nk:vec2-y l1)))
                           (nk:stroke-curve
                            canvas l0-x l0-y (+ l0-x 50) l0-y
                            (- l1-x 50) l1-y l1-x l1-y 1 light-gray)))))
                   (loop (add1 i)))))

             ;; input connector
             (let loop ((i 0))
               (when (< i in-count)
                 (let* ((x (- (nk:rect-x (nk:panel-bounds node)) 4))
                        (y (+ (nk:rect-y (nk:panel-bounds node)) (* in-space (add1 i))))
                        (w 8)
                        (h 8)
                        (circle (nk:make-rect x y w h)))
                   (nk:fill-circle canvas circle light-gray)
                   (when (and (nk:input-mouse-released? input nk:button/left)
                              (nk:input-mouse-hovering-in-rect? input circle))
                     (let ((linking (node-editor-linking editor)))
                       (when (and (linking-active? linking)
                                  (not (= (node-id (linking-node linking))
                                          (node-id it))))
                         (linking-active?-set! linking #f)
                         (node-editor-link! editor (linking-in-id linking)
                                            (linking-in-slot linking)
                                            (node-id it) i)))))
                 (loop (add1 i))))))
         (node-editor-nodes editor))

        ;; reset linking connection
        (let ((linking (node-editor-linking editor)))
          (when (and (linking-active? linking)
                     (nk:input-mouse-released? input nk:button/left))
            (linking-active?-set! linking #f)
            (linking-node-set! linking #f)
            (print "linking failed")))

        ;; draw each link
        (for-each
         (lambda (link)
           (let* ((height (nk:rect-h (nk:panel-bounds node)))
                  (scroll (node-editor-scrolling editor))
                  (in (node-editor-find editor (link-in-id link)))
                  (out (node-editor-find editor (link-out-id link)))
                  (in-bounds (node-bounds in))
                  (out-bounds (node-bounds out))
                  (in-space (/ height (add1 (node-out-count in))))
                  (out-space (/ height (add1 (node-in-count out))))
                  (l0 (nk:make-vec2 (+ (nk:rect-x in-bounds) (nk:rect-w in-bounds))
                                    (+ (nk:rect-y in-bounds)
                                       (* in-space (add1 (link-in-slot link))) 3)))
                  (l0 (nk:layout-space-to-screen ctx l0))
                  (l1 (nk:make-vec2 (nk:rect-x out-bounds)
                                    (+ (nk:rect-y out-bounds)
                                       (* out-space (add1 (link-out-slot link))) 3)))
                  (l1 (nk:layout-space-to-screen ctx l1)))
             (nk:vec2-x-set! l0 (- (nk:vec2-x l0) (nk:vec2-x scroll)))
             (nk:vec2-y-set! l0 (- (nk:vec2-y l0) (nk:vec2-y scroll)))
             (nk:vec2-x-set! l1 (- (nk:vec2-x l1) (nk:vec2-x scroll)))
             (nk:vec2-y-set! l1 (- (nk:vec2-y l1) (nk:vec2-y scroll)))
             (let ((l0-x (nk:vec2-x l0))
                   (l0-y (nk:vec2-y l0))
                   (l1-x (nk:vec2-x l1))
                   (l1-y (nk:vec2-y l1)))
               (nk:stroke-curve canvas l0-x l0-y (+ l0-x 50) l0-y (- l1-x 50)
                                l1-y l1-x l1-y 1.0 light-gray))))
         (node-editor-links editor))

        (when updated
          (node-editor-reshuffle! editor (node-id updated)))

        ;; node selection
        (when (nk:input-mouse-clicked? input nk:button/left (nk:layout-space-bounds ctx))
          (node-editor-selected-set! editor #f)
          (let ((pos (nk:mouse-position (nk:input-mouse input))))
            (node-editor-bounds-set! editor (nk:make-rect (nk:vec2-x pos)
                                                          (nk:vec2-y pos)
                                                          100
                                                          200)))
          (for-each
           (lambda (it)
             (let ((b (nk:layout-space-rect-to-screen ctx (node-bounds it))))
               (nk:rect-x-set! b (- (nk:rect-x b) (nk:vec2-x (node-editor-scrolling editor))))
               (nk:rect-y-set! b (- (nk:rect-y b) (nk:vec2-y (node-editor-scrolling editor))))
               (when (nk:input-mouse-hovering-in-rect? input b)
                 (node-editor-selected-set! editor it))))
           (node-editor-nodes editor)))

        ;; contextual menu
        (when (nk:contextual-begin ctx (->flag)
                                   (nk:make-vec2 100 220)
                                   (nk:panel-bounds (nk:window-panel ctx)))
          (nk:layout-row-dynamic ctx 25 1)
          (when (nk:contextual-item-label ctx "New" nk:text/centered)
            (node-editor-add! editor "New" (nk:make-rect 400 260 180 220)
                              (nk:rgb->color 255 255 255) 1 2))
          (when (nk:contextual-item-label ctx (if (node-editor-show-grid? editor)
                                                  "Hide Grid"
                                                  "Show Grid")
                                          nk:text/centered)
            (node-editor-show-grid?-set! editor (not (node-editor-show-grid? editor))))
          (nk:contextual-end ctx))

        (nk:layout-space-end ctx)

        ;; window content scrolling
        (when (and (nk:input-mouse-hovering-in-rect? input (nk:panel-bounds (nk:window-panel ctx)))
                   (nk:input-mouse-down? input nk:button/middle))
          (let* ((scroll (node-editor-scrolling editor))
                 (delta (nk:mouse-delta (nk:input-mouse input))))
            (nk:vec2-x-set! scroll (+ (nk:vec2-x scroll) (nk:vec2-x delta)))
            (nk:vec2-y-set! scroll (+ (nk:vec2-y scroll) (nk:vec2-y delta)))
            (node-editor-scrolling-set! editor scroll))))
      (nk:window-end ctx))

    (let-values (((width height) (glfw:get-window-size (glfw:window))))
      (gl:viewport 0 0 width height))
    (gl:clear gl:+color-buffer-bit+)
    (gl:clear-color (nk:color-r bg) (nk:color-g bg) (nk:color-b bg) (nk:color-a bg))
    (nk:render nk:anti-aliasing/on)
    (glfw:swap-buffers (glfw:window))
    (loop)))

(nk:shutdown)
(glfw:terminate)