Skip to content

Commit

Permalink
[VirtualTree] Implement multi- and range select
Browse files Browse the repository at this point in the history
  • Loading branch information
@hyazinthh
hyazinthh committed Aug 10, 2023
1 parent 1fed367 commit aa78489
Show file tree
Hide file tree
Showing 4 changed files with 93 additions and 53 deletions.
17 changes: 6 additions & 11 deletions src/Scratch/31 - VirtualTree/TreeView/TreeView.css
View file
Original file line number Diff line number Diff line change
@@ -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;
}

Expand Down
82 changes: 49 additions & 33 deletions src/Scratch/31 - VirtualTree/TreeView/TreeViewApp.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,15 @@ module TreeView =

state

[<AutoOpen>]
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 ->
Expand All @@ -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 }
Expand All @@ -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
Expand All @@ -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 {
Expand Down
19 changes: 13 additions & 6 deletions src/Scratch/31 - VirtualTree/TreeView/TreeViewModel.fs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
namespace TreeView.Model

open Aardvark.UI
open FSharp.Data.Adaptive
open Adaptify

Expand All @@ -12,7 +13,12 @@ type TreeView<'Key, 'Value> =
tree : VirtualTree<'Key>
values : HashMap<'Key, 'Value>
hovered : 'Key voption
selected : 'Key voption

[<TreatAsValue>]
selected : HashSet<'Key> // Adaptify does not support generic HashSets

[<NonAdaptive>]
lastClick : 'Key voption // For range select
}

module TreeView =
Expand All @@ -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) =
Expand All @@ -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
Expand Down
28 changes: 25 additions & 3 deletions src/Scratch/31 - VirtualTree/VirtualTree/FlatTree.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,9 @@ module internal ArraySegment =

[<Struct>]
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
Expand Down Expand Up @@ -81,6 +81,24 @@ type FlatTree<'T> internal (nodes : ArraySegment<FlatNode>, 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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit aa78489

Please sign in to comment.