(use goo)

(use samurui/samurui)

(use samurui/intrinsic) ;; for the lightweight stuff, should be refactored out

;; Extrinsic rendering... mapping properties of an object into cartesian space.
;;  -- although, ideally, the coordinate space should be transformable, but
;;   let's leave that up to decorating lenses... 

;; Extrinsic gets a rendering surface.

(idrawmodel-ext <visi-col> <visi-extrinsic>
                (
                  (if (mem? attribs 'extrinsic)
                      1000
                      1)
                  )
                ()
                )

(dp! ext-fundamental-axis (<visi-extrinsic> => <any>) #f)
(dp! ext-root-node (<visi-extrinsic> => <any>) #f)

(dp! ext-x-axis (<visi-extrinsic> => <any>) #f)
(dp! ext-y-axis (<visi-extrinsic> => <any>) #f)

(dp! ext-x-min (<visi-extrinsic> => <flo>) 0.0)
(dp! ext-x-max (<visi-extrinsic> => <flo>) 1.0)
(dp! ext-y-min (<visi-extrinsic> => <flo>) 0.0)
(dp! ext-y-max (<visi-extrinsic> => <flo>) 1.0)

(dp! ext-lenses (<visi-extrinsic> => <col>) (vec))

(dp! ext-wrapped (<visi-extrinsic> => (t? <visi-col>)) #f)
(dp! ext-master (<visi-extrinsic> => (t? <gui-master>)) #f)

(dp! ext-item-renderer (<visi-extrinsic> => (t? <lightweight-renderer>)) (new <visi-intrinsic>))


(dm method-fold (methods initial-data)
  (def cur-val initial-data)
  (do (fun (method)
        (set cur-val (method cur-val))
        )
      methods)
  cur-val
  )

(dm repaint-widget (ext|<visi-extrinsic>)
  (def renderer (ext-item-renderer ext))

  (def scale-x (/ (as <flo> (gui-width ext)) (as <flo> (- (ext-x-max ext) (ext-x-min ext)))))
  (def scale-y (/ (as <flo> (gui-height ext)) (as <flo> (- (ext-y-max ext) (ext-y-min ext)))))

;;  (post "Scales x: %= y: %=\n" scale-x scale-y)
;;  (post "Fundamental axis is: %=\n" (ext-fundamental-axis ext))
;;  (post "Painting with nodes: %=\n"       (node-out-edges (ext-wrapped ext) (ext-fundamental-axis ext) (ext-root-node ext)))

  (do (fun (item)
        ;; Get the point from the visi-col
        (def init-point (point (* scale-x (1st (node-out-edges (ext-wrapped ext) 
                                                               (ext-x-axis ext)
                                                               item)))
                               (* scale-y (1st (node-out-edges (ext-wrapped ext)
                                                               (ext-y-axis ext)
                                                               item)))))

        ;; Transform with global lenses
        (def actual-point (method-fold (ext-lenses ext) init-point))

        ;; Render
        (draw-lightweight ext actual-point renderer item)
        )
      (node-out-edges (ext-wrapped ext) (ext-fundamental-axis ext) (ext-root-node ext))
      )

  (invalidate-all ext)
  )

(dm find-node (ext|<visi-extrinsic> test-point|<point>)
  (def found-node #f)
  (def renderer (ext-item-renderer ext))

  (def scale-x (/ (as <flo> (gui-width ext)) (as <flo> (- (ext-x-max ext) (ext-x-min ext)))))
  (def scale-y (/ (as <flo> (gui-height ext)) (as <flo> (- (ext-y-max ext) (ext-y-min ext)))))

  (do (fun (item)
        ;; Get the point from the visi-col
        (def init-point (point (* scale-x (1st (node-out-edges (ext-wrapped ext) 
                                                               (ext-x-axis ext)
                                                               item)))
                               (* scale-y (1st (node-out-edges (ext-wrapped ext)
                                                               (ext-y-axis ext)
                                                               item)))))

        ;; Transform with global lenses
        (def actual-point (method-fold (ext-lenses ext) init-point))

        (when (point-in-lightweight renderer item actual-point test-point)
          (set found-node item)
          )
        )
      (node-out-edges (ext-wrapped ext) (ext-fundamental-axis ext) (ext-root-node ext))
      )
  
  found-node
  )

(dm bind (ext|<visi-extrinsic> info|<interface-info> => (tup <fun> <fun> <fun>))
  (tup
   ;; -- Rebinder --
   (fun (new-obj)
     ;; Detach from current if applicable
     (when (ext-wrapped ext)
       ;; um... nop for now
       )
     
     ;; 
     (set (ext-wrapped ext) ((getter info) new-obj))

     (set (ext-root-node ext) (get-start-node (ext-wrapped ext)))

     (do (fun (attr)
           (when (isa? attr <col>)
             (post "Processing attribute pair: %=\n" attr)
             (case-by (1st attr) =
               (('fundamental)
                (set (ext-fundamental-axis ext) (as <str> (2nd attr)))
                )
               (('x)
                (set (ext-x-axis ext) (as <str> (2nd attr)))
                )
               (('y)
                (set (ext-y-axis ext) (as <str> (2nd attr)))
                )
               )
             )
           )
         (attrs ext)
         )
     )

   ;; -- Refresher --
   (fun ()
     (repaint-widget ext)
     )

   ;; -- Free / Cleanup --
   (fun ()
     )
   )
  )

(dm bind-master (ext|<visi-extrinsic> master|<gui-master> => <log>)
  (set (ext-master ext) master)
  #t
  )

(dm mouse-press (widget|<visi-extrinsic> x|<int> y|<int> button|<int> time|<int>)
  (def clicked-node (find-node widget (point x y)))
  (when (and (ext-master widget)
             clicked-node
             (node-browsable (ext-wrapped widget) clicked-node))
    (master-update-slaves (ext-master widget) clicked-node)
    )

  (repaint-widget widget)
  )

(dm mouse-release (widget|<visi-extrinsic> x|<int> y|<int> button|<int> time|<int>)
  )

(dm mouse-move (widget|<visi-extrinsic> x|<int> y|<int> state|<int>)
  )

(export
  ext-fundamental-axis
  ext-fundamental-axis-setter

  ext-root-node
  ext-root-node-setter

  ext-x-axis
  ext-x-axis-setter

  ext-y-axis
  ext-y-axis-setter
 
  ext-x-min
  ext-x-min-setter

  ext-y-min
  ext-y-min-setter

  ext-x-max
  ext-x-max-setter
 
  ext-y-max
  ext-y-max-setter

  ext-lenses
  ext-lenses-setter

  ext-wrapped
  ext-wrapped-setter
  
  ext-master
  ext-master-setter

  ext-item-renderer
  ext-item-renderer-setter
  )