treeline/graph_editor.clj

   1 (ns treeline.graph_editor
   2   (:import
   3      (cytoscape Cytoscape)
   4      (cytoscape.data Semantics)
   5      (ding.view NodeContextMenuListener)
   6      (csplugins.layout.algorithms.hierarchicalLayout HierarchicalLayoutAlgorithm)
   7      (javax.swing JFrame JScrollPane JMenuItem JPanel)
   8      (java.awt Dimension)
   9      (java.awt.event ActionListener KeyAdapter KeyEvent)))
  10
  11 (defmacro report
  12   [& args]
  13   `(ij.IJ/log (str ~@args)))
  14
  15 (defmacro create-node
  16   [net title]
  17   `(let [node# (Cytoscape/getCyNode ~title true)]
  18     (.addNode ~net node#)
  19     node#))
  20
  21 (let [id (ref 0)]
  22   (defn next-id
  23     []
  24     (dosync (alter id inc))))
  25
  26 (defn create-nodes
  27   "Create a list of maps, where each map contains a :node and potentially a :branch,
  28   the latter containing another list of maps, etc."
  29   [net branch]
  30   ;(println "branch: "branch)
  31   (let [points (.getPoints branch)
  32         branches (if-let [bm (.getBranches branch)]
  33                    (into {} bm)
  34                    nil)
  35         branch-id (next-id)]
  36     (map
  37       (fn [i x y layer-id]
  38         (let [m {:x x :y y :layer-id layer-id
  39                  :node (create-node net (str branch-id \- i))}]
  40           (if branches
  41             (if-let [bs (branches i)]
  42               (assoc m :branches (map
  43                                    #(create-nodes net %)
  44                                    (into [] bs)))
  45               m)
  46             m)))
  47       (range (count (get points 0)))
  48       (seq (get points 0))
  49       (seq (get points 1))
  50       (seq (get points 2)))))
  51
  52
  53 (let [node-type "pp"]
  54   (defn create-edge
  55     [node1 node2]
  56     (Cytoscape/getCyEdge node1 node2 Semantics/INTERACTION node-type true)))
  57
  58 (defn create-edges
  59   [net nodes]
  60   (loop [prev-node (first nodes)
  61          next-nodes (next nodes)]
  62     (do
  63       ;(println "prev-node is" prev-node)
  64       (doseq [b (prev-node :branches)]
  65         (create-edges net b)
  66         ;(println "b is " b)
  67         (.addEdge net (create-edge (prev-node :node)
  68                                    ((first b) :node))))
  69       (let [next-node (first next-nodes)]
  70         (if (not next-node)
  71           nil
  72           (do
  73             (.addEdge net (create-edge (prev-node :node) (next-node :node)))
  74             (recur next-node (next next-nodes))))))))
  75
  76 ; WRONG: first node doesn't get checked for branches
  77 ;  (dorun
  78 ;    (map
  79 ;      (fn [m1 m2]
  80 ;        (.addEdge net (create-edge (m1 :node) (m2 :node)))
  81 ;        (doseq [b (m2 :branches)]
  82 ;          (println "going to use branch " b)
  83 ;          (.addEdge net (create-edge (m2 :node) ((first (create-edges net b)) :node))))))
  84 ;       nodes
  85 ;       (rest nodes))))
  86
  87 (defn create-tree
  88   [net tline]
  89   (let [nodes (create-nodes net (.getRoot tline))]
  90     (dorun (create-edges net nodes))
  91     nodes))
  92
  93 ;  (reduce
  94 ;    (fn [v m]
  95 ;      (.addEdge net (create-edge ((get v (dec (count v))) :node) (m :node)))
  96 ;      (if-let [bs (m :branches)]
  97 ;        (doseq [b bs]
  98 ;          (.addEdge net (create-edge (m :node) (first (create-tree b)))))))
  99 ;    (create-nodes net branch)))
 100
 101 (defn create-graph
 102   "Creates a graph of cytoscape nodes that show all points of a Treeline."
 103   [tline]
 104   (let [net (Cytoscape/createNetwork (.getTitle tline) false)
 105         nodes (create-tree net tline)
 106         view (Cytoscape/createNetworkView net (.getTitle tline) (HierarchicalLayoutAlgorithm.))]
 107     [net nodes view]))
 108
 109 (defn show
 110   "Takes any Component and shows it inside a JFrame."
 111   [component title]
 112   (doto (JFrame. title)
 113     (.add component)
 114     (.pack)
 115     (.setVisible true)))
 116
 117 (defn with-scroll
 118   "Takes a Component and returns a JScrollPane of dimensions w,h that shows it."
 119   [component w h]
 120   (doto (JScrollPane. component)
 121     (.setPreferredSize (Dimension. w h))))
 122
 123 (defn as-graph
 124   "Show the given treeline as a tree of nodes.
 125   Add mouse event hooks to each node to show a contextual menu."
 126   [tline]
 127   (if tline
 128     (let [[net nodes view] (create-graph tline)
 129           frame (JFrame. (.getTitle tline))
 130           panel (JScrollPane. (.getComponent view))]
 131       (doto panel
 132         (.setPreferredSize (Dimension. 500 500)))
 133       (.. frame getContentPane (add panel))
 134       (doto frame
 135         (.pack)
 136         (.setVisible true))
 137       (doto view
 138         ;(.fitContent)
 139         (.addNodeContextMenuListener
 140           (let [worker (agent nil)
 141                 items {(JMenuItem. "Fit graph") #(.fitContent view)
 142                        (JMenuItem. "Select in 2D") #(report "Selected not yet implemented")}
 143                 listener (proxy [ActionListener] []
 144                            (actionPerformed [evt]
 145                             (send-off worker
 146                               (fn [_]
 147                                 (try
 148                                   (if-let [action (items (.getSource evt))]
 149                                     (action)
 150                                     (report "Action not found for " (.getCommand evt))))))))]
 151             (doseq [item (keys items)] (.addActionListener item listener))
 152             (proxy [NodeContextMenuListener] []
 153               (addNodeContextMenuItems [nodeView menu]
 154                 (.removeAll menu)
 155                 (doseq [item (keys items)] (.add menu item)))))))
 156       (doto (.getComponent view)
 157         (.addKeyListener
 158           (proxy [KeyAdapter] []
 159             (keyPressed [evt]
 160               (try
 161                 (println "key pressed: " (.getKeyChar evt))
 162                 (if (= KeyEvent/VK_F (.getKeyCode evt))
 163                   (.fitContent view))
 164                 (catch Exception e (.printStackTrace e)))))))
 165       view)
 166     (report "Null Treeline!")))