From a4e2324faec4c664e6e8d4428b9fb8540e416240 Mon Sep 17 00:00:00 2001 From: Martin Date: Mon, 24 Jul 2023 16:59:13 +0200 Subject: [PATCH] Add simple virtualized list example --- src/Aardvark.Media.sln | 7 + .../30 - VirtualList/30 - VirtualList.fsproj | 28 +++ src/Scratch/30 - VirtualList/App.config | 6 + src/Scratch/30 - VirtualList/App.fs | 207 ++++++++++++++++++ src/Scratch/30 - VirtualList/Model.fs | 66 ++++++ src/Scratch/30 - VirtualList/Program.fs | 49 +++++ src/Scratch/30 - VirtualList/paket.references | 19 ++ 7 files changed, 382 insertions(+) create mode 100644 src/Scratch/30 - VirtualList/30 - VirtualList.fsproj create mode 100644 src/Scratch/30 - VirtualList/App.config create mode 100644 src/Scratch/30 - VirtualList/App.fs create mode 100644 src/Scratch/30 - VirtualList/Model.fs create mode 100644 src/Scratch/30 - VirtualList/Program.fs create mode 100644 src/Scratch/30 - VirtualList/paket.references diff --git a/src/Aardvark.Media.sln b/src/Aardvark.Media.sln index f886ff6d..ba5ca3de 100644 --- a/src/Aardvark.Media.sln +++ b/src/Aardvark.Media.sln @@ -2,6 +2,8 @@ Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio Version 17 VisualStudioVersion = 17.0.31912.275 MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "30 - VirtualList", "Scratch\30 - VirtualList\30 - VirtualList.fsproj", "{F18A02B9-F0FA-42A6-91A8-88203E0D59B8}" +EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "28 - Giraffe", "Scratch\28 - Giraffe\28 - Giraffe.fsproj", "{1A788AF4-257B-4C4C-8C5A-E379373B5838}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "27 - NavigationDemoNew", "Scratch\27 - NavigationDemoNew\27 - NavigationDemoNew.fsproj", "{5BD4DD0F-92E4-4EE9-A9C0-AE3E187B2F92}" @@ -154,6 +156,10 @@ Global Release|Any CPU = Release|Any CPU EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution + {F18A02B9-F0FA-42A6-91A8-88203E0D59B8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {F18A02B9-F0FA-42A6-91A8-88203E0D59B8}.Debug|Any CPU.Build.0 = Debug|Any CPU + {F18A02B9-F0FA-42A6-91A8-88203E0D59B8}.Release|Any CPU.ActiveCfg = Release|Any CPU + {F18A02B9-F0FA-42A6-91A8-88203E0D59B8}.Release|Any CPU.Build.0 = Release|Any CPU {1A788AF4-257B-4C4C-8C5A-E379373B5838}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {1A788AF4-257B-4C4C-8C5A-E379373B5838}.Debug|Any CPU.Build.0 = Debug|Any CPU {1A788AF4-257B-4C4C-8C5A-E379373B5838}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -399,6 +405,7 @@ Global HideSolutionNode = FALSE EndGlobalSection GlobalSection(NestedProjects) = preSolution + {F18A02B9-F0FA-42A6-91A8-88203E0D59B8} = {49FCD64D-3937-4F2E-BA36-D5B1837D4E5F} {1A788AF4-257B-4C4C-8C5A-E379373B5838} = {49FCD64D-3937-4F2E-BA36-D5B1837D4E5F} {5BD4DD0F-92E4-4EE9-A9C0-AE3E187B2F92} = {49FCD64D-3937-4F2E-BA36-D5B1837D4E5F} {70C08F03-F4A5-414A-ABD6-CC07DC42E07C} = {2FE8734A-BF34-43DE-8731-5D580FE4E83B} diff --git a/src/Scratch/30 - VirtualList/30 - VirtualList.fsproj b/src/Scratch/30 - VirtualList/30 - VirtualList.fsproj new file mode 100644 index 00000000..3d537d50 --- /dev/null +++ b/src/Scratch/30 - VirtualList/30 - VirtualList.fsproj @@ -0,0 +1,28 @@ + + + + Exe + net6.0 + True + $(MSBuildProjectName.Replace(" ", "_")) + + + ..\..\..\bin\Debug\ + + + ..\..\..\bin\Release\ + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/src/Scratch/30 - VirtualList/App.config b/src/Scratch/30 - VirtualList/App.config new file mode 100644 index 00000000..434e45fb --- /dev/null +++ b/src/Scratch/30 - VirtualList/App.config @@ -0,0 +1,6 @@ + + + + + + \ No newline at end of file diff --git a/src/Scratch/30 - VirtualList/App.fs b/src/Scratch/30 - VirtualList/App.fs new file mode 100644 index 00000000..9d95a709 --- /dev/null +++ b/src/Scratch/30 - VirtualList/App.fs @@ -0,0 +1,207 @@ +module VirtualListExample.App +open Aardvark.UI +open Aardvark.UI.Primitives + +open Aardvark.Base +open FSharp.Data.Adaptive +open VirtualListExample.Model + +module VirtualList = + + // Channel that triggers whenever the adaptive value changes (ignoring the actual value) + type private SignalChannelReader<'T>(value : aval<'T>) = + inherit ChannelReader() + + override x.Release() =() + override x.ComputeMessages t = + value.GetValue t |> ignore + [ "0" ] + + type private SignalChannel<'T>(value : aval<'T>) = + inherit Channel() + override x.GetReader() = new SignalChannelReader<_>(value) :> ChannelReader + + + let update (message : VirtualList.Message) (list : VirtualList<'T>) = + match message with + | VirtualList.Message.Resize height -> + Log.line "%A" height + { list with height = height } + + | VirtualList.Message.Scroll offset -> + Log.line "Scroll %A" offset + { list with scrollOffset = offset } + + let view (message : VirtualList.Message -> 'msg) (itemNode : 'T -> DomNode<'msg>) (list : AdaptiveVirtualList<'T, _, _>) : DomNode<'msg> = + let onUpdate = + onEvent "onupdate" [ ] ( + List.head >> Pickler.unpickleOfJson >> VirtualList.Message.Resize >> message + ) + + let onScroll = + onEvent "onscroll" [ "event.target.scrollTop" ] ( + List.head >> Pickler.unpickleOfJson >> VirtualList.Message.Scroll >> message + ) + + let bootJs = + String.concat "" [ + "const self = $('#__ID__')[0];" + + "const getItemHeight = () => {" + " const $item = $(self).children('.item:not(.virtual):first');" + " return $item.length > 0 ? $item[0].clientHeight : 0;" + "};" + + "let lastHeight = '';" + "const updateHeight = () => {" + " const height = {" + " itemHeight: getItemHeight()," + " clientHeight: self.clientHeight" + " };" + + " if (height.itemHeight !== lastHeight.itemHeight ||" + " height.clientHeight !== lastHeight.clientHeight)" + " {" + " aardvark.processEvent('__ID__', 'onupdate', height);" + " lastHeight = height;" + " }" + "};" + + "const scrollTo = (offset) => {" + " self.scrollTo({ top: offset, behavior: 'smooth'});" + "};" + "scrollCh.onmessage = scrollTo;" + + // Client and item height may change, update it when the elements or the size change + "elementsCh.onmessage = updateHeight;" + "const resizeObserver = new ResizeObserver(updateHeight);" + "resizeObserver.observe(self);" + ] + + let item (element : 'T) = + div [clazz "item"; style "color: white"] [itemNode element] + + let virtualItem (height : int) = + div [clazz "item virtual"; style $"height: {height}px; visibility: hidden"] [] + + // Number of elements the window extends beyond the actual visible space + let border = 5 + + let elements = + alist { + let! itemHeight = list.height.itemHeight + + if itemHeight = 0 then + let! elements = list.elements + + // We do not know the item height yet, render two elements to determine it. + // Also we need the client height of the list, expand it to the max with a big virtual item. + if elements.Length > 0 then + yield virtualItem 9999 + + for i = 0 to (min elements.Length 2) - 1 do + yield item elements.[i] + else + let! elements = list.elements + let! clientHeight = list.height.clientHeight + let! scrollOffset = list.scrollOffset + + let first = ((scrollOffset / itemHeight) - border) |> clamp 0 (elements.Length - 1) + let last = (first + (clientHeight / itemHeight) + 2 * border) |> min (elements.Length - 1) + + if first > 0 then + yield virtualItem (first * itemHeight) + + for i = first to last do + yield item elements.[i] + + if last < elements.Length - 1 then + yield virtualItem ((elements.Length - last - 1) * itemHeight) + } + + let channels : (string * Channel) list = [ + "elementsCh", SignalChannel list.elements + "scrollCh", AVal.channel list.scrollTarget + ] + + onBoot' channels bootJs ( + elements |> Incremental.div (AttributeMap.ofList [ + clazz "ui inverted divided list" + style "margin: 10px; padding: 5px; height: 100%; max-height: 400px; overflow-y: auto; border-style: solid; border-width: 1px; border-color: gray" + onUpdate; onScroll + ]) + ) + +let private rnd = RandomSystem() + +let update (model : Model) (msg : Message) = + match msg with + | SetCount count -> + { model with count = count} + + | Generate -> + let elements = Array.init model.count (fun i -> $"#{i}") + { model with elements = model.elements |> VirtualList.set elements } + + | Scroll -> + let target = model.elements |> VirtualList.length |> rnd.UniformInt + { model with elements = model.elements |> VirtualList.scrollTo target } + + | VirtualListAction message -> + { model with elements = model.elements |> VirtualList.update message } + +let view (model : AdaptiveModel) = + body [ style "background: #1B1C1E"] [ + require Html.semui ( + div [clazz "ui"; style "background: #1B1C1E; overflow-y: hidden"] [ + div [clazz "ui right labeled input"; style "margin: 10px"] [ + simplenumeric { + attributes [clazz "ui inverted input"] + value model.count + update SetCount + min 1 + max 10000000 + } + + div [clazz "ui basic label"] [ + text "Elements" + ] + ] + + button [ + clazz "ui button" + style "margin: 10px" + onClick (fun _ -> Generate) + ] [ + text "Generate" + ] + + button [ + clazz "ui button" + style "margin: 10px" + onClick (fun _ -> Scroll) + ] [ + text "Scroll" + ] + + model.elements |> VirtualList.view VirtualListAction text + ] + ) + ] + + +let threads (model : Model) = + ThreadPool.empty + +let app = + { + unpersist = Unpersist.instance + threads = threads + initial = + { + count = 100 + elements = VirtualList.empty + } + update = update + view = view + } \ No newline at end of file diff --git a/src/Scratch/30 - VirtualList/Model.fs b/src/Scratch/30 - VirtualList/Model.fs new file mode 100644 index 00000000..b79122dd --- /dev/null +++ b/src/Scratch/30 - VirtualList/Model.fs @@ -0,0 +1,66 @@ +namespace VirtualListExample.Model + +open Aardvark.Base +open FSharp.Data.Adaptive +open Adaptify + +[] +type VirtualHeight = + { + itemHeight : int + clientHeight : int + } + +[] +type VirtualList<'T> = + { + height : VirtualHeight + elements : 'T[] + scrollOffset : int + scrollTarget : int + } + +module VirtualList = + + [] + type Message = + | Resize of height: VirtualHeight + | Scroll of offset: int + + let inline length (list : VirtualList<'T>) = + list.elements.Length + + let inline ofArray (elements :'T[]) = + { height = Unchecked.defaultof<_> + elements = elements + scrollOffset = 0 + scrollTarget = -1 } + + let inline set (elements : 'T seq) (list : VirtualList<'T>) = + let elements = + match elements with + | :? array<'T> as arr -> arr + | _ -> Array.ofSeq elements + + { list with elements = elements } + + let inline empty<'T> : VirtualList<'T> = + ofArray Array.empty + + let inline scrollTo (index : int) (list : VirtualList<'T>) = + let offset = list.height.itemHeight * index + { list with scrollTarget = offset } + + +type Message = + | SetCount of count: int + | Generate + | Scroll + | VirtualListAction of VirtualList.Message + +[] +type Model = + { + count : int + elements : VirtualList + } \ No newline at end of file diff --git a/src/Scratch/30 - VirtualList/Program.fs b/src/Scratch/30 - VirtualList/Program.fs new file mode 100644 index 00000000..d8324d8e --- /dev/null +++ b/src/Scratch/30 - VirtualList/Program.fs @@ -0,0 +1,49 @@ +open System +open Aardvark.Base +open Aardvark.Application +open Aardvark.Application.Slim +open Aardvark.UI +open Aardium +open VirtualListExample + +open Suave +open Suave.WebPart + +[] +let main argv = + Aardvark.Init() + Aardium.init() + + use app = new OpenGlApplication() + let instance = App.app |> App.start + + // use can use whatever suave server to start you mutable app. + // startServerLocalhost is one of the convinience functions which sets up + // a server without much boilerplate. + // there is also WebPart.startServer and WebPart.runServer. + // look at their implementation here: https://github.com/aardvark-platform/aardvark.media/blob/master/src/Aardvark.Service/Suave.fs#L10 + // if you are unhappy with them, you can always use your own server config. + // the localhost variant does not require to allow the port through your firewall. + // the non localhost variant runs in 127.0.0.1 which enables remote acces (e.g. via your mobile phone) + WebPart.startServerLocalhost 4321 [ + MutableApp.toWebPart' app.Runtime false instance + Suave.Files.browseHome + ] |> ignore + + Aardium.run { + url "http://localhost:4321/" + width 1024 + height 768 + debug true + } + + //use ctrl = new AardvarkCefBrowser() + //ctrl.Dock <- DockStyle.Fill + //form.Controls.Add ctrl + //ctrl.StartUrl <- "http://localhost:4321/" + //ctrl.ShowDevTools() + //form.Text <- "Examples" + //form.Icon <- Icons.aardvark + + //Application.Run form + 0 diff --git a/src/Scratch/30 - VirtualList/paket.references b/src/Scratch/30 - VirtualList/paket.references new file mode 100644 index 00000000..740fa17d --- /dev/null +++ b/src/Scratch/30 - VirtualList/paket.references @@ -0,0 +1,19 @@ +Aardvark.Base +FSharp.Data.Adaptive +Aardvark.Base.FSharp + +Aardvark.Rendering +Aardvark.Rendering.Vulkan +Aardvark.Application.Slim.GL +Aardvark.SceneGraph +Aardvark.SceneGraph.IO +Aardvark.Rendering.Text +Adaptify.MSBuild + +FsPickler +FsPickler.Json + +Aardium + +Suave +FSharp.Core