diff --git a/src/Scratch/31 - VirtualTree/TreeView/TreeView.css b/src/Scratch/31 - VirtualTree/TreeView/TreeView.css index 1b33482c..1b3f3220 100644 --- a/src/Scratch/31 - VirtualTree/TreeView/TreeView.css +++ b/src/Scratch/31 - VirtualTree/TreeView/TreeView.css @@ -1,20 +1,15 @@ .treeview .hovered.item:not(.selected) { - background-color: rgba(255.0,255.0,255.0,0.10); + background-color: rgba(255,255,255,0.15); font-weight: normal; } -.treeview .selected.item:not(.hovered) { - background-color: rgba(255.0,255.0,255.0,0.20); - font-weight: bold; -} - -.treeview .hovered.selected.item { - background-color: rgba(255.0,255.0,255.0,0.15); - font-weight: bold; +.treeview .highlighted.item:not(.selected) { + background-color: rgba(255,255,255,0.05); + font-weight: normal; } -.treeview .parent.item { - background-color: rgb(33, 96, 15); +.treeview .selected.item { + background-color: rgba(255,255,255,0.20); font-weight: bold; } diff --git a/src/Scratch/31 - VirtualTree/TreeView/TreeViewApp.fs b/src/Scratch/31 - VirtualTree/TreeView/TreeViewApp.fs index b9c9bb1b..46d36829 100644 --- a/src/Scratch/31 - VirtualTree/TreeView/TreeViewApp.fs +++ b/src/Scratch/31 - VirtualTree/TreeView/TreeViewApp.fs @@ -23,6 +23,15 @@ module TreeView = state + [] + module private Events = + + let disablePropagation event = + sprintf "$('#__ID__').on('%s', function(e) { e.stopPropagation(); } ); " event + + let onClickModifiers (cb : KeyModifiers -> 'msg) = + onEvent "onclick" ["{ shift: event.shiftKey, alt: event.altKey, ctrl: event.ctrlKey }"] (List.head >> Pickler.json.UnPickleOfString >> cb) + let update (message : TreeView.Message<'Key>) (model : TreeView<'Key, 'Value>) = match message with | TreeView.Message.Hover key -> @@ -31,9 +40,25 @@ module TreeView = | TreeView.Message.Unhover -> { model with hovered = ValueNone } - | TreeView.Message.Select key -> - let s = if model.selected = ValueSome key then ValueNone else ValueSome key - { model with selected = s } + | TreeView.Message.Click (key, modifiers) -> + if modifiers.ctrl then + if model.selected |> HashSet.contains key then + { model with + selected = model.selected |> HashSet.remove key + lastClick = ValueSome key } + else + { model with + selected = model.selected |> HashSet.add key + lastClick = ValueSome key } + + elif modifiers.shift then + let anchor = model.lastClick |> ValueOption.defaultValue model.tree.hierarchy.Root + { model with selected = model.tree.hierarchy |> FlatTree.range [| anchor; key |] } + + else + { model with + selected = HashSet.single key + lastClick = ValueSome key } | TreeView.Message.Virtual msg -> { model with tree = model.tree |> VirtualTree.update msg } @@ -42,25 +67,14 @@ module TreeView = (itemNode : 'Key -> 'primValue -> DomNode<'msg>) (model : AdaptiveTreeView<'Key, 'primKey, 'aKey, 'Value, 'primValue, 'aValue>) : DomNode<'msg> = - let descendants (node : aval<'Key voption>) = + let hoveredDescendants = adaptive { let! tree = model.tree.current - match! node with + match! model.hovered with | ValueSome h -> return tree |> FlatTree.descendants h | _ -> return ArraySegment.Empty } - let hoverParent = - adaptive { - let! tree = model.tree.current - match! model.hovered with - | ValueSome h -> return tree |> FlatTree.parent h - | _ -> return ValueNone - } - - let hovered = descendants model.hovered - let selected = descendants model.selected - let itemNode (item : VirtualTree.Item<'Key>) = let value = model.values |> AMap.find item.Value let indent = item.Depth * 16 @@ -78,33 +92,35 @@ module TreeView = TreeView.Message.Collapse item.Value |> message - i [ clazz $"{icon} link icon"; style "color: white"; onClick (fun _ -> collapseMessage) ] [] + onBoot (disablePropagation "click") ( + i [ clazz $"{icon} link icon"; style "color: white"; onClick (fun _ -> collapseMessage) ] [] + ) let attributes = AttributeMap.ofAMap <| amap { - let! hoverParent = hoverParent - let childHovered = hoverParent |> ValueOption.contains item.Value + let! hovered = model.hovered + let hovered = hovered |> ValueOption.contains item.Value + + let! hoveredDescendants = hoveredDescendants + let highlighted = hoveredDescendants |> ArraySegment.contains item.Value - let! hovered = hovered - let hovered = hovered |> ArraySegment.contains item.Value + let! selected = model.selected + let selected = selected |> HashSet.contains item.Value - let! selected = selected - let selected = selected |> ArraySegment.contains item.Value + let selectedClass = + if selected then "selected" else "" - if childHovered then - yield clazz "item parent" - else - yield - match hovered, selected with - | true, true -> clazz "item hovered selected" - | true, false -> clazz "item hovered" - | false, true -> clazz "item selected" - | _ -> clazz "item" + let highlightClass = + if highlighted then + if hovered then "hovered" else "highlighted" + else + "" + yield clazz $"item {selectedClass} {highlightClass}" yield style $"display: flex; justify-content: flex-start; align-items: center; padding: 5px; padding-left: {indent + 5}px" yield onMouseEnter (fun _ -> message <| TreeView.Message.Hover item.Value) yield onMouseLeave (fun _ -> message TreeView.Message.Unhover) - yield onMouseDoubleClick (fun _ -> message <| TreeView.Message.Select item.Value) + yield onClickModifiers (fun modifiers -> message <| TreeView.Message.Click (item.Value, modifiers)) } Incremental.div attributes <| alist { diff --git a/src/Scratch/31 - VirtualTree/TreeView/TreeViewModel.fs b/src/Scratch/31 - VirtualTree/TreeView/TreeViewModel.fs index 83c4b0ad..638c1d2f 100644 --- a/src/Scratch/31 - VirtualTree/TreeView/TreeViewModel.fs +++ b/src/Scratch/31 - VirtualTree/TreeView/TreeViewModel.fs @@ -1,5 +1,6 @@ namespace TreeView.Model +open Aardvark.UI open FSharp.Data.Adaptive open Adaptify @@ -12,7 +13,12 @@ type TreeView<'Key, 'Value> = tree : VirtualTree<'Key> values : HashMap<'Key, 'Value> hovered : 'Key voption - selected : 'Key voption + + [] + selected : HashSet<'Key> // Adaptify does not support generic HashSets + + [] + lastClick : 'Key voption // For range select } module TreeView = @@ -21,7 +27,7 @@ module TreeView = type Message<'Key> = | Hover of key: 'Key | Unhover - | Select of key : 'Key + | Click of key : 'Key * modifers: KeyModifiers | Virtual of VirtualTree.Message<'Key> static member inline ScrollTo(target : 'Key) = @@ -40,10 +46,11 @@ module TreeView = Virtual <| VirtualTree.Message.UncollapseAll let empty<'Key, 'Value> : TreeView<'Key, 'Value> = - { tree = VirtualTree.empty - values = HashMap.empty - hovered = ValueNone - selected = ValueNone } + { tree = VirtualTree.empty + values = HashMap.empty + hovered = ValueNone + selected = HashSet.empty + lastClick = ValueNone } let set (getChildren : 'Key -> #seq<'Key>) (values : HashMap<'Key, 'Value>) (root : 'Key) (tree : TreeView<'Key, 'Value>) = let flat = root |> FlatTree.ofHierarchy getChildren diff --git a/src/Scratch/31 - VirtualTree/VirtualTree/FlatTree.fs b/src/Scratch/31 - VirtualTree/VirtualTree/FlatTree.fs index 05bfcd25..3a581f4a 100644 --- a/src/Scratch/31 - VirtualTree/VirtualTree/FlatTree.fs +++ b/src/Scratch/31 - VirtualTree/VirtualTree/FlatTree.fs @@ -28,9 +28,9 @@ module internal ArraySegment = [] type internal FlatNode = - val Count : int - val Depth : int - val Offset : int + val Count : int // Number of nodes in subtree with the current node as root (inluding the node itself) + val Depth : int // Depth of the node (0 for root) + val Offset : int // Offset from the parent, e.g. 1 for first child, count of first child for second child member inline x.IsLeaf = x.Count = 1 @@ -81,6 +81,24 @@ type FlatTree<'T> internal (nodes : ArraySegment, values : ArraySegmen member x.IndexOf(value : 'T) = indices.TryFindV value + /// Returns all values that are within the index range spanned by the given values. + member x.Range(input : #seq<'T>) = + let mutable minIndex = Int32.MaxValue + let mutable maxIndex = Int32.MinValue + + for value in input do + match indices.TryFindV value with + | ValueSome index -> + minIndex <- min minIndex index + maxIndex <- max maxIndex index + + | _ -> () + + if minIndex = Int32.MinValue then + HashSet.Empty + else + HashSet.OfArrayRange(values.Array, values.Offset + minIndex, maxIndex - minIndex + 1) + /// Returns whether the tree contains the given node. member x.Contains(value : 'T) = indices.ContainsKey value @@ -354,6 +372,10 @@ module FlatTree = let inline indexOf (value : 'T) (tree : FlatTree<'T>) = tree.IndexOf value + /// Returns all values that are within the index range spanned by the given values. + let inline range (input : #seq<'T>) (tree : FlatTree<'T>) = + tree.Range input + /// Returns whether the tree contains the given node. let inline contains (value : 'T) (tree : FlatTree<'T>) = tree.Contains value