-
Notifications
You must be signed in to change notification settings - Fork 14
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
7 changed files
with
382 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,28 @@ | ||
| <?xml version="1.0" encoding="utf-8"?> | ||
| <Project Sdk="Microsoft.NET.Sdk"> | ||
| <PropertyGroup> | ||
| <OutputType>Exe</OutputType> | ||
| <TargetFramework>net6.0</TargetFramework> | ||
| <DisableImplicitFSharpCoreReference>True</DisableImplicitFSharpCoreReference> | ||
| <AssemblyName>$(MSBuildProjectName.Replace(" ", "_"))</AssemblyName> | ||
| </PropertyGroup> | ||
| <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|AnyCPU'"> | ||
| <OutputPath>..\..\..\bin\Debug\</OutputPath> | ||
| </PropertyGroup> | ||
| <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|AnyCPU'"> | ||
| <OutputPath>..\..\..\bin\Release\</OutputPath> | ||
| </PropertyGroup> | ||
| <ItemGroup> | ||
| <Compile Include="Model.fs" /> | ||
| <Compile Include="App.fs" /> | ||
| <Compile Include="Program.fs" /> | ||
| <None Include="App.config" /> | ||
| <None Include="paket.references" /> | ||
| </ItemGroup> | ||
| <ItemGroup> | ||
| <ProjectReference Include="..\..\Aardvark.Service\Aardvark.Service.fsproj" /> | ||
| <ProjectReference Include="..\..\Aardvark.UI.Primitives\Aardvark.UI.Primitives.fsproj" /> | ||
| <ProjectReference Include="..\..\Aardvark.UI\Aardvark.UI.fsproj" /> | ||
| </ItemGroup> | ||
| <Import Project="..\..\..\.paket\Paket.Restore.targets" /> | ||
| </Project> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,6 @@ | ||
| <?xml version="1.0" encoding="utf-8"?> | ||
| <configuration> | ||
| <startup> | ||
| <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5" /> | ||
| </startup> | ||
| </configuration> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,66 @@ | ||
| namespace VirtualListExample.Model | ||
|
|
||
| open Aardvark.Base | ||
| open FSharp.Data.Adaptive | ||
| open Adaptify | ||
|
|
||
| [<Struct; ModelType>] | ||
| type VirtualHeight = | ||
| { | ||
| itemHeight : int | ||
| clientHeight : int | ||
| } | ||
|
|
||
| [<ModelType>] | ||
| type VirtualList<'T> = | ||
| { | ||
| height : VirtualHeight | ||
| elements : 'T[] | ||
| scrollOffset : int | ||
| scrollTarget : int | ||
| } | ||
|
|
||
| module VirtualList = | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| 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 | ||
|
|
||
| [<ModelType>] | ||
| type Model = | ||
| { | ||
| count : int | ||
| elements : VirtualList<string> | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 | ||
|
|
||
| [<EntryPoint; STAThread>] | ||
| 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 |
Oops, something went wrong.