motion.cljs

(ns history.motion
  (:require [reagent.core    :as rx     ]
            [posh.core       :as rx-db  :refer [pull transact!]]
            [reagent.session :as session]
            [re-frame.core   :refer [register-sub subscribe dispatch register-handler]]
            [re-frame.db :as rdb :refer [app-db]]
            [datascript.core :as mdb    ]
            [cljs.reader                ]
            [clojure.string  :as str    ])
  (:require-macros
            [reagent.ratom :refer [reaction]]
            [devcards.core   :as dc
             :refer [defcard defcard-doc defcard-rg deftest]]))




(register-handler
 :init1
 (fn [_ _]
    {:status "great"}))





(register-handler
 :change-status
 (fn [db [_ status]]
      (assoc db :status status)))


(register-sub
 :status
 (fn [db _]
   (reaction (:status @db))))


(def lildb 
 (reaction @(subscribe [:status])))


(defn swapper []
  (let [s (subscribe [:status])]
    [:div
     [:button {:on-click #(dispatch [:change-status "fantastic"])} "fantastic"]
     [:button {:on-click #(dispatch [:change-status "terrible"])} "terrible"]]))

(defcard-rg status-card
   [swapper]
  lildb
  {:inspect-data true
   :history true})






(enable-console-print!)

(def e->xy 
  (juxt #(.-clientX %) #(.-clientY %)))



(defn getBounding [e]
  (let [r (.-target e)]
    ((juxt #(.-left %) #(.-top %)) (. r getBoundingClientRect))))





(defn get-pos [e]
	(mapv - (e->xy e) (getBounding e)))




(defcard-rg sv1
  [:svg 
   {:height 500
    :style {:border "1px solid black"}
    :on-click #(do 
                 #_(js/alert (e->xy %))
                 (js/alert (get-pos %)))
    :width 500}])
   
  





(def state-1
  (rx/atom [{:x 50 :y 50 :width 50 :height 50}]))


(defn svg2 [state]
  (fn [state]
    (let [recs @state]
      (into 
       [:svg 
        {:height 500
         :style {:border "1px solid black"}
         :on-click #(do 
                     #_(js/alert (e->xy %))
                     (swap! state conj (get-pos %)))
         :width 500}]
       (for [{:keys [x y width height]} recs]
         [:rect
          {:x x
           :y y
           :width width
           :height height
           :fill :blue}])))))


(defcard-rg svg2s
  [svg2 state-1]
  state-1
  {:inspect-data true})
          


(defn add-square [state e]
  (let [[x y] (get-pos e)]
    (swap! state conj {:x x :y y :width 50 :height 100})))


(defn svg3 [state]
  (fn [state]
    (let [recs @state]
      (into 
       [:svg#board 
        {:height 500
         :style {:border "1px solid black"}
         :on-click #(add-square state %)
         :width 500}]
       (for [{:keys [x y width height]} recs]
         [:rect
          {:x x
           :y y
           :width width
           :height height
           :fill :blue}])))))


(defcard-rg svg33
  [svg3 state-1]
  state-1
  {:inspect-data true
   :history true})

(defn getBounding2 [parent]
  (let [p (js/document.getElementById parent)]
    ((juxt #(.-left %) #(.-top %)) (. p getBoundingClientRect))))



(defn add-square2 [state e parentID]
  (let [[x y] (mapv - (e->xy e) (getBounding2 parentID))]
    (swap! state conj {:x x :y y :width 50 :height 100})))


(defn svg4 [state]
  (fn [state]
    (let [recs @state]
      (into 
       [:svg#board2 
        {:height 500
         :style {:border "1px solid black"}
         :on-click #(add-square2 state % "board2")
         :width 500}]
       (for [{:keys [x y width height]} recs]
         [:rect
          {:x x
           :y y
           :width width
           :height height
           :fill :blue}])))))




(defcard-rg svg44
  [svg4 state-1]
  state-1
  {:inspect-data true
   :history true})



















(defn merge- [a b]
  (merge-with - a b))

(defn start-position1 [evt atom]
  (do 
    (prn "motion: "(.-clientX evt)(.-clientY evt)
    (swap! atom assoc :start (merge- {:x (.-clientX evt) :y (.-clientY evt)} (:state @atom)))  
    (prn @atom))))

;;; important stuff

(defn change-position [evt atom]
  (let [x (.-clientX evt)
        y (.-clientY evt)
        diff (merge-with - {:x x :y y} (:start @atom))]
  (do 
    (prn "motion: difference" diff)
    (swap! atom assoc :state diff)  
    (prn @atom))))

(defn log-position [evt]
  (prn "motion: "(.-clientX evt)(.-clientY evt)))



(defonce position1 (rx/atom {:state {:x 1 :y 1} :rwidth 200 :rheight 100 :moving false :start {:x 1 :y 1}}))

(defonce position2 (rx/atom @position1))

(defn newboard1 [posatom fo]
  (let [position posatom]
    (fn []
      (let [dw (:rwidth @position)
            dh (:rheight @position)
            dx (get-in @position [:state :x])
            dy (get-in @position [:state :y])]
         [:g 
          { :width 100
            :height 100

            :transform (str "matrix(1 0 0 1 0 ""0"")")
            :on-mouse-down #(do (swap! position assoc :moving true)
                                (start-position1 % position))
            :on-mouse-up #(do (swap! position assoc :moving false)
                                (log-position %))
            :on-mouse-leave #(do (swap! position assoc :moving false))
            :on-mouse-move #(do (if (:moving @position)
                                      (change-position % position))) } 


            [:rect
              {:width dw
                :height dh
                :x (* 0.5 dx)
                :y (* 0.75 dy)
                :fill "blue"}]

            [:rect
              {:width dw 
                :height dh
                :x (+ 10 dx)
                :y (+ 10 dy)
                :fill "grey"}]
            [:foreignObject 
              {:width dw 
               :height dw
               :x (+ (/ dw 3) dx)
               :y (+ (/ dh 2) dy) 
              }
              fo]

            [:line
              {
                :stroke "green"
                :stroke-width 20
                :stroke-linecap "round"
                :x1 (+ 100 dx)
                :y1 (+ 10 dy)
                :x2 (* 0.5 (+ 0 dx ))
                :y2 (* 0.75 (+ 0 dy))}]
            [:line
              {
                :stroke "white"
                :stroke-width 4
                :stroke-linecap "round"
                :x1 (+ 10 dx)
                :y1 (+ 10 dy)
                :x2 (* 0.5 (+ 0 dx ))
                :y2 (* 0.75 (+ 0 dy))}]
            [:line
              {
                :stroke "black"
                :stroke-width 4
                :stroke-linecap "round"
                :x1 (+ 10 dx)
                :y1 (+ dh 10 dy)
                :x2 (+ 2 (* 0.5 (+ 0 dx )))
                :y2 (+ dh -2 (* 0.75 dy))}]]))))
    

(def s1
(rx/atom {:state {:x 0 :y 0} 
			  :start {:x 0 :y 0}
			  :moving false }))


(defn patom [sx sy] 
	(rx/atom {:state {:x sx :y sy} 
			  :start {:x 0 :y 0}
			  :moving false }))


(defn fo [posatom fo]
  (let [position posatom]
    (fn []
      (let [
            dx (get-in @position [:state :x])
            dy (get-in @position [:state :y])]
         [:g 
          { 
          

            :on-mouse-down #(do (swap! position assoc :moving true)
                                (start-position1 % position))
            :on-mouse-up #(do (swap! position assoc :moving false)
                                (log-position %))
            :on-mouse-leave #(do (swap! position assoc :moving false))
            :on-mouse-move #(do (if (:moving @position)
                                      (change-position % position))) } 

            [:foreignObject 
              {:width 1000
              	:height 1000
               :x dx
               :y dy
              }
              #_(if (:moving @position)
              	[s/icon {:soda {:icon :spinner
              					:state :loading}}])
              fo
              ]]))))


(defcard-rg hey
[:button {:on-click #(do 
                       (swap! position2 assoc-in [:state :x] 250)
                       (js/alert (str "hello " (pr-str (:x (get @position2 :state))))))} "Hey"]
position2
{:inspect-data true})


(defcard-rg next-step-adding-svg1*
  "Motion using groups"
  [:svg 
  	{:height 500
  	 :width 500}
    [newboard1 position1 [:button {:on-click #(js/alert "Hello SVG")} "Hellllooo"]]

    [newboard1 position2 [:button {:on-click #(js/alert "Hello VG")} "looo"]]

    [fo s1 [:div 
    		[:h1 "This is a grand statement"]]]
    ]
  position2
  {:inspect-data true
   :history true}
  )

(defn icon-s [itype]
  (fn []
  #_[s/icon {:soda {:icon itype
                  :size :small}}]))

(defn seg-raised [inner]
  #_[s/segment {:soda {:type :raised}} 
  inner])






(defn assumption-layout1 []
 (fn []
  #_[s/segments {}
    [seg-raised [:h3 "Assumptions  "]]
    [seg-raised "This is deeply nested"]
    [seg-raised "This is also nested"]
    ]))

(defn layout []
	[:svg 
		{:height 3000
		 :width 3000
		 }
		 [fo position1 assumption-layout1]
		 [fo position2 assumption-layout1]]

	)



(defcard-rg layout-testing
	[assumption-layout1])



(defonce position3 (rx/atom @position1))
(defonce p4 (patom 200 200))
(defonce p5 (rx/atom (merge {:state {:x 200 :y 20}} @p4)))






(defn layout-testing2 []
	[:svg
	{:width 900
	 :height 1900} 
	[fo position1 [:div {:style {:maxWidth 400}}
		[:h1 "Assumptions"] 
		#_[s/segments {}
	    [seg-raised "First Assumption"]
	    [seg-raised "This is deeply nested"]
	    [seg-raised "This is also nested"]]]]
	[fo position2 
		[:div {:style {:maxWidth 700}}  
			#_[s/header {:soda {:tag :h1
							  :aligned :center
							  :state :disabled}} 
							  "Test"
			[s/label {:soda {:type :floating}}
				"Boom"]]
			#_[s/segments {:soda {:horizontal? true}}
		    [seg-raised "First Assumption"]
		    [seg-raised "This is deeply nested"]
		    [seg-raised "This is also nested"]]]]
	[fo p4
		[:div {:style {:maxWidth 200}}  
			[:h1 "Tools"] 
			#_[s/segments {}
		    [seg-raised "First Assumption"]
		    [seg-raised "This is deeply nested"]
		    [seg-raised "This is also nested"]]]]

	[fo p5
		[:div {:style {:maxWidth 200}}  
			[:h1 "plaintext"] 
			#_[s/segments {}
		    [seg-raised "Firs Assumpion"]
		    [seg-raised "This is deeply nested"]
		    [seg-raised "This is also nested"]]]]
	[fo position3
		[:div {:style {:maxWidth 400}} 
			[:h1 "Tools"] 
			#_[s/segments {}
		    [s/segment {:soda {:type :default}}



				"#Initial assumptions 

				---------------


					Questions

				###Any question that can be asked can be phrased in many ways

				+	Each way of phrasing the question may bring to mind many possible answers

				###Every question has a number of implicit assumptions built into it

				+	####The validity of those assumptions will affect the following
					1.	Whether the question can be answered
					2.	How the answers to the question will affect other questions/answers
						+ Particularly the parent question

				###	For every question you can ask, there is another question for which this question is a possible answer
				+	Every question is also the answer to another question
				+	This might be called the parent question
				+	You might say one question flows from the other


				### The root question from which all action flows is this:  _How should I spend my time?_

				+	alternatively phrased:  _What should I do now?_


				---------------

					Answering Questions

				### To answer any question a mind performs certain actions
				1.	 It lists the possible answers it knows of


				2.	 It determines what factors will be applied 

					filtering factors

				These factors will determine
				+	If an answer is a possible one
				+	How the answer should be weighted 
					+	Relative to other answers
					+	Relative to the criteria for success


				Each weighting factor is an assumption

				The applicability of a weighting factor to the question is an assumption

				Weighing factors/tests can be thought of as filters
				+	These filters could be positive or negative
					+	Example
						+	An answer to this question should ....
						+	An answer to this question should not ...


				When a mind finds that no available answers will pass the filters 
				+	It asks new questions which it hopes will provide a larger set of possible answers that can be tested against the filters

				The filters can be thought of as questions
				+	Therefore:	

				### You consider the answer to any larger question to be the intersection of the sets of all the answers to the sub-questions that are relevant ot the question

				"

		    ]]]]])

(defcard-rg layout-card
	[layout-testing2]
	position1
	{:inspect-data true})