graph.cljs

(ns undead.cards.svg.graph
  (:require
   [posh.core :as posh :refer [posh!]]
   [re-com.core :as rc]
   [cljs.pprint :refer [pprint]]
   [datascript.core :as d]
   [undead.cards.multi :as multi]
   [undead.util :refer [truncate]]
   [reagent.core :as r]
   [clojure.set :as s]
   #_[re-frame.core :refer [subscribe dispatch]]
   [reagent.ratom :as ra])
  (:require-macros
   [cljs.test  :refer [testing is]]
   [undead.subs :refer [deftrack]]
   [devcards.core
    :as dc
    :refer [defcard defcard-doc defcard-rg deftest]]))


(def schema {:node/title        {:db/unique :db.unique/identity}
             :node/prereqs        {:db/valueType   :db.type/ref
                                   :db/cardinality :db.cardinality/many}
             })

(def items-conn (d/create-conn schema))
(posh! items-conn)

(d/transact! items-conn [{:node/title "Goal"
                          :node/prereqs [{:node/title "Prereq A"
                                          :node/prereqs [{:node/title "Root Prereq"}]}
                                         {:node/title "Prereq B"
                                          :node/prereqs [{:node/title "Root Prereq"}]}]}
                         {:node/title "Simple Goal"}
                         {:node/title "Other Root Based Goal"
                          :node/prereqs [{:node/title "Root Prereq"}]}])


(defn pull-prereqs [conn eid]
  (d/pull @conn '[:node/title :db/id {:node/prereqs ...}] eid )
  )
(defn pull-is-prereqs [conn eid]
  (d/pull @conn '[:node/title :db/id {:node/_prereqs ...}] eid )
  )

;; (defn pull-edges [conn eid]
;;   (d/pull @conn '[:node/title {:node/_prereqs ...
;;                                :node/prereqs ...}] eid )
;;   )


(def prereqs-rule
  '[[(prereqs ?e ?p)
     [?e :node/prereqs ?p]]
    [(prereqs ?e ?p)
     [?e :node/prereqs ?p1]
     (prereqs ?p1 ?p)]])

;; 1 -> 2, 4
;; 2 -> 3
;; 3
;; 4 -> 3
;; 5
;; 6 -> 3

(defn magic-filter [s k l]
  (filter #(s/subset? (k % #{}) s) l))

(deftest filter-test
  (let [l [{:a [1 2]} {:a [1 3]} {:a [1 2 3]} {:a []}]
        s #{1 2}]
    (testing "keeping the maps, whose keys do not contain a value NOT in set s"

      (is  (= [{:a [1 2]} {:a []}] (magic-filter s :a l) )))
    (testing "pull all the prereqs"
      (is (= #{2 4 3} (set @(posh/q items-conn '[:find [?p ...] 
                                        :in $ % ?item
                                        :where (prereqs ?item ?p)]
                           prereqs-rule
                           1
                           )))))
    (testing "pull in query"     (is (= "" (posh/q items-conn '[:find (pull ?e [*])
                                                                :where [?e :node/title]]))))))


(defn layout-level [layout k l]
  (let [this-layer (magic-filter (:placed-items layout)
                                 k
                                 l)
        future-layers (remove (set this-layer) l)
        ]
    (-> (update-in layout [:columns] conj this-layer)
        (update-in [:placed-items] (partial apply conj) this-layer))))

(defn layout-columns [k items]
  (loop [layout {:placed-items #{}
                 :columns []}
         l items]
    (if (empty? l)
      layout
      (let [this-layer (magic-filter (:placed-items layout)
                                     k
                                     l)
            future-layers (remove (set this-layer) l)
            ]
        (recur (-> (update-in layout [:columns] conj this-layer)
                   (update-in [:placed-items] (partial apply conj) this-layer))
               future-layers)))))



(defn gridboard [conn]
  (let [items (posh/q conn '[:find [?e ...]
                             :where [?e :node/title]])
        prereqs (map (fn [eid] (pull-prereqs conn eid)) @items)
        columns (:columns (layout-columns :node/prereqs prereqs))
        selected-eid (r/atom {:s nil
                          :ancestors #{}
                          :descendants #{}})]
    (fn []
      [:div
       (pr-str @selected-eid)
       [rc/h-box
        :gap "15px"
        :children (for [c columns]
                    ^{:key c}
                    [rc/v-box
                     :gap "10px"
                     :children
                     (for [cell c]
                       ^{:key cell}[:div.grid-item
                                    {:on-click #(swap! selected-eid assoc-in [:s]
                                                       cell)}
                                    (truncate 10 (:node/title cell))])])]])))

#_(defcard-rg a
  [gridboard items-conn])


(deftrack prereq-q [conn eidatom]
  (set @(posh/q items-conn '[:find [?p ...] 
                             :in $ % ?item
                             :where (prereqs ?item ?p)]
                prereqs-rule
                @eidatom
                )) )

(deftrack desc-q [conn eidatom]
  (set @(posh/q items-conn '[:find [?p ...] 
                             :in $ % ?item
                             :where (prereqs ?p ?item)]
                prereqs-rule
                @eidatom
                )) )


(defn gridboard2 [conn]
  (let [items (posh/q conn '[:find [?e ...]
                             :where [?e :node/title]])
        prereqs (map (fn [eid] (pull-prereqs conn eid)) @items)
        columns (:columns (layout-columns :node/prereqs prereqs))
        selected-eid (r/atom 1)
        ancestors (prereq-q conn selected-eid)
        ds (desc-q conn selected-eid)]
    (fn []
      [:div#bso
       (pr-str @selected-eid)
       [rc/v-box
        :gap "10px"
        :children [[rc/line]
                   [:div (pr-str @ancestors)]
                   ]
        ]
       [rc/h-box
        :gap "15px"
        :children (for [c columns]
                    ^{:key c}
                    [rc/v-box
                     :gap "15px"
                     :children
                     (for [cell c
                           :let [id (:db/id cell)]]
                       ^{:key id}[:div.grid-item
                                    {:on-click #(reset! selected-eid 
                                                        id)
                                     :style {:background-color (cond
                                                                 (@ancestors id)
                                                                 "yellow"
                                                                 (@ds id)
                                                                 "green"
                                                                 (= @selected-eid id)
                                                                 "grey"
                                                                 :else
                                                                 "white"
                                                                 )}
                                     }
                                    (truncate 10 (:node/title cell))])])]])))

(defcard-rg grid-with-pre-and-post
  [gridboard2 items-conn])













(defn rect [i j]
	[:rect {:width 1
          :height 1
                                        ; :stroke-width 0.03
          :fill "green"
                                        ; :stroke "black"
          :x i
          :y j
          }])

(defn cross1 []
  [:g {:stroke "darkred"
       :stroke-width 0.1 
       :stroke-linecap "round"}
   [:line {:x1 1 :y1 2 :x2 2 :y2 1}]
   [:line {:x1 1 :y1 1 :x2 2 :y2 2}]]
  )
;;;

(defn line [x y x2 y2 color]
  [:line
   {:x1 x
    :y1 y
    :x2 x2
    :y2 y2
    :stroke color
    :stroke-width 0.1}
   ]

  )

(defn row-line [width height x1 x2 y]
  (let [startx (+ width x1)
        starty (+ (/ height 2) y)]
    [line startx starty x2 starty "black"]))

(defcard-rg svg-drawing
  [:svg
   {:view-box "0 0 10 10"
    :height 500
    :width 500
    }
   [line 4 2 5 2 "red"]

   [rect 4 2]
   [rect 9 3]
   [rect 1 3]
   [row-line 0.9 0.9 1 9 3]
   [rect 5 2]
   ]
  )




(defn vline
  ([x1 y1 x2]
   [line x1 y1 x2 y1 "black"])
  ([x1 y1 x2 color]
   [line x1 y1 x2 y1 color]))

(defn colline
  ([x y1 y2]
   [line x y1 x y2 "black"])
  ([x y1 y2 color]
   [line x y1 x y2 color]))

(defcard-rg right-angles
  [:svg
   {:view-box "0 0 10 10"
    :height 500
    :width 500
    }

   [rect 1 1]
   [rect 3 1]
   [rect 5 1]
   [rect 1 3]
   [rect 3 3]
   [rect 5 3]
   [rect 1 5]
   [rect 3 5]
   [rect 5 5]
   [vline 2 5.5 2.5]
   [vline 2.5 3.5 3]
   [colline 2.5 5.55 3.45]
   ]
  )



(defn right-angle [{:keys [x1 
                           y1
                           x2
                           y2
                           colwidth
                           row-height
                           line-width
                           spacer-width
                           color
                           opacity]
                    :or {colwidth 1
                         row-height 1
                         line-width 0.1
                         spacer-width 1
                         color "blue"
                         opacity 1}
                    }

                   ]

  (let [x1 (min x1 x2)
        x2 (max x1 x2)
        miny (min y1 y2)
        maxy (max y1 y2)

        x (+ colwidth x1)
        midcol (/ spacer-width 2)
        midrow (/ row-height 2)
        midpoint (+ x midcol)
        midpoint2 (- x2 midcol)
        ]
    [:g {:opacity opacity}
     [vline
        x
        (+ y1 midrow)
        ;; (+ x1 colwidth (/ spacer-width 2))
        ;; "blue"
        midpoint
        color
        ]
     [vline
      x2
      (+ y2 midrow)
      ;; (+ x1 colwidth (/ spacer-width 2))
      ;; "color"
      midpoint2
      color
      ]
     [colline
      midpoint
      (-  (+ miny midrow ) (/ line-width 2) )
      (+ maxy midrow (/ line-width 2))
      color]
     ]

    )

  )

(defcard-rg right-angles2
  
  [:svg
   {:view-box "0 0 10 10"
    :height 500
    :width 500
    }

   [rect 1 1]
   [rect 3 1]
   [rect 5 1]
   [rect 1 3]
   [rect 3 3]
   [rect 5 3]
   [rect 1 5]
   [rect 3 5]
   [rect 5 5]
   [right-angle {:x1 3 :x2 5
                 :y1 5 :y2 3
                 :color "red"}]
   [right-angle {:x1 1 :x2 3
                 :y1 1 :y2 3
                 :color "red"}
    ]
   ]
  )

(defcard-rg right-angles2
  [:svg
   {:view-box "0 0 10 10"
    :height 500
    :width 500
    }

   [rect 1 1]
   [rect 3 1]
   [rect 5 1]
   [rect 1 3]
   [rect 3 3]
   [rect 5 3]
   [rect 1 5]
   [right-angle {:x1 3 :x2 5
                 :y1 3 :y2 5
                 :opacity 0.3}]
   [right-angle {:x1 3 :x2 5
                 :y1 1 :y2 5
                 :opacity 0.3}]
   [right-angle {:x1 3 :x2 5
                 :y1 5 :y2 5
                 :opacity 0.3}]
   [rect 3 5]
   [rect 5 5]
   [right-angle {:x1 3 :x2 5
                 :y1 5 :y2 3
                 :opacity 0.3
                 :color "red"}]
   [right-angle {:x1 1 :x2 3
                 :y1 1 :y2 3
                 :color "red"}
    ]
     ]
  )


;;;;;;;;;
(defcard-rg right-angles3
  "*spacer-width can be used to cross columns*"
  [:svg
   {:view-box "0 0 10 10"
    :height 500
    :width 500
    }

   [rect 1 1]
   [rect 3 1]
   [rect 5 1]
   [rect 1 3]
   [rect 3 3]
   [rect 5 3]
   [rect 1 5]
   
   [rect 3 5]
   [rect 5 5]
   [right-angle {:x1 1 :y1 5
                 :x2 5 :y2 1
                 :color "blue"
                 :spacer-width 3}]
   [right-angle {:x1 1 :x2 5
                 :y1 1 :y2 5
                 :color "red"}
    ]
     ]
  )