From c61e30165457373f6f64a9bfbb3f8dea6205a3b1 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Sun, 4 Oct 2020 14:14:08 +0200 Subject: [PATCH 01/14] Store only one value per region --- src/vlaaad/reveal/layout.clj | 11 +++++++++-- src/vlaaad/reveal/output_panel.clj | 6 +++--- src/vlaaad/reveal/stream.clj | 24 ++++++++++++++++-------- 3 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index a77f366..4f417d8 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -11,7 +11,14 @@ (set! *warn-on-reflection* true) -(s/def ::values (s/coll-of any? :kind vector?)) +(s/def :vlaaad.reveal.annotated-value/value any?) +(s/def :vlaaad.reveal.annotated-value/annotation map?) + +(s/def ::annotated-value + (s/keys :req-un [:vlaaad.reveal.annotated-value/value + :vlaaad.reveal.annotated-value/annotation])) + +(s/def ::value (s/nilable ::annotated-value)) (s/def ::text string?) @@ -39,7 +46,7 @@ (s/and int? (complement neg?))) (s/def ::region - (s/keys :req-un [::index ::values ::segments])) + (s/keys :req-un [::index ::value ::segments])) (s/def ::line (s/coll-of ::region :kind vector?)) diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index ff12b5d..5bb83cf 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -59,14 +59,14 @@ (let [layout (layout/ensure-cursor-visible (:layout this)) {:keys [lines cursor]} layout region (get-in lines cursor) - values (:values region) + value (:value region) ^Node target (.getTarget event)] (-> this (assoc :layout layout) - (cond-> (pos? (count values)) + (cond-> value (assoc :popup {:bounds (.localToScreen target (layout/cursor->canvas-bounds layout)) :window (.getWindow (.getScene target)) - :annotated-value (peek values)}))))) + :annotated-value value}))))) (defn- show-search [this] (assoc this :search {:term "" :results (sorted-set)})) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index 88b112a..9738429 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -391,17 +391,25 @@ (+ (:index region 0) (segments-length (:segments region)))) -(defn- add-segment [line values segment] +;; this logic should be in format-xf... +;; index = character index + +;; line = regions +;; region = segments +;; region = value+segments+index+selectable +;; selectable is property of a region. regions are split on changes to value and selectable! + +(defn- add-segment [line value segment] (let [last-region (peek line)] - (if (not= (:values last-region) values) - (conj line {:values values :segments [segment] :index (next-index last-region)}) + (if (not (identical? (:value last-region) value)) + (conj line {:value value :segments [segment] :index (next-index last-region)}) (update-in line [(dec (count line)) :segments] conj segment)))) (defn- add-separator [line] (let [last-region (peek line)] (cond-> line last-region - (conj {:values (:values last-region) + (conj {:value (:value last-region) :segments [] :index (next-index last-region)})))) @@ -457,7 +465,7 @@ (let [blocks (:blocks state) block (peek blocks)] (do (vswap! *state assoc :line (-> [] - (add-segment (:values state) (blank-segment (:indent block 0))) + (add-segment (peek (:values state)) (blank-segment (:indent block 0))) add-separator)) (rf acc (:line state)))) @@ -467,14 +475,14 @@ (if (= :horizontal (:block block)) (do (vswap! *state update :line #(-> % add-separator - (add-segment (:values state) (blank-segment 1)) + (add-segment (peek (:values state)) (blank-segment 1)) add-separator)) acc) - (do (vswap! *state update :line add-segment (:values state) (blank-segment 0)) + (do (vswap! *state update :line add-segment (peek (:values state)) (blank-segment 0)) acc))) ::string - (do (vswap! *state update :line add-segment (:values state) (string-segment input)) + (do (vswap! *state update :line add-segment (peek (:values state)) (string-segment input)) acc))))))) (def stream-xf From fe850d31e4d77a4047ffcc111879ccfe9d175f85 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Mon, 5 Oct 2020 21:12:53 +0200 Subject: [PATCH 02/14] Split regions on :selectable, persist it on regions --- src/vlaaad/reveal/layout.clj | 38 ++++++++++++++---------------------- src/vlaaad/reveal/stream.clj | 33 ++++++++++++++++++------------- 2 files changed, 34 insertions(+), 37 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 4f417d8..2cd89f7 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -45,8 +45,10 @@ (s/def ::index (s/and int? (complement neg?))) +(s/def ::selectable boolean?) + (s/def ::region - (s/keys :req-un [::index ::value ::segments])) + (s/keys :req-un [::index ::value ::segments ::selectable])) (s/def ::line (s/coll-of ::region :kind vector?)) @@ -431,18 +433,8 @@ remove-cursor make)) -(defn empty-region? [region] - (every? #(false? (:selectable (:style %) true)) - (:segments region))) - -(def non-empty-region? - (complement empty-region?)) - -(defn empty-line? [line] - (every? empty-region? line)) - -(def non-empty-line? - (complement empty-line?)) +(defn non-empty-line? [line] + (boolean (some :selectable line))) (defn canvas->cursor [layout x y] (let [{:keys [scroll-x scroll-y lines]} layout @@ -461,7 +453,7 @@ [(inc i) x])))) [0 0] (range (count line))))] - (when (and (< index (count line)) (non-empty-region? (line index))) + (when (and (< index (count line)) (:selectable (line index))) [row index]))))) (defn perform-drag [layout ^MouseEvent event] @@ -573,7 +565,7 @@ (< canvas-height (- (* drawn-line-count (font/line-height)) scroll-y-remainder)) dec)] - (if-let [cursor (lines/scan lines [start-row -1] dec inc non-empty-region?)] + (if-let [cursor (lines/scan lines [start-row -1] dec inc :selectable)] (-> layout (set-cursor cursor) ensure-cursor-visible) @@ -584,7 +576,7 @@ start-row (cond-> dropped-line-count (not (zero? scroll-y-remainder)) inc)] - (if-let [cursor (lines/scan lines [start-row -1] inc inc non-empty-region?)] + (if-let [cursor (lines/scan lines [start-row -1] inc inc :selectable)] (-> layout (set-cursor cursor) ensure-cursor-visible) @@ -615,9 +607,9 @@ (if-let [row (lines/scan lines row direction non-empty-line?)] (let [line (lines row) nearest-col (binary-nearest-by :index line align-char-index) - col (or (some #(when (non-empty-region? (line %)) %) + col (or (some #(when (:selectable (line %)) %) (range nearest-col (count line))) - (some #(when (non-empty-region? (line %)) %) + (some #(when (:selectable (line %)) %) (range (dec nearest-col) 0 -1))) cursor [row col]] (-> layout @@ -627,15 +619,15 @@ (defn select-all [layout] (let [{:keys [lines]} layout - from (lines/scan lines [##-Inf ##-Inf] inc inc non-empty-region?) - to (lines/scan lines [##Inf ##Inf] dec dec non-empty-region?)] + from (lines/scan lines [##-Inf ##-Inf] inc inc :selectable) + to (lines/scan lines [##Inf ##Inf] dec dec :selectable)] (cond-> layout (and from to) (set-cursor to :anchor from)))) (defn move-cursor-horizontally [layout with-anchor direction] (let [{:keys [cursor lines]} layout] - (if-let [cursor (lines/scan lines cursor direction direction non-empty-region?)] + (if-let [cursor (lines/scan lines cursor direction direction :selectable)] (-> layout (set-cursor cursor :anchor with-anchor) ensure-cursor-visible) @@ -657,7 +649,7 @@ (let [{:keys [lines cursor]} layout [row col] cursor line (lines row)] - (if-let [new-col (some #(when (non-empty-region? (line %)) %) + (if-let [new-col (some #(when (:selectable (line %)) %) (range (dec (count line)) (dec col) -1))] (let [cursor [row new-col]] (-> layout @@ -669,7 +661,7 @@ (let [{:keys [lines cursor]} layout [row col] cursor line (lines row)] - (if-let [new-col (some #(when (non-empty-region? (line %)) %) (range 0 (inc col)))] + (if-let [new-col (some #(when (:selectable (line %)) %) (range 0 (inc col)))] (let [cursor [row new-col]] (-> layout (set-cursor cursor :anchor with-anchor) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index 9738429..41070d2 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -397,21 +397,26 @@ ;; line = regions ;; region = segments ;; region = value+segments+index+selectable -;; selectable is property of a region. regions are split on changes to value and selectable! +;; selectable is property of a region. regions are split on: +;; - changes to value +;; - changes to selectable +;; - if previous region is marked as complete (by "complete-region") (defn- add-segment [line value segment] - (let [last-region (peek line)] - (if (not (identical? (:value last-region) value)) - (conj line {:value value :segments [segment] :index (next-index last-region)}) + (let [last-region (peek line) + selectable (:selectable (:style segment) true)] + (if (or (not (identical? (:value last-region) value)) + (:complete last-region) + (not= (:selectable last-region) selectable)) + (conj line {:value value + :selectable selectable + :segments [segment] + :index (next-index last-region)}) (update-in line [(dec (count line)) :segments] conj segment)))) -(defn- add-separator [line] - (let [last-region (peek line)] - (cond-> line - last-region - (conj {:value (:value last-region) - :segments [] - :index (next-index last-region)})))) +(defn- complete-region [line] + (let [i (dec (count line))] + (cond-> line (not= i -1) (update i assoc :complete true)))) (defn- line-length [line] (next-index (peek line))) @@ -466,7 +471,7 @@ block (peek blocks)] (do (vswap! *state assoc :line (-> [] (add-segment (peek (:values state)) (blank-segment (:indent block 0))) - add-separator)) + complete-region)) (rf acc (:line state)))) ::separator @@ -474,9 +479,9 @@ block (peek blocks)] (if (= :horizontal (:block block)) (do (vswap! *state update :line #(-> % - add-separator + complete-region (add-segment (peek (:values state)) (blank-segment 1)) - add-separator)) + complete-region)) acc) (do (vswap! *state update :line add-segment (peek (:values state)) (blank-segment 0)) acc))) From b33293caf28d4d9da2ca197140406c363615cf50 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Tue, 6 Oct 2020 23:14:48 +0200 Subject: [PATCH 03/14] Split add-segment to selectable and non-selectable --- src/vlaaad/reveal/stream.clj | 52 +++++++++++++++++------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index 41070d2..dbc9e4c 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -375,8 +375,9 @@ value)) (defn- blank-segment [n] - {:text (apply str (repeat n \space)) - :style {:selectable false}}) + (let [sb (StringBuilder.)] + (dotimes [_ n] (.append sb \space)) + {:text (.toString sb)})) (defn- string-segment [string-op] (dissoc string-op :op)) @@ -402,27 +403,30 @@ ;; - changes to selectable ;; - if previous region is marked as complete (by "complete-region") -(defn- add-segment [line value segment] +(defn- add-non-selectable-segment [line segment] + (let [last-region (peek line)] + (if (:selectable last-region true) + (conj line {:selectable false :segments [segment] :index (next-index last-region)}) + (update-in line [(dec (count line)) :segments] conj segment)))) + +(defn- add-selectable-segment [line values segment] (let [last-region (peek line) - selectable (:selectable (:style segment) true)] + value (peek values)] (if (or (not (identical? (:value last-region) value)) - (:complete last-region) - (not= (:selectable last-region) selectable)) + (not (:selectable last-region false))) (conj line {:value value - :selectable selectable + :selectable true :segments [segment] - :index (next-index last-region)}) + :index (next-index last-region) + :nav {:depth (max 0 (dec (count values)))}}) (update-in line [(dec (count line)) :segments] conj segment)))) -(defn- complete-region [line] - (let [i (dec (count line))] - (cond-> line (not= i -1) (update i assoc :complete true)))) - (defn- line-length [line] (next-index (peek line))) (defn- format-xf [rf] - (let [*state (volatile! {:line [] :values [] :blocks []})] + (let [*state (volatile! {:line [] :blocks []}) + *values (volatile! [])] (fn ([] (rf)) ([acc] (rf acc)) @@ -430,12 +434,10 @@ (let [state @*state] (case (:op input) ::push-value - (do (vswap! *state update :values conj (:value input)) - acc) + (do (vswap! *values conj (:value input)) acc) ::pop-value - (do (vswap! *state update :values pop) - acc) + (do (vswap! *values pop) acc) ::push-block (let [blocks (:blocks state) @@ -469,25 +471,21 @@ ::newline (let [blocks (:blocks state) block (peek blocks)] - (do (vswap! *state assoc :line (-> [] - (add-segment (peek (:values state)) (blank-segment (:indent block 0))) - complete-region)) + (do (vswap! *state assoc :line (add-non-selectable-segment [] (blank-segment (:indent block 0)))) (rf acc (:line state)))) ::separator (let [blocks (:blocks state) block (peek blocks)] (if (= :horizontal (:block block)) - (do (vswap! *state update :line #(-> % - complete-region - (add-segment (peek (:values state)) (blank-segment 1)) - complete-region)) + (do (vswap! *state update :line add-non-selectable-segment (blank-segment 1)) acc) - (do (vswap! *state update :line add-segment (peek (:values state)) (blank-segment 0)) - acc))) + acc)) ::string - (do (vswap! *state update :line add-segment (peek (:values state)) (string-segment input)) + (do (if (:selectable (:style input) true) + (vswap! *state update :line add-selectable-segment @*values (string-segment input)) + (vswap! *state update :line add-non-selectable-segment (string-segment input))) acc))))))) (def stream-xf From 6d2ff17fbfc3af3a2fbcc83956ef43945fd89554 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Tue, 6 Oct 2020 23:32:38 +0200 Subject: [PATCH 04/14] Split format-xf state --- src/vlaaad/reveal/stream.clj | 52 +++++++++++++++--------------------- 1 file changed, 21 insertions(+), 31 deletions(-) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index dbc9e4c..13616ff 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -425,13 +425,14 @@ (next-index (peek line))) (defn- format-xf [rf] - (let [*state (volatile! {:line [] :blocks []}) - *values (volatile! [])] + (let [*values (volatile! []) + *line (volatile! []) + *blocks (volatile! [])] (fn ([] (rf)) ([acc] (rf acc)) ([acc input] - (let [state @*state] + (let [line @*line] (case (:op input) ::push-value (do (vswap! *values conj (:value input)) acc) @@ -440,52 +441,41 @@ (do (vswap! *values pop) acc) ::push-block - (let [blocks (:blocks state) - block (peek blocks)] + (let [block (peek @*blocks)] (case (:block block) :vertical - (do (vswap! *state update :blocks conj {:block (:block input) - :indent (:indent block)}) + (do (vswap! *blocks conj {:block (:block input) :indent (:indent block)}) acc) :horizontal - (do (vswap! *state update :blocks conj {:block (:block input) - :indent (line-length (:line state))}) + (do (vswap! *blocks conj {:block (:block input) :indent (line-length line)}) acc) nil - (do (vswap! *state update :blocks conj {:block (:block input) - :indent 0}) + (do (vswap! *blocks conj {:block (:block input) + :indent 0}) acc))) ::pop-block - (let [blocks (:blocks state)] - (if (= 1 (count blocks)) - (do (vreset! *state (-> state - (assoc :blocks (pop blocks)) - (assoc :line []))) - (rf acc (:line state))) - (do (vreset! *state (assoc state :blocks (pop blocks))) - acc))) + (if (= 1 (count @*blocks)) + (do (vswap! *blocks pop) + (vreset! *line []) + (rf acc line)) + (do (vswap! *blocks pop) acc)) ::newline - (let [blocks (:blocks state) - block (peek blocks)] - (do (vswap! *state assoc :line (add-non-selectable-segment [] (blank-segment (:indent block 0)))) - (rf acc (:line state)))) + (do (vreset! *line (add-non-selectable-segment [] (blank-segment (:indent (peek @*blocks) 0)))) + (rf acc line)) ::separator - (let [blocks (:blocks state) - block (peek blocks)] - (if (= :horizontal (:block block)) - (do (vswap! *state update :line add-non-selectable-segment (blank-segment 1)) - acc) - acc)) + (if (= :horizontal (:block (peek @*blocks))) + (do (vswap! *line add-non-selectable-segment (blank-segment 1)) acc) + acc) ::string (do (if (:selectable (:style input) true) - (vswap! *state update :line add-selectable-segment @*values (string-segment input)) - (vswap! *state update :line add-non-selectable-segment (string-segment input))) + (vswap! *line add-selectable-segment @*values (string-segment input)) + (vswap! *line add-non-selectable-segment (string-segment input))) acc))))))) (def stream-xf From 34fd7a4f71c288edf4066e42a7098584753df017 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Wed, 7 Oct 2020 23:09:24 +0200 Subject: [PATCH 05/14] Implement value starts --- src/vlaaad/reveal/stream.clj | 52 +++++++++++++++++++++++++++++------- 1 file changed, 43 insertions(+), 9 deletions(-) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index 13616ff..cab392b 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -409,23 +409,53 @@ (conj line {:selectable false :segments [segment] :index (next-index last-region)}) (update-in line [(dec (count line)) :segments] conj segment)))) -(defn- add-selectable-segment [line values segment] +(defn- add-selectable-segment [line values *value-starts segment] (let [last-region (peek line) value (peek values)] (if (or (not (identical? (:value last-region) value)) (not (:selectable last-region false))) - (conj line {:value value - :selectable true - :segments [segment] - :index (next-index last-region) - :nav {:depth (max 0 (dec (count values)))}}) + (let [value-starts @*value-starts + start (peek value-starts)] + (when start + (vreset! *value-starts (assoc value-starts (dec (count value-starts)) false))) + (conj line {:value value + :selectable true + :segments [segment] + :index (next-index last-region) + :nav {:depth (max 0 (dec (count values))) + :start-value start}})) (update-in line [(dec (count line)) :segments] conj segment)))) + +(comment + ((emit-xf conj) [] {:a 1 :b 2}) + + (->> {:a 1 :b 2} + ((stream-xf conj) []) + (mapv (fn [x] (mapv #(-> % + (dissoc :value :index) + (update :segments (fn [segments] + (->> segments + (map :text) + (clojure.string/join))))) + x)))) + + ((stream-xf conj) [] (as-is + (horizontal + (raw-string "tap>") + separator + (stream {:a 1 :b [2]})))) + + nil) + +;; start-row?.. + (defn- line-length [line] (next-index (peek line))) (defn- format-xf [rf] (let [*values (volatile! []) + *value-starts (volatile! [false]) *line (volatile! []) *blocks (volatile! [])] (fn @@ -435,10 +465,14 @@ (let [line @*line] (case (:op input) ::push-value - (do (vswap! *values conj (:value input)) acc) + (do (vswap! *values conj (:value input)) + (vswap! *value-starts conj true) + acc) ::pop-value - (do (vswap! *values pop) acc) + (do (vswap! *values pop) + (vswap! *value-starts pop) + acc) ::push-block (let [block (peek @*blocks)] @@ -474,7 +508,7 @@ ::string (do (if (:selectable (:style input) true) - (vswap! *line add-selectable-segment @*values (string-segment input)) + (vswap! *line add-selectable-segment @*values *value-starts (string-segment input)) (vswap! *line add-non-selectable-segment (string-segment input))) acc))))))) From 336aabe928b28ce2dff36635b6c0cd2dab6ab2ca Mon Sep 17 00:00:00 2001 From: vlaaad Date: Sat, 10 Oct 2020 11:45:15 +0200 Subject: [PATCH 06/14] Add row-starts to structural nav information --- src/vlaaad/reveal/stream.clj | 82 +++++++++++++++++++----------------- 1 file changed, 44 insertions(+), 38 deletions(-) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index cab392b..c286c40 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -392,16 +392,8 @@ (+ (:index region 0) (segments-length (:segments region)))) -;; this logic should be in format-xf... -;; index = character index - -;; line = regions -;; region = segments -;; region = value+segments+index+selectable -;; selectable is property of a region. regions are split on: -;; - changes to value -;; - changes to selectable -;; - if previous region is marked as complete (by "complete-region") +(defn- set-last [xs x] + (assoc xs (dec (count xs)) x)) (defn- add-non-selectable-segment [line segment] (let [last-region (peek line)] @@ -409,28 +401,37 @@ (conj line {:selectable false :segments [segment] :index (next-index last-region)}) (update-in line [(dec (count line)) :segments] conj segment)))) -(defn- add-selectable-segment [line values *value-starts segment] +(defn- add-selectable-segment [line values *value-starts *row-starts segment] (let [last-region (peek line) value (peek values)] (if (or (not (identical? (:value last-region) value)) (not (:selectable last-region false))) (let [value-starts @*value-starts - start (peek value-starts)] - (when start - (vreset! *value-starts (assoc value-starts (dec (count value-starts)) false))) + value-start (peek value-starts) + row-starts @*row-starts + row-start (and (some? value) + (peek row-starts))] + (when row-start + (vswap! *row-starts set-last false)) + (when value-start + (vswap! *value-starts set-last false)) (conj line {:value value :selectable true :segments [segment] :index (next-index last-region) :nav {:depth (max 0 (dec (count values))) - :start-value start}})) + :start-value value-start + :start-row row-start}})) (update-in line [(dec (count line)) :segments] conj segment)))) - (comment ((emit-xf conj) [] {:a 1 :b 2}) - (->> {:a 1 :b 2} + (->> (as-is + (horizontal + (raw-string "tap>") + separator + (stream {:a 1 :b 2}))) ((stream-xf conj) []) (mapv (fn [x] (mapv #(-> % (dissoc :value :index) @@ -444,7 +445,11 @@ (horizontal (raw-string "tap>") separator - (stream {:a 1 :b [2]})))) + (stream {:a 1 :b 2})))) + + (require 'criterium.core) + (criterium.core/quick-bench + ((stream-xf (constantly nil)) nil user/interesting-values)) nil) @@ -456,6 +461,7 @@ (defn- format-xf [rf] (let [*values (volatile! []) *value-starts (volatile! [false]) + *row-starts (volatile! [true]) *line (volatile! []) *blocks (volatile! [])] (fn @@ -475,30 +481,30 @@ acc) ::push-block - (let [block (peek @*blocks)] - (case (:block block) - :vertical - (do (vswap! *blocks conj {:block (:block input) :indent (:indent block)}) - acc) - - :horizontal - (do (vswap! *blocks conj {:block (:block input) :indent (line-length line)}) - acc) - - nil - (do (vswap! *blocks conj {:block (:block input) - :indent 0}) - acc))) + (let [block (:block input) + parent (peek @*blocks)] + (when (= :vertical block) + (vswap! *row-starts conj true)) + (case (:block parent) + :vertical (vswap! *blocks conj {:block block :indent (:indent parent)}) + :horizontal (vswap! *blocks conj {:block block :indent (line-length line)}) + nil (vswap! *blocks conj {:block block :indent 0})) + acc) ::pop-block - (if (= 1 (count @*blocks)) - (do (vswap! *blocks pop) - (vreset! *line []) - (rf acc line)) - (do (vswap! *blocks pop) acc)) + (let [blocks @*blocks] + (when (= :vertical (:block (peek blocks))) + (vswap! *row-starts pop)) + (if (= 1 (count blocks)) + (do (vreset! *blocks (pop blocks)) + (vreset! *line []) + (rf acc line)) + (do (vswap! *blocks pop) acc))) ::newline (do (vreset! *line (add-non-selectable-segment [] (blank-segment (:indent (peek @*blocks) 0)))) + (when (= :vertical (:block (peek @*blocks))) + (vswap! *row-starts set-last true)) (rf acc line)) ::separator @@ -508,7 +514,7 @@ ::string (do (if (:selectable (:style input) true) - (vswap! *line add-selectable-segment @*values *value-starts (string-segment input)) + (vswap! *line add-selectable-segment @*values *value-starts *row-starts (string-segment input)) (vswap! *line add-non-selectable-segment (string-segment input))) acc))))))) From 7d16c08858f6b079b83b14bfbdab7c10319f3df8 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Mon, 19 Oct 2020 14:36:55 +0200 Subject: [PATCH 07/14] Add structural navigation --- src/vlaaad/reveal/layout.clj | 165 ++++++++++++++++++++++------- src/vlaaad/reveal/nav.clj | 73 +++++++++++++ src/vlaaad/reveal/output_panel.clj | 7 +- src/vlaaad/reveal/stream.clj | 26 +++-- 4 files changed, 220 insertions(+), 51 deletions(-) create mode 100644 src/vlaaad/reveal/nav.clj diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 2cd89f7..7d48d7c 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -1,5 +1,6 @@ (ns vlaaad.reveal.layout (:require [vlaaad.reveal.font :as font] + [vlaaad.reveal.nav :as nav] [cljfx.coerce :as fx.coerce] [vlaaad.reveal.cursor :as cursor] [vlaaad.reveal.style :as style] @@ -373,25 +374,6 @@ (update :scroll-y + dy) make)) -(defn- arrow-scroll [layout size-key] - (let [line-height (font/line-height)] - (* line-height - (-> 5 - (min (Math/ceil (* 0.1 (/ (get layout size-key) line-height)))) - (max 1))))) - -(defn arrow-scroll-left [layout] - (make (update layout :scroll-x + (arrow-scroll layout :canvas-width)))) - -(defn arrow-scroll-right [layout] - (make (update layout :scroll-x - (arrow-scroll layout :canvas-width)))) - -(defn arrow-scroll-up [layout] - (make (update layout :scroll-y + (arrow-scroll layout :canvas-height)))) - -(defn arrow-scroll-down [layout] - (make (update layout :scroll-y - (arrow-scroll layout :canvas-height)))) - (defn- page-scroll [layout] (let [{:keys [canvas-height]} layout line-height (font/line-height)] @@ -416,8 +398,39 @@ (defn scroll-to-right [layout] (make (assoc layout :scroll-x ##-Inf))) +(defn- add-lines-with-nav [layout lines] + (let [start-y (count (:lines layout))] + (-> layout + (update :lines into lines) + (update :nav + (fn [nav] + (reduce-kv + (fn [nav y line] + (reduce-kv + (fn [nav x region] + (if (:selectable region) + (let [{:keys [ids start-row]} (:nav region) + ids (if (= ids []) + (let [ids (nav/latest-ids nav)] + (if (= ids []) + [-1] + ids)) + ids) + id (peek ids) + parent-ids (pop ids)] + (-> nav + (nav/ensure-parents parent-ids) + (cond-> (not (nav/has? nav id)) + ((if start-row nav/add-row nav/add-col) (peek parent-ids) id)) + (nav/add-cursor id [(+ start-y y) x]))) + nav)) + nav + line)) + nav + lines)))))) + (defn add-lines [layout lines] - (let [layout (update layout :lines into lines) + (let [layout (add-lines-with-nav layout lines) should-scroll (if (:autoscroll layout true) (scrolled-to-bottom? layout) (and (scrolled-to-bottom? layout) @@ -429,7 +442,7 @@ (defn clear-lines [layout] (-> layout - (assoc :lines []) + (assoc :lines [] :nav nil) remove-cursor make)) @@ -549,6 +562,89 @@ :width (region-width (line col)) :height line-height}))) +(defn- clamped-nth [xs i] + (xs (clamp i 0 (dec (count xs))))) + +(defn- start-cursor [nav cursor] + (let [id (nav/id nav cursor) + start-cursor (nav/cursor nav id)] + (when-not (= start-cursor cursor) + start-cursor))) + +(defn- grid-movement-cursor [nav cursor row-direction col-direction] + (let [id (nav/id nav cursor) + parent-id (nav/parent nav id) + [row col] (nav/coordinate nav id) + target-id (-> (nav/grid nav parent-id) + (clamped-nth (row-direction row)) + (clamped-nth (col-direction col)))] + (when-not (= id target-id) + (nav/cursor nav target-id)))) + +(defn- next-line-cursor [nav cursor] + (let [id (nav/id nav cursor) + parent-id (nav/parent nav id) + parent-grid (nav/grid nav parent-id) + row ((nav/coordinate nav id) 0)] + (when (< row (dec (count (nav/grid nav parent-id)))) + (nav/cursor nav ((parent-grid (inc row)) 0))))) + +(defn- out-cursor [nav cursor] + (loop [id (nav/id nav cursor)] + (let [parent-id (nav/parent nav id)] + (and parent-id + (or (nav/cursor nav parent-id) + (recur parent-id)))))) + +(defn- in-cursor [nav cursor] + (loop [id (nav/id nav cursor)] + (let [child-id (ffirst (nav/grid nav id))] + (and child-id + (or (nav/cursor nav child-id) + (recur child-id)))))) + +(defn- change-maybe-cursor [maybe-cursor layout with-anchor] + (if maybe-cursor + (-> layout + (set-cursor maybe-cursor :anchor with-anchor) + ensure-cursor-visible) + layout)) + +(defn nav-cursor-up [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (change-maybe-cursor + (or (start-cursor nav cursor) + (grid-movement-cursor nav cursor dec identity) + (out-cursor nav cursor)) + layout + with-anchor))) + +(defn nav-cursor-left [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (change-maybe-cursor + (or (start-cursor nav cursor) + (grid-movement-cursor nav cursor identity dec) + (out-cursor nav cursor)) + layout + with-anchor))) + +(defn nav-cursor-down [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (change-maybe-cursor + (or (grid-movement-cursor nav cursor inc identity) + (in-cursor nav cursor)) + layout + with-anchor))) + +(defn nav-cursor-right [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (change-maybe-cursor + (or (grid-movement-cursor nav cursor identity inc) + (in-cursor nav cursor) + (next-line-cursor nav cursor)) + layout + with-anchor))) + (defn cursor->canvas-bounds ^Bounds [layout] (let [{:keys [lines cursor scroll-x scroll-y]} layout [row col] cursor @@ -565,22 +661,20 @@ (< canvas-height (- (* drawn-line-count (font/line-height)) scroll-y-remainder)) dec)] - (if-let [cursor (lines/scan lines [start-row -1] dec inc :selectable)] - (-> layout - (set-cursor cursor) - ensure-cursor-visible) - layout))) + (change-maybe-cursor + (lines/scan lines [start-row -1] dec inc :selectable) + layout + true))) (defn introduce-cursor-at-top-of-screen [layout] (let [{:keys [dropped-line-count lines scroll-y-remainder]} layout start-row (cond-> dropped-line-count (not (zero? scroll-y-remainder)) inc)] - (if-let [cursor (lines/scan lines [start-row -1] inc inc :selectable)] - (-> layout - (set-cursor cursor) - ensure-cursor-visible) - layout))) + (change-maybe-cursor + (lines/scan lines [start-row -1] inc inc :selectable) + layout + true))) (defn- binary-nearest-by [f xs x] (let [last-i (dec (count xs))] @@ -627,11 +721,10 @@ (defn move-cursor-horizontally [layout with-anchor direction] (let [{:keys [cursor lines]} layout] - (if-let [cursor (lines/scan lines cursor direction direction :selectable)] - (-> layout - (set-cursor cursor :anchor with-anchor) - ensure-cursor-visible) - layout))) + (change-maybe-cursor + (lines/scan lines cursor direction direction :selectable) + layout + with-anchor))) (defn cursor-to-start-of-selection [layout] (let [start (cursor/min (:cursor layout) (:anchor layout))] diff --git a/src/vlaaad/reveal/nav.clj b/src/vlaaad/reveal/nav.clj new file mode 100644 index 0000000..5e20e9e --- /dev/null +++ b/src/vlaaad/reveal/nav.clj @@ -0,0 +1,73 @@ +(ns vlaaad.reveal.nav) + +(def ^:private vec-conj (fnil conj [])) + +(defn- grid-conj [grid node] + (let [n (count grid)] + (if (zero? n) + (vec-conj grid [node]) + (update grid (dec n) conj node)))) + +(defn- last-coordinate [grid] + [(dec (count grid)) (dec (count (peek grid)))]) + +(defn add-row [nav parent id] + (let [grid (-> nav + ::id->grid + (get parent) + (vec-conj [id]))] + (-> nav + (assoc-in [::id->grid parent] grid) + (assoc-in [::id->coordinate id] (last-coordinate grid)) + (assoc-in [::id->parent id] parent)))) + +(defn add-col [nav parent id] + (let [grid (-> nav + ::id->grid + (get parent) + (grid-conj id))] + (-> nav + (assoc-in [::id->grid parent] grid) + (assoc-in [::id->coordinate id] (last-coordinate grid)) + (assoc-in [::id->parent id] parent)))) + +(defn add-cursor [nav id cursor] + (-> nav + (update-in [::id->cursor id] #(or % cursor)) + (assoc-in [::cursor->id cursor] id))) + +(defn ensure-parents [nav parent-ids] + (loop [nav nav + ids parent-ids] + (let [id (peek ids)] + (if (or (nil? id) (contains? (::id->parent nav) id)) + nav + (let [ids (pop ids) + parent (peek ids)] + (recur (add-row nav parent id) ids)))))) + +(defn latest-ids [nav] + (loop [acc [] + id nil] + (if-let [grid (get-in nav [::id->grid id])] + (let [id (get-in grid (last-coordinate grid))] + (recur (conj acc id) id)) + acc))) + +(defn has? [nav id] + (contains? (::id->parent nav) id)) + +(defn cursor [nav id] + (get-in nav [::id->cursor id])) + +(defn coordinate [nav id] + (get-in nav [::id->coordinate id])) + +(defn parent [nav id] + (get-in nav [::id->parent id])) + +(defn id [nav cursor] + (get-in nav [::cursor->id cursor])) + +(defn grid [nav id] + (get-in nav [::id->grid id])) diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index 5bb83cf..4524774 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -101,6 +101,7 @@ (defn- handle-key-pressed [this ^KeyEvent event] (let [code (.getCode event) shortcut (.isShortcutDown event) + alt (.isAltDown event) with-anchor (not (.isShiftDown event)) layout (:layout this) {:keys [cursor anchor]} layout] @@ -117,6 +118,7 @@ :layout (cond shortcut layout + (and alt cursor) (layout/nav-cursor-up layout with-anchor) (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-start-of-selection layout) :else (layout/move-cursor-vertically layout with-anchor dec)))) @@ -128,6 +130,7 @@ :layout (cond shortcut layout + (and alt cursor) (layout/nav-cursor-down layout with-anchor) (not cursor) (layout/introduce-cursor-at-top-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-end-of-selection layout) :else (layout/move-cursor-vertically layout with-anchor inc)))) @@ -137,6 +140,7 @@ :layout (cond shortcut layout + (and alt cursor) (layout/nav-cursor-left layout with-anchor) (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-start-of-selection layout) :else (layout/move-cursor-horizontally layout with-anchor dec))) @@ -146,6 +150,7 @@ :layout (cond shortcut layout + (and alt cursor) (layout/nav-cursor-right layout with-anchor) (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-end-of-selection layout) :else (layout/move-cursor-horizontally layout with-anchor inc))) @@ -200,7 +205,7 @@ (show-search this) KeyCode/F - (cond-> this (.isShortcutDown event) show-search) + (cond-> this shortcut show-search) this))) diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index c286c40..58e6b8f 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -401,26 +401,20 @@ (conj line {:selectable false :segments [segment] :index (next-index last-region)}) (update-in line [(dec (count line)) :segments] conj segment)))) -(defn- add-selectable-segment [line values *value-starts *row-starts segment] - (let [last-region (peek line) - value (peek values)] +(defn- add-selectable-segment [line value ids *row-starts segment] + (let [last-region (peek line)] (if (or (not (identical? (:value last-region) value)) (not (:selectable last-region false))) - (let [value-starts @*value-starts - value-start (peek value-starts) - row-starts @*row-starts + (let [row-starts @*row-starts row-start (and (some? value) (peek row-starts))] (when row-start (vswap! *row-starts set-last false)) - (when value-start - (vswap! *value-starts set-last false)) (conj line {:value value :selectable true :segments [segment] :index (next-index last-region) - :nav {:depth (max 0 (dec (count values))) - :start-value value-start + :nav {:ids ids :start-row row-start}})) (update-in line [(dec (count line)) :segments] conj segment)))) @@ -458,9 +452,13 @@ (defn- line-length [line] (next-index (peek line))) +(defonce ^:private *id (atom 0)) + +(defn- next-id [] (swap! *id inc)) + (defn- format-xf [rf] (let [*values (volatile! []) - *value-starts (volatile! [false]) + *ids (volatile! []) *row-starts (volatile! [true]) *line (volatile! []) *blocks (volatile! [])] @@ -472,12 +470,12 @@ (case (:op input) ::push-value (do (vswap! *values conj (:value input)) - (vswap! *value-starts conj true) + (vswap! *ids conj (next-id)) acc) ::pop-value (do (vswap! *values pop) - (vswap! *value-starts pop) + (vswap! *ids pop) acc) ::push-block @@ -514,7 +512,7 @@ ::string (do (if (:selectable (:style input) true) - (vswap! *line add-selectable-segment @*values *value-starts *row-starts (string-segment input)) + (vswap! *line add-selectable-segment (peek @*values) @*ids *row-starts (string-segment input)) (vswap! *line add-non-selectable-segment (string-segment input))) acc))))))) From 0f5702bea8f0f3c49d15686d3105260e9bbeb1e8 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Wed, 21 Oct 2020 10:12:53 +0200 Subject: [PATCH 08/14] Improve cursor persistence and controls --- src/vlaaad/reveal/layout.clj | 239 ++++++++++++++--------------- src/vlaaad/reveal/nav.clj | 16 +- src/vlaaad/reveal/output_panel.clj | 10 +- 3 files changed, 129 insertions(+), 136 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 7d48d7c..0d64c86 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -349,21 +349,59 @@ (defn scrolled-to-top? [layout] (zero? (:scroll-y layout))) +(defn- adjust-scroll [scroll canvas-size region-start region-size] + (let [canvas-start (- scroll) + region-end (+ region-start region-size) + canvas-end (+ canvas-start canvas-size) + start (if (> region-end canvas-end) + (- region-start (- region-end canvas-end)) + region-start) + start (if (< start canvas-start) + (+ start (- canvas-start start)) + start)] + (- scroll (- region-start start)))) + +(defn ensure-rect-visible [layout {:keys [x y width height]}] + (let [{:keys [canvas-width canvas-height]} layout] + (-> layout + (update :scroll-y adjust-scroll canvas-height y height) + (update :scroll-x adjust-scroll canvas-width x width) + make))) + +(defn ensure-cursor-visible [layout] + (let [{:keys [lines cursor]} layout + [row col] cursor + line (lines row) + line-height (font/line-height)] + (ensure-rect-visible layout + {:x (transduce (map region-width) + (subvec line 0 col)) + :y (* line-height (cursor/row cursor)) + :width (region-width (line col)) + :height line-height}))) + (defn set-cursor "Set cursor - `:anchor` - either true/false, or specific cursor value - - `:align` - whether should update align char index used for vertical navigation" - [layout cursor & {:keys [anchor align] + - `:align` - whether should update align char index used for vertical navigation + - `:ensure-visible` - whether to scroll the view to ensure cursor is visible" + [layout cursor & {:keys [anchor align ensure-visible] :or {anchor true - align true}}] - (-> layout - (assoc :cursor cursor) - (cond-> (or align (nil? (:align-char-index layout))) - (assoc :align-char-index (:index (get-in (:lines layout) cursor))) + align true + ensure-visible true}}] + (if cursor + (-> layout + (assoc :cursor cursor) + (cond-> + (or align (nil? (:align-char-index layout))) + (assoc :align-char-index (:index (get-in (:lines layout) cursor))) - (or anchor (nil? (:anchor layout))) - (assoc :anchor (if (cursor/cursor? anchor) anchor cursor))))) + (or anchor (nil? (:anchor layout))) + (assoc :anchor (if (cursor/cursor? anchor) anchor cursor)) + + ensure-visible + ensure-cursor-visible)) + layout)) (defn remove-cursor [layout] (dissoc layout :cursor :anchor :align-char-index)) @@ -374,18 +412,6 @@ (update :scroll-y + dy) make)) -(defn- page-scroll [layout] - (let [{:keys [canvas-height]} layout - line-height (font/line-height)] - (* line-height - (max 1 (Math/ceil (* 0.5 (/ canvas-height line-height))))))) - -(defn page-scroll-up [layout] - (make (update layout :scroll-y + (page-scroll layout)))) - -(defn page-scroll-down [layout] - (make (update layout :scroll-y - (page-scroll layout)))) - (defn scroll-to-top [layout] (make (assoc layout :scroll-y 0))) @@ -483,11 +509,8 @@ (-> layout :scroll-tab-y :scroll-per-pixel)))) make) :selection - (if-let [cursor (canvas->cursor layout (.getX event) (.getY event))] - (-> layout - (set-cursor cursor :anchor false)) - layout) - + (set-cursor layout (canvas->cursor layout (.getX event) (.getY event)) + :anchor false :ensure-visible false) layout) layout)) @@ -532,36 +555,6 @@ (assoc :focused focused) (cond-> (not focused) stop-gesture))) -(defn- adjust-scroll [scroll canvas-size region-start region-size] - (let [canvas-start (- scroll) - region-end (+ region-start region-size) - canvas-end (+ canvas-start canvas-size) - start (if (> region-end canvas-end) - (- region-start (- region-end canvas-end)) - region-start) - start (if (< start canvas-start) - (+ start (- canvas-start start)) - start)] - (- scroll (- region-start start)))) - -(defn ensure-rect-visible [layout {:keys [x y width height]}] - (let [{:keys [canvas-width canvas-height]} layout] - (-> layout - (update :scroll-y adjust-scroll canvas-height y height) - (update :scroll-x adjust-scroll canvas-width x width) - make))) - -(defn ensure-cursor-visible [layout] - (let [{:keys [lines cursor]} layout - [row col] cursor - line (lines row) - line-height (font/line-height)] - (ensure-rect-visible layout - {:x (transduce (map region-width) + (subvec line 0 col)) - :y (* line-height (cursor/row cursor)) - :width (region-width (line col)) - :height line-height}))) - (defn- clamped-nth [xs i] (xs (clamp i 0 (dec (count xs))))) @@ -603,47 +596,32 @@ (or (nav/cursor nav child-id) (recur child-id)))))) -(defn- change-maybe-cursor [maybe-cursor layout with-anchor] - (if maybe-cursor - (-> layout - (set-cursor maybe-cursor :anchor with-anchor) - ensure-cursor-visible) - layout)) - (defn nav-cursor-up [layout with-anchor] (let [{:keys [cursor nav]} layout] - (change-maybe-cursor - (or (start-cursor nav cursor) - (grid-movement-cursor nav cursor dec identity) - (out-cursor nav cursor)) - layout - with-anchor))) + (set-cursor layout (or (start-cursor nav cursor) + (grid-movement-cursor nav cursor dec identity) + (out-cursor nav cursor)) + :anchor with-anchor))) (defn nav-cursor-left [layout with-anchor] (let [{:keys [cursor nav]} layout] - (change-maybe-cursor - (or (start-cursor nav cursor) - (grid-movement-cursor nav cursor identity dec) - (out-cursor nav cursor)) - layout - with-anchor))) + (set-cursor layout (or (start-cursor nav cursor) + (grid-movement-cursor nav cursor identity dec) + (out-cursor nav cursor)) + :anchor with-anchor))) (defn nav-cursor-down [layout with-anchor] (let [{:keys [cursor nav]} layout] - (change-maybe-cursor - (or (grid-movement-cursor nav cursor inc identity) - (in-cursor nav cursor)) - layout - with-anchor))) + (set-cursor layout (or (grid-movement-cursor nav cursor inc identity) + (in-cursor nav cursor)) + :anchor with-anchor))) (defn nav-cursor-right [layout with-anchor] (let [{:keys [cursor nav]} layout] - (change-maybe-cursor - (or (grid-movement-cursor nav cursor identity inc) - (in-cursor nav cursor) - (next-line-cursor nav cursor)) - layout - with-anchor))) + (set-cursor layout (or (grid-movement-cursor nav cursor identity inc) + (in-cursor nav cursor) + (next-line-cursor nav cursor)) + :anchor with-anchor))) (defn cursor->canvas-bounds ^Bounds [layout] (let [{:keys [lines cursor scroll-x scroll-y]} layout @@ -661,20 +639,14 @@ (< canvas-height (- (* drawn-line-count (font/line-height)) scroll-y-remainder)) dec)] - (change-maybe-cursor - (lines/scan lines [start-row -1] dec inc :selectable) - layout - true))) + (set-cursor layout (lines/scan lines [start-row -1] dec inc :selectable)))) (defn introduce-cursor-at-top-of-screen [layout] (let [{:keys [dropped-line-count lines scroll-y-remainder]} layout start-row (cond-> dropped-line-count (not (zero? scroll-y-remainder)) inc)] - (change-maybe-cursor - (lines/scan lines [start-row -1] inc inc :selectable) - layout - true))) + (set-cursor layout (lines/scan lines [start-row -1] inc inc :selectable)))) (defn- binary-nearest-by [f xs x] (let [last-i (dec (count xs))] @@ -695,21 +667,52 @@ :else (recur (inc i) high))))))) -(defn move-cursor-vertically [layout with-anchor direction] - (let [{:keys [cursor lines align-char-index]} layout - row (cursor/row cursor)] - (if-let [row (lines/scan lines row direction non-empty-line?)] +(defn- vertical-move-cursor [layout row direction] + (let [{:keys [lines align-char-index]} layout] + (when-let [row (lines/scan lines row direction non-empty-line?)] (let [line (lines row) nearest-col (binary-nearest-by :index line align-char-index) col (or (some #(when (:selectable (line %)) %) (range nearest-col (count line))) (some #(when (:selectable (line %)) %) - (range (dec nearest-col) 0 -1))) - cursor [row col]] - (-> layout - (set-cursor cursor :anchor with-anchor :align false) - ensure-cursor-visible)) - layout))) + (range (dec nearest-col) 0 -1)))] + [row col])))) + +(defn move-cursor-vertically [layout with-anchor direction] + (let [{:keys [cursor]} layout + row (cursor/row cursor)] + (set-cursor layout (vertical-move-cursor layout row direction) + :anchor with-anchor + :align false))) + +(defn move-cursor-home [layout with-anchor] + (let [{:keys [lines]} layout] + (set-cursor layout (lines/scan lines [##-Inf ##-Inf] inc inc :selectable) + :anchor with-anchor))) + +(defn move-cursor-end [layout with-anchor] + (let [{:keys [lines]} layout] + (set-cursor layout (lines/scan lines [##Inf ##Inf] dec dec :selectable) + :anchor with-anchor))) + +(defn move-by-page [layout direction with-anchor] + (let [{:keys [canvas-height cursor]} layout + line-height (font/line-height) + row-delta (* (direction 0) + (int (* 0.75 (/ canvas-height line-height)))) + row (cursor/row cursor) + new-cursor (vertical-move-cursor layout (+ row row-delta) direction)] + (cond + new-cursor + (-> layout + (scroll-by 0 (* line-height (- row (cursor/row new-cursor)))) + (set-cursor new-cursor :anchor with-anchor :align false)) + + (= inc direction) + (move-cursor-end layout with-anchor) + + :else + (move-cursor-home layout with-anchor)))) (defn select-all [layout] (let [{:keys [lines]} layout @@ -721,22 +724,13 @@ (defn move-cursor-horizontally [layout with-anchor direction] (let [{:keys [cursor lines]} layout] - (change-maybe-cursor - (lines/scan lines cursor direction direction :selectable) - layout - with-anchor))) + (set-cursor layout (lines/scan lines cursor direction direction :selectable) :anchor with-anchor))) (defn cursor-to-start-of-selection [layout] - (let [start (cursor/min (:cursor layout) (:anchor layout))] - (-> layout - (set-cursor start) - ensure-cursor-visible))) + (set-cursor layout (cursor/min (:cursor layout) (:anchor layout)))) (defn cursor-to-end-of-selection [layout] - (let [end (cursor/max (:cursor layout) (:anchor layout))] - (-> layout - (set-cursor end) - ensure-cursor-visible))) + (set-cursor layout (cursor/max (:cursor layout) (:anchor layout)))) (defn cursor-to-end-of-line [layout with-anchor] (let [{:keys [lines cursor]} layout @@ -744,10 +738,7 @@ line (lines row)] (if-let [new-col (some #(when (:selectable (line %)) %) (range (dec (count line)) (dec col) -1))] - (let [cursor [row new-col]] - (-> layout - (set-cursor cursor :anchor with-anchor) - ensure-cursor-visible)) + (set-cursor layout [row new-col] :anchor with-anchor) layout))) (defn cursor-to-beginning-of-line [layout with-anchor] @@ -755,12 +746,12 @@ [row col] cursor line (lines row)] (if-let [new-col (some #(when (:selectable (line %)) %) (range 0 (inc col)))] - (let [cursor [row new-col]] - (-> layout - (set-cursor cursor :anchor with-anchor) - ensure-cursor-visible)) + (set-cursor layout [row new-col] :anchor with-anchor) layout))) +(defn reset-anchor [layout] + (set-cursor layout (:cursor layout))) + (defn- string-builder ([] (StringBuilder.)) ([^StringBuilder ret] (.toString ret)) diff --git a/src/vlaaad/reveal/nav.clj b/src/vlaaad/reveal/nav.clj index 5e20e9e..7fba57c 100644 --- a/src/vlaaad/reveal/nav.clj +++ b/src/vlaaad/reveal/nav.clj @@ -34,7 +34,8 @@ (defn add-cursor [nav id cursor] (-> nav (update-in [::id->cursor id] #(or % cursor)) - (assoc-in [::cursor->id cursor] id))) + (assoc-in [::cursor->id cursor] id) + (assoc ::latest-id id))) (defn ensure-parents [nav parent-ids] (loop [nav nav @@ -47,12 +48,13 @@ (recur (add-row nav parent id) ids)))))) (defn latest-ids [nav] - (loop [acc [] - id nil] - (if-let [grid (get-in nav [::id->grid id])] - (let [id (get-in grid (last-coordinate grid))] - (recur (conj acc id) id)) - acc))) + (loop [acc nil + id (::latest-id nav)] + (if id + (recur + (conj acc id) + ((::id->parent nav) id)) + (vec acc)))) (defn has? [nav id] (contains? (::id->parent nav) id)) diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index 4524774..151ce13 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -109,7 +109,7 @@ KeyCode/ESCAPE (assoc this :layout - (cond-> layout cursor layout/remove-cursor)) + (cond-> layout cursor layout/reset-anchor)) KeyCode/UP (do @@ -156,10 +156,10 @@ :else (layout/move-cursor-horizontally layout with-anchor inc))) KeyCode/PAGE_UP - (assoc this :layout (layout/page-scroll-up layout)) + (assoc this :layout (layout/move-by-page layout dec with-anchor)) KeyCode/PAGE_DOWN - (assoc this :layout (layout/page-scroll-down layout)) + (assoc this :layout (layout/move-by-page layout inc with-anchor)) KeyCode/HOME (assoc this @@ -167,7 +167,7 @@ (cond shortcut (-> layout layout/scroll-to-top - (cond-> cursor layout/remove-cursor)) + (cond-> cursor (layout/move-cursor-home with-anchor))) (not cursor) (layout/scroll-to-left layout) :else (layout/cursor-to-beginning-of-line layout with-anchor))) @@ -177,7 +177,7 @@ (cond shortcut (-> layout layout/scroll-to-bottom - (cond-> cursor layout/remove-cursor)) + (cond-> cursor (layout/move-cursor-end with-anchor))) (not cursor) (layout/scroll-to-right layout) :else (layout/cursor-to-end-of-line layout with-anchor))) From fe44eaa1f874eb237a4108efaabb6a4985140503 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Wed, 28 Oct 2020 22:49:07 +0100 Subject: [PATCH 09/14] Minor nav improvements --- src/vlaaad/reveal/layout.clj | 3 +-- src/vlaaad/reveal/output_panel.clj | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 0d64c86..93ab3cc 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -599,8 +599,7 @@ (defn nav-cursor-up [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (or (start-cursor nav cursor) - (grid-movement-cursor nav cursor dec identity) - (out-cursor nav cursor)) + (grid-movement-cursor nav cursor dec identity)) :anchor with-anchor))) (defn nav-cursor-left [layout with-anchor] diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index 151ce13..e8d9822 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -156,10 +156,10 @@ :else (layout/move-cursor-horizontally layout with-anchor inc))) KeyCode/PAGE_UP - (assoc this :layout (layout/move-by-page layout dec with-anchor)) + (cond-> this cursor (assoc :layout (layout/move-by-page layout dec with-anchor))) KeyCode/PAGE_DOWN - (assoc this :layout (layout/move-by-page layout inc with-anchor)) + (cond-> this cursor (assoc :layout (layout/move-by-page layout inc with-anchor))) KeyCode/HOME (assoc this From 0b31c9331d202463bd68a98fcb831270839e0429 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Sun, 1 Nov 2020 21:59:06 +0100 Subject: [PATCH 10/14] Add nav autoscroll --- src/vlaaad/reveal/layout.clj | 105 ++++++++++------------------- src/vlaaad/reveal/nav.clj | 45 +++++++++++-- src/vlaaad/reveal/output_panel.clj | 6 +- 3 files changed, 75 insertions(+), 81 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 93ab3cc..3c20ed7 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -341,14 +341,6 @@ (assoc :canvas-height canvas-height) (cond-> (neg? diff) (update :scroll-y + diff)))))) -(defn scrolled-to-bottom? [layout] - (let [{:keys [scroll-y canvas-height document-height]} layout] - (or (< document-height canvas-height) - (= scroll-y (- canvas-height document-height))))) - -(defn scrolled-to-top? [layout] - (zero? (:scroll-y layout))) - (defn- adjust-scroll [scroll canvas-size region-start region-size] (let [canvas-start (- scroll) region-end (+ region-start region-size) @@ -403,9 +395,6 @@ ensure-cursor-visible)) layout)) -(defn remove-cursor [layout] - (dissoc layout :cursor :anchor :align-char-index)) - (defn scroll-by [layout dx dy] (-> layout (update :scroll-x + dx) @@ -424,52 +413,10 @@ (defn scroll-to-right [layout] (make (assoc layout :scroll-x ##-Inf))) -(defn- add-lines-with-nav [layout lines] - (let [start-y (count (:lines layout))] - (-> layout - (update :lines into lines) - (update :nav - (fn [nav] - (reduce-kv - (fn [nav y line] - (reduce-kv - (fn [nav x region] - (if (:selectable region) - (let [{:keys [ids start-row]} (:nav region) - ids (if (= ids []) - (let [ids (nav/latest-ids nav)] - (if (= ids []) - [-1] - ids)) - ids) - id (peek ids) - parent-ids (pop ids)] - (-> nav - (nav/ensure-parents parent-ids) - (cond-> (not (nav/has? nav id)) - ((if start-row nav/add-row nav/add-col) (peek parent-ids) id)) - (nav/add-cursor id [(+ start-y y) x]))) - nav)) - nav - line)) - nav - lines)))))) - -(defn add-lines [layout lines] - (let [layout (add-lines-with-nav layout lines) - should-scroll (if (:autoscroll layout true) - (scrolled-to-bottom? layout) - (and (scrolled-to-bottom? layout) - (not (scrolled-to-top? layout))))] - - (if should-scroll - (scroll-to-bottom layout) - (make layout)))) - (defn clear-lines [layout] (-> layout (assoc :lines [] :nav nil) - remove-cursor + (dissoc :cursor :anchor :align-char-index) make)) (defn non-empty-line? [line] @@ -602,6 +549,16 @@ (grid-movement-cursor nav cursor dec identity)) :anchor with-anchor))) +(defn nav-cursor-home [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (set-cursor layout (grid-movement-cursor nav cursor (constantly 0) identity) + :anchor with-anchor))) + +(defn nav-cursor-end [layout with-anchor] + (let [{:keys [cursor nav]} layout] + (set-cursor layout (grid-movement-cursor nav cursor (constantly ##Inf) identity) + :anchor with-anchor))) + (defn nav-cursor-left [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (or (start-cursor nav cursor) @@ -611,8 +568,7 @@ (defn nav-cursor-down [layout with-anchor] (let [{:keys [cursor nav]} layout] - (set-cursor layout (or (grid-movement-cursor nav cursor inc identity) - (in-cursor nav cursor)) + (set-cursor layout (grid-movement-cursor nav cursor inc identity) :anchor with-anchor))) (defn nav-cursor-right [layout with-anchor] @@ -622,6 +578,28 @@ (next-line-cursor nav cursor)) :anchor with-anchor))) +(defn add-lines [layout lines] + (let [start-y (count (:lines layout)) + with-lines (-> layout + (update :lines into lines) + (update :nav nav/add-lines start-y lines))] + (if (:autoscroll layout true) + (let [nav (:nav with-lines)] + (make + (cond + (not (:cursor layout)) + (set-cursor with-lines (nav/cursor nav (get (peek (nav/grid nav nil)) 0))) + + (and (:cursor layout) (nav/at-last-row? (:nav layout) (:cursor layout))) + (nav-cursor-end with-lines true) + + :else + with-lines))) + (-> with-lines + (cond-> (not (:cursor layout)) + (set-cursor (lines/scan (:lines with-lines) [(dec start-y) -1] inc inc :selectable))) + make)))) + (defn cursor->canvas-bounds ^Bounds [layout] (let [{:keys [lines cursor scroll-x scroll-y]} layout [row col] cursor @@ -632,21 +610,6 @@ (region-width (line col)) line-height))) -(defn introduce-cursor-at-bottom-of-screen [layout] - (let [{:keys [drawn-line-count dropped-line-count lines canvas-height scroll-y-remainder]} layout - start-row (cond-> (dec (+ dropped-line-count drawn-line-count)) - (< canvas-height (- (* drawn-line-count (font/line-height)) - scroll-y-remainder)) - dec)] - (set-cursor layout (lines/scan lines [start-row -1] dec inc :selectable)))) - -(defn introduce-cursor-at-top-of-screen [layout] - (let [{:keys [dropped-line-count lines scroll-y-remainder]} layout - start-row (cond-> dropped-line-count - (not (zero? scroll-y-remainder)) - inc)] - (set-cursor layout (lines/scan lines [start-row -1] inc inc :selectable)))) - (defn- binary-nearest-by [f xs x] (let [last-i (dec (count xs))] (loop [low 0 diff --git a/src/vlaaad/reveal/nav.clj b/src/vlaaad/reveal/nav.clj index 7fba57c..7c0ee94 100644 --- a/src/vlaaad/reveal/nav.clj +++ b/src/vlaaad/reveal/nav.clj @@ -11,7 +11,7 @@ (defn- last-coordinate [grid] [(dec (count grid)) (dec (count (peek grid)))]) -(defn add-row [nav parent id] +(defn- add-row [nav parent id] (let [grid (-> nav ::id->grid (get parent) @@ -21,7 +21,7 @@ (assoc-in [::id->coordinate id] (last-coordinate grid)) (assoc-in [::id->parent id] parent)))) -(defn add-col [nav parent id] +(defn- add-col [nav parent id] (let [grid (-> nav ::id->grid (get parent) @@ -31,13 +31,13 @@ (assoc-in [::id->coordinate id] (last-coordinate grid)) (assoc-in [::id->parent id] parent)))) -(defn add-cursor [nav id cursor] +(defn- add-cursor [nav id cursor] (-> nav (update-in [::id->cursor id] #(or % cursor)) (assoc-in [::cursor->id cursor] id) (assoc ::latest-id id))) -(defn ensure-parents [nav parent-ids] +(defn- ensure-parents [nav parent-ids] (loop [nav nav ids parent-ids] (let [id (peek ids)] @@ -47,7 +47,7 @@ parent (peek ids)] (recur (add-row nav parent id) ids)))))) -(defn latest-ids [nav] +(defn- latest-ids [nav] (loop [acc nil id (::latest-id nav)] (if id @@ -56,7 +56,7 @@ ((::id->parent nav) id)) (vec acc)))) -(defn has? [nav id] +(defn- has? [nav id] (contains? (::id->parent nav) id)) (defn cursor [nav id] @@ -73,3 +73,36 @@ (defn grid [nav id] (get-in nav [::id->grid id])) + +(defn at-last-row? [nav cursor] + (let [id (id nav cursor) + parent (parent nav id) + grid (grid nav parent) + row ((coordinate nav id) 0)] + (= row (dec (count grid))))) + +(defn add-lines [nav start-y lines] + (reduce-kv + (fn [nav y line] + (reduce-kv + (fn [nav x region] + (if (:selectable region) + (let [{:keys [ids start-row]} (:nav region) + ids (if (= ids []) + (let [ids (latest-ids nav)] + (if (= ids []) + [-1] + ids)) + ids) + id (peek ids) + parent-ids (pop ids)] + (-> nav + (ensure-parents parent-ids) + (cond-> (not (has? nav id)) + ((if start-row add-row add-col) (peek parent-ids) id)) + (add-cursor id [(+ start-y y) x]))) + nav)) + nav + line)) + nav + lines)) diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index e8d9822..68d0d7b 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -119,7 +119,6 @@ (cond shortcut layout (and alt cursor) (layout/nav-cursor-up layout with-anchor) - (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-start-of-selection layout) :else (layout/move-cursor-vertically layout with-anchor dec)))) @@ -131,7 +130,6 @@ (cond shortcut layout (and alt cursor) (layout/nav-cursor-down layout with-anchor) - (not cursor) (layout/introduce-cursor-at-top-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-end-of-selection layout) :else (layout/move-cursor-vertically layout with-anchor inc)))) @@ -141,7 +139,6 @@ (cond shortcut layout (and alt cursor) (layout/nav-cursor-left layout with-anchor) - (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-start-of-selection layout) :else (layout/move-cursor-horizontally layout with-anchor dec))) @@ -151,7 +148,6 @@ (cond shortcut layout (and alt cursor) (layout/nav-cursor-right layout with-anchor) - (not cursor) (layout/introduce-cursor-at-bottom-of-screen layout) (and with-anchor (not= cursor anchor)) (layout/cursor-to-end-of-selection layout) :else (layout/move-cursor-horizontally layout with-anchor inc))) @@ -168,6 +164,7 @@ shortcut (-> layout layout/scroll-to-top (cond-> cursor (layout/move-cursor-home with-anchor))) + (and alt cursor) (layout/nav-cursor-home layout with-anchor) (not cursor) (layout/scroll-to-left layout) :else (layout/cursor-to-beginning-of-line layout with-anchor))) @@ -178,6 +175,7 @@ shortcut (-> layout layout/scroll-to-bottom (cond-> cursor (layout/move-cursor-end with-anchor))) + (and alt cursor) (layout/nav-cursor-end layout with-anchor) (not cursor) (layout/scroll-to-right layout) :else (layout/cursor-to-end-of-line layout with-anchor))) From 47b3ac4deb2a92a0dfa59316c9d4dec2f3962af7 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Tue, 3 Nov 2020 21:15:27 +0100 Subject: [PATCH 11/14] Improve nav performance --- dev/user.clj | 8 ++- src/vlaaad/reveal/nav.clj | 135 ++++++++++++++++------------------- src/vlaaad/reveal/stream.clj | 29 -------- 3 files changed, 69 insertions(+), 103 deletions(-) diff --git a/dev/user.clj b/dev/user.clj index 20b78fb..464d853 100644 --- a/dev/user.clj +++ b/dev/user.clj @@ -52,5 +52,9 @@ :local-date-time (LocalDateTime/ofEpochSecond 0 0 ZoneOffset/UTC)}}) (comment - (->> (range 10000) - (map #(hash-map :index % :string (str %))))) \ No newline at end of file + (->> (range 100000) + (map #(hash-map :index % :string (str %)))) + + (repeat 1000 {:boolean true + :integer 100 + :string "woop"})) \ No newline at end of file diff --git a/src/vlaaad/reveal/nav.clj b/src/vlaaad/reveal/nav.clj index 7c0ee94..42a43e0 100644 --- a/src/vlaaad/reveal/nav.clj +++ b/src/vlaaad/reveal/nav.clj @@ -11,54 +11,6 @@ (defn- last-coordinate [grid] [(dec (count grid)) (dec (count (peek grid)))]) -(defn- add-row [nav parent id] - (let [grid (-> nav - ::id->grid - (get parent) - (vec-conj [id]))] - (-> nav - (assoc-in [::id->grid parent] grid) - (assoc-in [::id->coordinate id] (last-coordinate grid)) - (assoc-in [::id->parent id] parent)))) - -(defn- add-col [nav parent id] - (let [grid (-> nav - ::id->grid - (get parent) - (grid-conj id))] - (-> nav - (assoc-in [::id->grid parent] grid) - (assoc-in [::id->coordinate id] (last-coordinate grid)) - (assoc-in [::id->parent id] parent)))) - -(defn- add-cursor [nav id cursor] - (-> nav - (update-in [::id->cursor id] #(or % cursor)) - (assoc-in [::cursor->id cursor] id) - (assoc ::latest-id id))) - -(defn- ensure-parents [nav parent-ids] - (loop [nav nav - ids parent-ids] - (let [id (peek ids)] - (if (or (nil? id) (contains? (::id->parent nav) id)) - nav - (let [ids (pop ids) - parent (peek ids)] - (recur (add-row nav parent id) ids)))))) - -(defn- latest-ids [nav] - (loop [acc nil - id (::latest-id nav)] - (if id - (recur - (conj acc id) - ((::id->parent nav) id)) - (vec acc)))) - -(defn- has? [nav id] - (contains? (::id->parent nav) id)) - (defn cursor [nav id] (get-in nav [::id->cursor id])) @@ -82,27 +34,66 @@ (= row (dec (count grid))))) (defn add-lines [nav start-y lines] - (reduce-kv - (fn [nav y line] - (reduce-kv - (fn [nav x region] - (if (:selectable region) - (let [{:keys [ids start-row]} (:nav region) - ids (if (= ids []) - (let [ids (latest-ids nav)] - (if (= ids []) - [-1] - ids)) - ids) - id (peek ids) - parent-ids (pop ids)] - (-> nav - (ensure-parents parent-ids) - (cond-> (not (has? nav id)) - ((if start-row add-row add-col) (peek parent-ids) id)) - (add-cursor id [(+ start-y y) x]))) - nav)) - nav - line)) - nav - lines)) + (let [id->grid (volatile! (transient (::id->grid nav {}))) + id->coordinate (volatile! (transient (::id->coordinate nav {}))) + id->parent (volatile! (transient (::id->parent nav {}))) + id->cursor (volatile! (transient (::id->cursor nav {}))) + cursor->id (volatile! (transient (::cursor->id nav {}))) + latest-id (volatile! (::latest-id nav)) + latest-ids! (fn [] + (loop [acc nil + id @latest-id] + (if id + (recur (conj acc id) (@id->parent id)) + (vec acc)))) + add-row! (fn [parent id] + (let [grid (-> @id->grid (get parent) (vec-conj [id]))] + (vswap! id->grid assoc! parent grid) + (vswap! id->coordinate assoc! id (last-coordinate grid)) + (vswap! id->parent assoc! id parent))) + ensure-parents! (fn [parent-ids] + (loop [ids parent-ids] + (let [id (peek ids)] + (if (or (nil? id) (contains? @id->parent id)) + nil + (let [ids (pop ids)] + (add-row! (peek ids) id) + (recur ids)))))) + add-col! (fn [parent id] + (let [grid (-> @id->grid (get parent) (grid-conj id))] + (vswap! id->grid assoc! parent grid) + (vswap! id->coordinate assoc! id (last-coordinate grid)) + (vswap! id->parent assoc! id parent))) + add-cursor! (fn [id cursor] + (when-not (@id->cursor id) + (vswap! id->cursor assoc! id cursor)) + (vswap! cursor->id assoc! cursor id) + (vreset! latest-id id))] + (reduce-kv + (fn [_ y line] + (reduce-kv + (fn [_ x region] + (when (:selectable region) + (let [{:keys [ids start-row]} (:nav region) + ids (if (= ids []) + (let [ids (latest-ids!)] + (if (= ids []) + [-1] + ids)) + ids) + id (peek ids) + parent-ids (pop ids)] + (ensure-parents! parent-ids) + (when-not (contains? @id->parent id) + ((if start-row add-row! add-col!) (peek parent-ids) id)) + (add-cursor! id [(+ start-y y) x])))) + nil + line)) + nil + lines) + {::id->grid (persistent! @id->grid) + ::id->coordinate (persistent! @id->coordinate) + ::id->parent (persistent! @id->parent) + ::id->cursor (persistent! @id->cursor) + ::cursor->id (persistent! @cursor->id) + ::latest-id @latest-id})) \ No newline at end of file diff --git a/src/vlaaad/reveal/stream.clj b/src/vlaaad/reveal/stream.clj index 58e6b8f..deac2ad 100644 --- a/src/vlaaad/reveal/stream.clj +++ b/src/vlaaad/reveal/stream.clj @@ -418,35 +418,6 @@ :start-row row-start}})) (update-in line [(dec (count line)) :segments] conj segment)))) -(comment - ((emit-xf conj) [] {:a 1 :b 2}) - - (->> (as-is - (horizontal - (raw-string "tap>") - separator - (stream {:a 1 :b 2}))) - ((stream-xf conj) []) - (mapv (fn [x] (mapv #(-> % - (dissoc :value :index) - (update :segments (fn [segments] - (->> segments - (map :text) - (clojure.string/join))))) - x)))) - - ((stream-xf conj) [] (as-is - (horizontal - (raw-string "tap>") - separator - (stream {:a 1 :b 2})))) - - (require 'criterium.core) - (criterium.core/quick-bench - ((stream-xf (constantly nil)) nil user/interesting-values)) - - nil) - ;; start-row?.. (defn- line-length [line] From 9c34cbc901b06b205c591bf6f265d4ea2f1b17fb Mon Sep 17 00:00:00 2001 From: vlaaad Date: Thu, 5 Nov 2020 19:39:21 +0100 Subject: [PATCH 12/14] Add scroll adjusting to nav --- src/vlaaad/reveal/layout.clj | 44 ++++++++++++++++++++---------- src/vlaaad/reveal/nav.clj | 30 ++++++++++++++++---- src/vlaaad/reveal/output_panel.clj | 2 +- 3 files changed, 54 insertions(+), 22 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 3c20ed7..42a80b0 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -360,7 +360,7 @@ (update :scroll-x adjust-scroll canvas-width x width) make))) -(defn ensure-cursor-visible [layout] +(defn ensure-cursor-visible [layout mode] (let [{:keys [lines cursor]} layout [row col] cursor line (lines row) @@ -369,18 +369,24 @@ {:x (transduce (map region-width) + (subvec line 0 col)) :y (* line-height (cursor/row cursor)) :width (region-width (line col)) - :height line-height}))) + :height (case mode + :text line-height + :nav (-> (nav/last-row (:nav layout) cursor) + (- row) + inc + (* line-height) + (+ scroll-bar-breadth)))}))) (defn set-cursor "Set cursor - `:anchor` - either true/false, or specific cursor value - `:align` - whether should update align char index used for vertical navigation - - `:ensure-visible` - whether to scroll the view to ensure cursor is visible" - [layout cursor & {:keys [anchor align ensure-visible] + - `:scroll` - :text, :nav or false - whether and how to adjust the scroll of the view" + [layout cursor & {:keys [anchor align scroll] :or {anchor true align true - ensure-visible true}}] + scroll :text}}] (if cursor (-> layout (assoc :cursor cursor) @@ -391,8 +397,8 @@ (or anchor (nil? (:anchor layout))) (assoc :anchor (if (cursor/cursor? anchor) anchor cursor)) - ensure-visible - ensure-cursor-visible)) + scroll + (ensure-cursor-visible scroll))) layout)) (defn scroll-by [layout dx dy] @@ -457,7 +463,8 @@ make) :selection (set-cursor layout (canvas->cursor layout (.getX event) (.getY event)) - :anchor false :ensure-visible false) + :anchor false + :scroll false) layout) layout)) @@ -547,36 +554,42 @@ (let [{:keys [cursor nav]} layout] (set-cursor layout (or (start-cursor nav cursor) (grid-movement-cursor nav cursor dec identity)) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn nav-cursor-home [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (grid-movement-cursor nav cursor (constantly 0) identity) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn nav-cursor-end [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (grid-movement-cursor nav cursor (constantly ##Inf) identity) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn nav-cursor-left [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (or (start-cursor nav cursor) (grid-movement-cursor nav cursor identity dec) (out-cursor nav cursor)) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn nav-cursor-down [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (grid-movement-cursor nav cursor inc identity) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn nav-cursor-right [layout with-anchor] (let [{:keys [cursor nav]} layout] (set-cursor layout (or (grid-movement-cursor nav cursor identity inc) (in-cursor nav cursor) (next-line-cursor nav cursor)) - :anchor with-anchor))) + :anchor with-anchor + :scroll :nav))) (defn add-lines [layout lines] (let [start-y (count (:lines layout)) @@ -588,7 +601,8 @@ (make (cond (not (:cursor layout)) - (set-cursor with-lines (nav/cursor nav (get (peek (nav/grid nav nil)) 0))) + (set-cursor with-lines (nav/cursor nav (get (peek (nav/grid nav nil)) 0)) + :scroll :nav) (and (:cursor layout) (nav/at-last-row? (:nav layout) (:cursor layout))) (nav-cursor-end with-lines true) diff --git a/src/vlaaad/reveal/nav.clj b/src/vlaaad/reveal/nav.clj index 42a43e0..4bb8571 100644 --- a/src/vlaaad/reveal/nav.clj +++ b/src/vlaaad/reveal/nav.clj @@ -12,7 +12,7 @@ [(dec (count grid)) (dec (count (peek grid)))]) (defn cursor [nav id] - (get-in nav [::id->cursor id])) + (get-in nav [::id->first-cursor id])) (defn coordinate [nav id] (get-in nav [::id->coordinate id])) @@ -37,7 +37,8 @@ (let [id->grid (volatile! (transient (::id->grid nav {}))) id->coordinate (volatile! (transient (::id->coordinate nav {}))) id->parent (volatile! (transient (::id->parent nav {}))) - id->cursor (volatile! (transient (::id->cursor nav {}))) + id->first-cursor (volatile! (transient (::id->first-cursor nav {}))) + id->last-cursor (volatile! (transient (::id->last-cursor nav {}))) cursor->id (volatile! (transient (::cursor->id nav {}))) latest-id (volatile! (::latest-id nav)) latest-ids! (fn [] @@ -65,8 +66,9 @@ (vswap! id->coordinate assoc! id (last-coordinate grid)) (vswap! id->parent assoc! id parent))) add-cursor! (fn [id cursor] - (when-not (@id->cursor id) - (vswap! id->cursor assoc! id cursor)) + (when-not (@id->first-cursor id) + (vswap! id->first-cursor assoc! id cursor)) + (vswap! id->last-cursor assoc! id cursor) (vswap! cursor->id assoc! cursor id) (vreset! latest-id id))] (reduce-kv @@ -94,6 +96,22 @@ {::id->grid (persistent! @id->grid) ::id->coordinate (persistent! @id->coordinate) ::id->parent (persistent! @id->parent) - ::id->cursor (persistent! @id->cursor) + ::id->first-cursor (persistent! @id->first-cursor) + ::id->last-cursor (persistent! @id->last-cursor) ::cursor->id (persistent! @cursor->id) - ::latest-id @latest-id})) \ No newline at end of file + ::latest-id @latest-id})) + +(defn last-row [nav cursor] + (let [{::keys [cursor->id id->coordinate id->parent id->grid id->last-cursor]} nav + id (cursor->id cursor) + row ((id->coordinate id) 0) + parent-id (id->parent id) + target-id (peek ((id->grid parent-id) row))] + ((fn search [id] + (let [self-cursor (id->last-cursor id) + self-grid (id->grid id) + child-row (when self-grid (-> self-grid peek peek search))] + (if (and self-cursor child-row) + (max (self-cursor 0) child-row) + (or child-row (self-cursor 0))))) + target-id))) \ No newline at end of file diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index 68d0d7b..c15b691 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -56,7 +56,7 @@ #(update-in % [id :layout] layout/perform-drag event)) (defn- show-popup [this ^Event event] - (let [layout (layout/ensure-cursor-visible (:layout this)) + (let [layout (layout/ensure-cursor-visible (:layout this) :text) {:keys [lines cursor]} layout region (get-in lines cursor) value (:value region) From 5cc5d9d89afebf6546bf28ef3b2a9ecc4259d4b1 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Thu, 5 Nov 2020 22:01:06 +0100 Subject: [PATCH 13/14] Prevent selecting non-selectable values --- src/vlaaad/reveal/layout.clj | 5 +++++ src/vlaaad/reveal/output_panel.clj | 8 ++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/vlaaad/reveal/layout.clj b/src/vlaaad/reveal/layout.clj index 42a80b0..6bcc79e 100644 --- a/src/vlaaad/reveal/layout.clj +++ b/src/vlaaad/reveal/layout.clj @@ -698,6 +698,11 @@ (and from to) (set-cursor to :anchor from)))) +(defn select-nearest [layout [row col]] + (let [{:keys [lines]} layout + cursor (lines/scan lines [row (dec col)] inc inc :selectable)] + (cond-> layout cursor (set-cursor cursor)))) + (defn move-cursor-horizontally [layout with-anchor direction] (let [{:keys [cursor lines]} layout] (set-cursor layout (lines/scan lines cursor direction direction :selectable) :anchor with-anchor))) diff --git a/src/vlaaad/reveal/output_panel.clj b/src/vlaaad/reveal/output_panel.clj index c15b691..fc02199 100644 --- a/src/vlaaad/reveal/output_panel.clj +++ b/src/vlaaad/reveal/output_panel.clj @@ -240,11 +240,11 @@ (result->rect highlight (-> this :search :term))))) (defn- select-highlight [this] - (let [result (-> this :search :highlight)] + (let [cursor (-> this :search :highlight first)] (-> this - hide-search - (cond-> result - (update :layout layout/set-cursor (first result)))))) + hide-search + (cond-> cursor + (update :layout layout/select-nearest cursor))))) (defn- jump-to-prev-match [{:keys [search] :as this}] (let [highlight (:highlight search) From 614f4cbe4897e4b407b0849bf404960966f8dfd3 Mon Sep 17 00:00:00 2001 From: vlaaad Date: Thu, 5 Nov 2020 22:06:13 +0100 Subject: [PATCH 14/14] Improve versioning in build script --- build/version.clj | 4 ++-- release.ps1 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/build/version.clj b/build/version.clj index 0d5d5c8..efc378d 100644 --- a/build/version.clj +++ b/build/version.clj @@ -26,11 +26,11 @@ (recur tags parent (zip/right child))) (zip/append-child parent replace-node)))))) -(defn -main [& version] +(defn -main [version hash] (with-open [reader (io/reader "pom.xml")] (let [xml (-> reader (xml/parse :skip-whitespace true) (xml-update [::pom/version] (xml/sexp-as-element [::pom/version version])) - (xml-update [::pom/scm ::pom/tag] (xml/sexp-as-element [::pom/tag version])))] + (xml-update [::pom/scm ::pom/tag] (xml/sexp-as-element [::pom/tag hash])))] (with-open [writer (io/writer "pom.xml")] (xml/indent xml writer))))) \ No newline at end of file diff --git a/release.ps1 b/release.ps1 index b742e4a..fe3249b 100644 --- a/release.ps1 +++ b/release.ps1 @@ -9,14 +9,14 @@ if (!((invoke git rev-parse --abbrev-ref HEAD) -eq "master")) { } $version = "1.0.$(invoke git rev-list HEAD --count)" -clj -A:build -m version $version +clj -A:build -M -m version $version $(invoke git rev-parse HEAD) clj -Spom invoke git commit -am "Release $version" invoke git tag $version invoke git push invoke git push origin $version clj -A:depstar "$version.jar" -clj -A:build -m deploy "$version.jar" (Read-Host -Prompt "Username") (Read-Host -Prompt "Token" -AsSecureString | ConvertFrom-SecureString -AsPlainText) +clj -A:build -M -m deploy "$version.jar" (Read-Host -Prompt "Username") (Read-Host -Prompt "Token" -AsSecureString | ConvertFrom-SecureString -AsPlainText) rm "$version.jar"