diff --git a/src/Aardvark.UI.Primitives/Aardvark.UI.Primitives.fsproj b/src/Aardvark.UI.Primitives/Aardvark.UI.Primitives.fsproj
index 6c928747..d1f294b7 100644
--- a/src/Aardvark.UI.Primitives/Aardvark.UI.Primitives.fsproj
+++ b/src/Aardvark.UI.Primitives/Aardvark.UI.Primitives.fsproj
@@ -87,6 +87,7 @@
+
diff --git a/src/Aardvark.UI.Primitives/Primitives/SimplePrimitives.fs b/src/Aardvark.UI.Primitives/Primitives/SimplePrimitives.fs
index 0d544958..569d417c 100644
--- a/src/Aardvark.UI.Primitives/Primitives/SimplePrimitives.fs
+++ b/src/Aardvark.UI.Primitives/Primitives/SimplePrimitives.fs
@@ -5,6 +5,8 @@ open Aardvark.UI
open FSharp.Data.Adaptive
open Aardvark.UI.Generic
+#nowarn "44" // TODO: Remove old dropdown stuff
+
[]
module SimplePrimitives =
open System
@@ -167,6 +169,223 @@ module SimplePrimitives =
module TextConfig =
let empty = { regex = None; maxLength = None }
+ // TODO: Add []
+ module Dropdown =
+
+ []
+ type DropdownValues<'T, 'msg> =
+ | List of alist<'T * DomNode<'msg>>
+ | Map of amap<'T, DomNode<'msg>>
+
+ module DropdownInternals =
+
+ []
+ type DropdownValueConverter() =
+ static member inline ToDropdownValues (values: DropdownValues<'T, 'msg>) = values
+ static member inline ToDropdownValues (values: alist<'T * DomNode<'msg>>) = DropdownValues.List values
+ static member inline ToDropdownValues (values: amap<'T, DomNode<'msg>>) = DropdownValues.Map values
+ static member inline ToDropdownValues (values: seq<'T * DomNode<'msg>>) = DropdownValues.List <| AList.ofSeq values
+ static member inline ToDropdownValues (values: array<'T * DomNode<'msg>>) = DropdownValues.List <| AList.ofArray values
+ static member inline ToDropdownValues (values: list<'T * DomNode<'msg>>) = DropdownValues.List <| AList.ofList values
+
+ let inline private toDropdownValuesAux (_: ^Converter) (values: ^Values) =
+ ((^Converter or ^Values) : (static member ToDropdownValues : ^Values -> DropdownValues<'T, 'msg>) (values))
+
+ let inline toDropdownValues (values: ^Values) : DropdownValues<'T, 'msg> =
+ toDropdownValuesAux Unchecked.defaultof values
+
+ let inline getEnumValues<'T, 'U, 'msg when 'T : enum<'U>> (toNode: Option<'T -> DomNode<'msg>>) : array<'T * DomNode<'msg>> =
+ let values = Enum.GetValues typeof<'T> |> unbox<'T[]>
+ let nodes =
+ match toNode with
+ | Some f -> values |> Array.map f
+ | _ -> Enum.GetNames typeof<'T> |> Array.map text
+
+ Array.zip values nodes
+
+ let private pickler = MBrace.FsPickler.FsPickler.CreateBinarySerializer()
+
+ let private dropdownImpl (update: 'T list -> 'msg) (activateOnHover: bool) (placeholder: string option) (multiSelect: bool) (icon: string option)
+ (selected: alist<'T>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ let dependencies =
+ Html.semui @ [ { name = "dropdown"; url = "resources/dropdown.js"; kind = Script }]
+
+ let valuesWithKeys =
+ let sortedValues =
+ match values with
+ | DropdownValues.List list -> list
+ | DropdownValues.Map map ->
+ let cmp =
+ if typeof.IsAssignableFrom typeof<'T> then Unchecked.compare<'T>
+ else fun _ _ -> -1
+
+ map |> AMap.toASet |> ASet.sortWith (fun (a, _) (b, _) -> cmp a b)
+
+ sortedValues
+ |> AList.map (fun (key, node) ->
+ let hash = pickler.ComputeHash(key).Hash |> Convert.ToBase64String
+ key, hash, node
+ )
+
+ let lookup =
+ valuesWithKeys
+ |> AList.toAVal
+ |> AVal.map (fun values ->
+ let forward = values |> IndexList.map (fun (key, hash, _) -> struct (key, hash)) |> HashMap.ofSeqV
+ let backward = values |> IndexList.map (fun (key, hash, _) -> struct (hash, key)) |> HashMap.ofSeqV
+ forward, backward
+ )
+
+ let update (args : string list) =
+ try
+ let data : string = Pickler.unpickleOfJson args.Head
+ let _fw, bw = AVal.force lookup
+
+ let values =
+ data
+ |> String.split ","
+ |> Array.toList
+ |> List.choose (fun k -> HashMap.tryFind k bw)
+
+ Seq.singleton (update values)
+
+ with exn ->
+ Log.warn "[Dropdown] callback failed: %s" exn.Message
+ Seq.empty
+
+ let selection =
+ adaptive {
+ let! selected = selected |> AList.toAVal
+ let! fw, _bw = lookup
+
+ return selected
+ |> IndexList.choose (fun v -> HashMap.tryFind v fw)
+ |> IndexList.toList
+ }
+
+ let attributes =
+ let disableClazz clazz disabled =
+ if disabled then AttributeMap.removeClass clazz
+ else id
+
+ let toggleClazz clazz enabled =
+ if enabled then AttributeMap.addClass clazz
+ else AttributeMap.removeClass clazz
+
+ let attributes =
+ attributes
+ |> toggleClazz "multiple" multiSelect
+ |> toggleClazz "selection" icon.IsNone
+ |> disableClazz "clearable" placeholder.IsNone
+
+ AttributeMap.ofList [
+ clazz "ui dropdown"
+ onEvent' "data-event" [] update
+ ]
+ |> AttributeMap.union attributes
+
+ let boot =
+ let trigger = if activateOnHover then "'hover'" else "'click'"
+
+ String.concat "" [
+ "const $self = $('#__ID__');"
+ $"aardvark.dropdown($self, {trigger}, channelSelection);"
+ ]
+
+ require dependencies (
+ onBoot' ["channelSelection", AVal.channel selection] boot (
+ Incremental.div attributes <| AList.ofList [
+ input [ attribute "type" "hidden" ]
+
+ match icon with
+ | Some icon ->
+ i [ clazz (sprintf "%s icon" icon)] []
+ | _ ->
+ i [ clazz "dropdown icon" ] []
+ div [ clazz "default text"] (placeholder |> Option.defaultValue "")
+
+ Incremental.div (AttributeMap.ofList [clazz "menu"]) <| alist {
+ for (_, hash, node) in valuesWithKeys do
+ yield div [ clazz "ui item"; attribute "data-value" hash] [node]
+ }
+ ]
+ )
+ )
+
+ let private dropdownOptionImpl (update: 'T option -> 'msg) (activateOnHover: bool) (icon: string option) (placeholder: string)
+ (selected: aval<'T option>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ let selected = selected |> AVal.map Option.toList |> AList.ofAVal
+ let update = List.tryHead >> update
+ dropdownImpl update activateOnHover (Some placeholder) false icon selected attributes values
+
+ let private dropdownSingleImpl (update: 'T -> 'msg) (activateOnHover: bool) (icon: string option)
+ (selected: aval<'T>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ let selected = selected |> AVal.map List.singleton |> AList.ofAVal
+ let update = List.head >> update
+ dropdownImpl update activateOnHover None false icon selected attributes values
+
+ /// Dropdown menu for a collection of values. Multiple items can be selected at a time.
+ let dropdownMultiSelect (update: 'T list -> 'msg) (activateOnHover: bool) (placeholder: string)
+ (selected: alist<'T>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ dropdownImpl update activateOnHover (Some placeholder) true None selected attributes values
+
+ /// Dropdown menu for a collection of values. At most a single item can be selected at a time.
+ let dropdownOption (update: 'T option -> 'msg) (activateOnHover: bool) (icon: string option) (placeholder: string)
+ (selected: aval<'T option>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ dropdownOptionImpl update activateOnHover icon placeholder selected attributes values
+
+ /// Dropdown menu for a collection of values.
+ let dropdown (update: 'T -> 'msg) (activateOnHover: bool) (icon: string option)
+ (selected: aval<'T>) (attributes: AttributeMap<'msg>) (values: DropdownValues<'T, 'msg>) =
+ dropdownSingleImpl update activateOnHover icon selected attributes values
+
+
+ /// Dropdown menu for a collection of values. Multiple items can be selected at a time.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The values can be provided as alist, amap, or sequence of keys with DOM nodes.
+ let inline dropdownMultiSelect (update: 'T list -> 'msg) (activateOnHover: bool) (placeholder: string)
+ (selected: alist<'T>) attributes values =
+ let values: DropdownValues<'T, 'msg> = DropdownInternals.toDropdownValues values
+ DropdownInternals.dropdownMultiSelect update activateOnHover placeholder selected (att attributes) values
+
+ /// Dropdown menu for an enumeration type. Multiple items can be selected at a time.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The displayed values are derived from the enumeration value names, if the values argument is None.
+ let inline dropdownEnumMultiSelect (update: 'T list -> 'msg) (activateOnHover: bool) (placeholder: string)
+ (selected: alist<'T>) attributes values =
+ let values = DropdownInternals.getEnumValues<'T, _, 'msg> values |> DropdownInternals.toDropdownValues
+ dropdownMultiSelect update activateOnHover placeholder selected attributes values
+
+ /// Dropdown menu for a collection of values. At most a single item can be selected at a time.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The values can be provided as alist, amap, or sequence of keys with DOM nodes.
+ let inline dropdownOption (update: 'T option -> 'msg) (activateOnHover: bool) (icon: string option) (placeholder: string)
+ (selected: aval<'T option>) attributes values =
+ let values: DropdownValues<'T, 'msg> = DropdownInternals.toDropdownValues values
+ DropdownInternals.dropdownOption update activateOnHover icon placeholder selected (att attributes) values
+
+ /// Dropdown menu for an enumeration type. At most a single item can be selected at a time.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The displayed values are derived from the enumeration value names, if the values argument is None.
+ let inline dropdownEnumOption (update: 'T option -> 'msg) (activateOnHover: bool) (icon: string option) (placeholder: string)
+ (selected: aval<'T option>) attributes values =
+ let values = DropdownInternals.getEnumValues<'T, _, 'msg> values
+ dropdownOption update activateOnHover icon placeholder selected attributes values
+
+ /// Dropdown menu for a collection of values.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The values can be provided as alist, amap, or sequence of keys with DOM nodes.
+ let inline dropdown (update: 'T -> 'msg) (activateOnHover: bool) (icon: string option) (selected: aval<'T>) attributes values =
+ let values: DropdownValues<'T, 'msg> = DropdownInternals.toDropdownValues values
+ DropdownInternals.dropdown update activateOnHover icon selected (att attributes) values
+
+ /// Dropdown menu for a an enumeration type.
+ /// The attributes can be provided as AttributeMap, amap, alist, or sequence of (conditional) attributes.
+ /// The displayed values are derived from the enumeration value names, if the values argument is None.
+ let inline dropdownEnum (update: 'T -> 'msg) (activateOnHover: bool) (icon: string option) (selected: aval<'T>) attributes values =
+ let values = DropdownInternals.getEnumValues<'T, _, 'msg> values
+ dropdown update activateOnHover icon selected attributes values
+
module Incremental =
[]
@@ -354,7 +573,7 @@ module SimplePrimitives =
)
)
)
-
+
let textarea (cfg : TextAreaConfig) (atts : AttributeMap<'msg>) (value : aval) (update : string -> 'msg) =
let value = if value.IsConstant then AVal.custom (fun t -> value.GetValue t) else value
let update v =
@@ -381,7 +600,7 @@ module SimplePrimitives =
alist {
yield
textarea (att [
- match cfg.placeholder with
+ match cfg.placeholder with
| Some ph when ph<>"" -> yield attribute "placeholder" ph
| _ -> ()
yield attribute "type" "text"
@@ -391,221 +610,39 @@ module SimplePrimitives =
)
)
- let private pickler = MBrace.FsPickler.FsPickler.CreateBinarySerializer()
-
+ []
let dropdown (cfg : DropdownConfig) (atts : AttributeMap<'msg>) (values : amap<'a, DomNode<'msg>>) (selected : aval>) (update : Option<'a> -> 'msg) =
+ let activateOnHover = cfg.onTrigger = TriggerDropdown.Hover
- let selected = if selected.IsConstant then AVal.custom (fun t -> selected.GetValue t) else selected
+ match cfg.mode with
+ | DropdownMode.Icon icon ->
+ Dropdown.dropdownOption update activateOnHover (Some icon) "" selected atts values
- let compare =
- if typeof.IsAssignableFrom typeof<'a> then Some Unchecked.compare<'a>
- else None
-
- let valuesWithKeys =
- values
- |> AMap.map (fun k v ->
- let hash = pickler.ComputeHash(k).Hash |> System.Convert.ToBase64String
- //let hash = System.Threading.Interlocked.Increment(&id) |> string
- hash, v
- )
-
- let m =
- valuesWithKeys
- |> AMap.toAVal
- |> AVal.map (HashMap.map (fun k (v,_) -> v))
- |> AVal.map (fun m -> m, HashMap.ofSeq (Seq.map (fun (a,b) -> b,a) m))
-
- let update (k : string) =
- let _fw, bw = AVal.force m
- selected.MarkOutdated()
- try
- match HashMap.tryFind k bw with
- | Some v -> update (Some v) |> Seq.singleton
- | None -> update None |> Seq.singleton
- with _ ->
- Seq.empty
+ | DropdownMode.Text (Some placeholder) ->
+ let atts = AttributeMap.union atts (AttributeMap.ofList [clazz "clearable"])
+ Dropdown.dropdownOption update activateOnHover None placeholder selected atts values
- let selection =
- selected |> AVal.bind (function Some v -> m |> AVal.map (fun (fw,_) -> HashMap.tryFind v fw) | None -> AVal.constant None)
-
- let myAtts =
- AttributeMap.ofList [
- clazz "ui dropdown"
- onEvent' "data-event" [] (function (str :: _) -> Seq.delay (fun () -> update (Pickler.unpickleOfJson str)) | _ -> Seq.empty)
- ]
-
- let initial =
- match selection.GetValue() with
- | Some v -> sprintf ".dropdown('set selected', '%s', '', true);" v
- | None -> ".dropdown('clear');"
-
- let boot =
- let trigger =
- match cfg.onTrigger with
- | TriggerDropdown.Click -> "'click'" // default
- | TriggerDropdown.Hover -> "'hover'"
-
- let clearable =
- match cfg.mode with
- | DropdownMode.Text (Some _) -> "true"
- | _ -> "false"
-
- String.concat ";" [
- "var $self = $('#__ID__');"
- "$self.dropdown({ on: " + trigger + ", clearable: " + clearable + ", onChange: function(value) { aardvark.processEvent('__ID__', 'data-event', value); }, onHide : function() { var v = $self.dropdown('get value'); if(!v || v.length == 0) { $self.dropdown('clear'); } } })" + initial
- "selectedCh.onmessage = function(value) { if(value.value) { $self.dropdown('set selected', value.value.Some, '', true); } else { $self.dropdown('clear'); } }; "
- ]
-
- require Html.semui (
- onBoot' ["selectedCh", AVal.channel (AVal.map thing selection)] boot (
- Incremental.div (AttributeMap.union atts myAtts) (
- alist {
- yield input [ attribute "type" "hidden" ]
- match cfg.mode with
- | DropdownMode.Text ph ->
- let ph = ph |> Option.defaultValue ""
- yield i [ clazz "dropdown icon" ] []
- yield div [ clazz "default text"] ph
- | DropdownMode.Icon iconName ->
- yield i [ clazz (sprintf "%s icon" iconName)] []
- yield
- Incremental.div (AttributeMap.ofList [clazz "ui menu"]) (
- alist {
- match compare with
- | Some cmp ->
- for (_, (value, node)) in valuesWithKeys |> AMap.toASet |> ASet.sortWith (fun (a,_) (b,_) -> cmp a b) do
- yield div [ clazz "ui item"; attribute "data-value" value] [node]
- | None ->
- for (_, (value, node)) in valuesWithKeys |> AMap.toASet |> ASet.sortBy (snd >> fst) do
- yield div [ clazz "ui item"; attribute "data-value" value] [node]
- }
- )
- }
- )
- )
- )
+ | DropdownMode.Text None ->
+ Dropdown.dropdownOption update activateOnHover None "" selected atts values
+ []
let dropdownUnclearable (atts : AttributeMap<'msg>) (values : amap<'a, DomNode<'msg>>) (selected : aval<'a>) (update : 'a -> 'msg) =
- dropdown DropdownConfig.unclearable atts values (AVal.map Some selected) (Option.get >> update)
+ Dropdown.dropdown update false None selected atts values
- []
+ []
let dropdownUnClearable (atts : AttributeMap<'msg>) (values : amap<'a, DomNode<'msg>>) (selected : aval<'a>) (update : 'a -> 'msg) =
- dropdown DropdownConfig.unclearable atts values (AVal.map Some selected) (Option.get >> update)
+ Dropdown.dropdown update false None selected atts values
+ []
let dropdownMultiSelect (attributes : AttributeMap<'msg>)
(compare : Option<'T -> 'T -> int>) (defaultText : string)
(values : amap<'T, DomNode<'msg>>) (selected : alist<'T>) (update : 'T list -> 'msg) =
- let valuesWithKeys =
- values
- |> AMap.map (fun k v ->
- let hash = pickler.ComputeHash(k).Hash |> Convert.ToBase64String
- hash, v
- )
-
- let lookup =
- valuesWithKeys
- |> AMap.toAVal
- |> AVal.map (HashMap.map (fun k (v,_) -> v))
- |> AVal.map (fun m -> m, HashMap.ofSeq (Seq.map (fun (a,b) -> b,a) m))
-
- let items =
- let set = valuesWithKeys |> AMap.toASet
-
- let compare =
- compare |> Option.orElse (
- if typeof.IsAssignableFrom typeof<'T> then
- Some Unchecked.compare<'T>
- else
- None
- )
-
- match compare with
- | Some cmp ->
- set |> ASet.sortWith (fun (a,_) (b,_) -> cmp a b)
- | _ ->
- set |> ASet.sortBy (snd >> fst)
-
- let update (args : string list) =
- try
- let data : string = Pickler.unpickleOfJson args.Head
- let _fw, bw = AVal.force lookup
-
- let values =
- data
- |> String.split ","
- |> Array.toList
- |> List.choose (fun k -> HashMap.tryFind k bw)
-
- Seq.singleton (update values)
-
- with exn ->
- Log.warn "[dropdownMultiSelect] callback failed: %s" exn.Message
- Seq.empty
-
- let selection =
- adaptive {
- let! selected = selected |> AList.toAVal
- let! (fw, _) = lookup
-
- return selected
- |> IndexList.choose (fun v -> HashMap.tryFind v fw)
- |> IndexList.toList
- }
-
- let attributes =
- AttributeMap.ofList [
- clazz "ui dropdown multiple selection"
- onEvent' "data-event" [] update
- ]
- |> AttributeMap.union attributes
-
- let boot =
- String.concat "" [
- "const $self = $('#__ID__');"
-
- "$self.dropdown({"
- " onChange: function(value) { aardvark.processEvent('__ID__', 'data-event', value); },"
- "});"
-
- // God I hate JS...
- // https://stackoverflow.com/questions/7837456/how-to-compare-arrays-in-javascript/7837725#7837725
- "function arraysIdentical(a, b) {"
- " var i = a.length;"
- " if (i != b.length) return false;"
- " while (i--) {"
- " if (a[i] !== b[i]) return false;"
- " }"
- " return true;"
- "};"
-
- "selectedCh.onmessage = function(values) {"
- " const curr = $self.dropdown('get values');"
-
- // Prevent resetting the same values (leads to flickering)
- " if (arraysIdentical(curr, values)) {"
- " return;"
- " }"
-
- " $self.dropdown('clear', true);"
- " $self.dropdown('set selected', values, true);" // set exactly bugged? clear seems to trigger event
- "};"
- ]
-
- require Html.semui (
- onBoot' ["selectedCh", AVal.channel selection] boot (
- Incremental.div attributes <| AList.ofList [
- input [ attribute "type" "hidden" ]
-
- i [ clazz "dropdown icon" ] []
- div [ clazz "default text"] defaultText
-
- Incremental.div (AttributeMap.ofList [clazz "ui menu"]) <| alist {
- for (_, (value, node)) in items do
- yield div [ clazz "ui item"; attribute "data-value" value] [node]
- }
- ]
- )
- )
+ match compare with
+ | Some cmp ->
+ let values = values |> AMap.toASet |> ASet.sortWith (fun (a, _) (b, _) -> cmp a b)
+ Dropdown.dropdownMultiSelect update false defaultText selected attributes values
+ | _ ->
+ Dropdown.dropdownMultiSelect update false defaultText selected attributes values
[]
type private AccordionInput<'msg> =
@@ -943,6 +980,7 @@ module SimplePrimitives =
member inline x.Run((a,v : aval<_>,cfg,msg)) =
Incremental.textbox cfg a v msg
+ []
type DropdownBuilder() =
member inline x.Yield(()) =
@@ -973,6 +1011,8 @@ module SimplePrimitives =
let simplenumeric<'a> = NumericBuilder<'a>()
let simplenumeric'<'T> = NumericBuilder2<'T>()
let simpletextbox = TextBuilder()
+
+ []
let simpledropdown = DropdownBuilder()
@@ -991,16 +1031,19 @@ module SimplePrimitives =
let inline textarea (cfg : TextAreaConfig) atts (state : aval) (update : string -> 'msg) =
Incremental.textarea cfg (att atts) state update
+ []
let inline dropdown (cfg : DropdownConfig) atts (values : amap<'a, DomNode<'msg>>) (selected : aval>) (update : Option<'a> -> 'msg) =
Incremental.dropdown cfg (att atts) values selected update
+ []
let inline dropdownUnclearable atts (values : amap<'a, DomNode<'msg>>) (selected : aval<'a>) (update : 'a -> 'msg) =
Incremental.dropdownUnclearable (att atts) values selected update
- []
+ []
let inline dropdownUnClearable atts (values : amap<'a, DomNode<'msg>>) (selected : aval<'a>) (update : 'a -> 'msg) =
Incremental.dropdownUnclearable (att atts) values selected update
+ []
let inline dropdownMultiSelect (attributes : AttributeMap<'msg>)
(compare : Option<'T -> 'T -> int>) (defaultText : string)
(values : amap<'T, DomNode<'msg>>) (selected : alist<'T>) (update : 'T list -> 'msg) =
diff --git a/src/Aardvark.UI.Primitives/Primitives/UI.Primitives.Simple.fs b/src/Aardvark.UI.Primitives/Primitives/UI.Primitives.Simple.fs
index 8f7c85b0..e77adb87 100644
--- a/src/Aardvark.UI.Primitives/Primitives/UI.Primitives.Simple.fs
+++ b/src/Aardvark.UI.Primitives/Primitives/UI.Primitives.Simple.fs
@@ -215,31 +215,11 @@ module Simple =
let largeTextArea (changed : string -> 'msg) (value : aval) =
largeTextArea' changed value AttributeMap.empty
+ []
let dropDown<'a, 'msg when 'a : comparison and 'a : equality> (att : list>) (current : aval<'a>) (update : 'a -> 'msg) (names : Map<'a, string>) : DomNode<'msg> =
-
- let mutable back = Map.empty
- let forth =
- names |> Map.map (fun a s ->
- let id = System.Guid.NewGuid()
- back <- Map.add id a back
- id
- )
-
- let selectedValue = current |> AVal.map (fun c -> Map.find c forth)
-
- let boot =
- String.concat "\r\n" [
- sprintf "$('#__ID__').dropdown().dropdown('set selected', '%s');" (string (AVal.force selectedValue))
- "current.onmessage = function(v) { $('#__ID__').dropdown('set selected', v); };"
- ]
-
- onBoot' ["current", AVal.channel selectedValue] boot (
- select ((onChange (fun str -> Map.find (str |> System.Guid.Parse) back |> update))::att) [
- for (value, name) in Map.toSeq names do
- let v = Map.find value forth
- yield option [attribute "value" (string v)] [ text name ]
- ]
- )
+ let values: seq<'a * DomNode<'msg>> = names |> Seq.map (fun (KeyValue(value, str)) -> value, text str)
+ Dropdown.dropdown update false None current att values
+ []
let allValues<'a when 'a : comparison> =
FSharpType.GetUnionCases(typeof<'a>,true) |> Array.map (fun c -> unbox<'a>(FSharpValue.MakeUnion(c, [||], true)), c.Name) |> Map.ofArray
\ No newline at end of file
diff --git a/src/Aardvark.UI.Primitives/resources/dropdown.js b/src/Aardvark.UI.Primitives/resources/dropdown.js
new file mode 100644
index 00000000..f37eefd5
--- /dev/null
+++ b/src/Aardvark.UI.Primitives/resources/dropdown.js
@@ -0,0 +1,40 @@
+if (!aardvark.dropdown) {
+ /**
+ * @param {*} x
+ * @param {*} y
+ */
+ function arraysIdentical(x, y) {
+ const a = Array.isArray(x) ? x : [x];
+ const b = Array.isArray(y) ? y : [y];
+ let i = a.length;
+ if (i != b.length) return false;
+ while (i--) {
+ if (a[i] !== b[i]) return false;
+ }
+ return true;
+ };
+
+ /**
+ * @param {HTMLElement[]} $self
+ * @param {string} trigger
+ * @param {{onmessage: function}} channel
+ */
+ aardvark.dropdown = function ($self, trigger, channel) {
+ $self.dropdown({
+ on: trigger,
+ onChange: function (value) { aardvark.processEvent($self[0].id, 'data-event', value); }
+ });
+
+ channel.onmessage = function(values) {
+ const curr = $self.dropdown('get values');
+
+ // Prevent resetting the same values (leads to flickering)
+ if (arraysIdentical(curr, values)) {
+ return;
+ }
+
+ $self.dropdown('clear', true);
+ $self.dropdown('set selected', values, true); // set exactly bugged? clear seems to trigger event
+ };
+ };
+}
\ No newline at end of file
diff --git a/src/Aardvark.UI/Core.fs b/src/Aardvark.UI/Core.fs
index 2ed82f02..35b015ad 100644
--- a/src/Aardvark.UI/Core.fs
+++ b/src/Aardvark.UI/Core.fs
@@ -16,36 +16,36 @@ open FSharp.Data.Traceable
type RenderControlConfig =
{
- adjustAspect : V2i -> Frustum -> Frustum
+ adjustAspect : V2i -> Frustum -> Frustum
}
module RenderControlConfig =
-
+
/// Fills height, depending in aspect ratio
- let standard =
+ let standard =
{
- adjustAspect = fun (size : V2i) -> Frustum.withAspect (float size.X / float size.Y)
+ adjustAspect = fun (size : V2i) -> Frustum.withAspect (float size.X / float size.Y)
}
/// Fills height, depending in aspect ratio
- let fillHeight = standard
+ let fillHeight = standard
/// Fills width, depending in aspect ratio
let fillWidth =
let aspect { left = l; right = r; top = t; bottom = b } = (t - b) / (r - l)
- let withAspectFlipped (newAspect : float) ( { left = l; right = r; top = t; bottom = b } as f) =
- let factor = 1.0 - (newAspect / aspect f)
+ let withAspectFlipped (newAspect : float) ( { left = l; right = r; top = t; bottom = b } as f) =
+ let factor = 1.0 - (newAspect / aspect f)
{ f with bottom = factor * t + b; top = factor * b + t }
{
- adjustAspect = fun (size : V2i) -> withAspectFlipped (float size.X / float size.Y)
+ adjustAspect = fun (size : V2i) -> withAspectFlipped (float size.X / float size.Y)
}
let noScaling =
{
adjustAspect = fun (size : V2i) (frustum : Frustum) -> frustum
}
-
+
[]
@@ -72,7 +72,7 @@ module Event =
let private processEvent (name : string) (id : string) (args : list) =
let args = sprintf "'%s'" id :: sprintf "'%s'" name :: args
sprintf "aardvark.processEvent(%s);" (String.concat ", " args)
-
+
let toString (id : string) (name : string) (evt : Event<'msg>) =
let send = processEvent name
evt.clientSide send id
@@ -98,16 +98,16 @@ module Event =
let create1 (a : string) (reaction : 'a -> 'msg) =
{
clientSide = fun send id -> send id [a]
- serverSide = fun session id args ->
+ serverSide = fun session id args ->
match args with
| [a] ->
- try
+ try
Seq.delay (fun () -> Seq.singleton (reaction (Pickler.json.UnPickleOfString a)))
with e ->
Log.warn "[UI] expected args (%s) but got (%A)" typename<'a> a
Seq.empty
- | _ ->
+ | _ ->
Log.warn "[UI] expected args (%s) but got %A" typename<'a> args
Seq.empty
}
@@ -115,16 +115,16 @@ module Event =
let create2 (a : string) (b : string) (reaction : 'a -> 'b -> 'msg) =
{
clientSide = fun send id -> send id [a; b]
- serverSide = fun session id args ->
+ serverSide = fun session id args ->
match args with
| [a; b] ->
- try
+ try
Seq.delay (fun () -> Seq.singleton (reaction (Pickler.json.UnPickleOfString a) (Pickler.json.UnPickleOfString b) ))
with e ->
Log.warn "[UI] expected args (%s, %s) but got (%A, %A)" typename<'a> typename<'b> a b
Seq.empty
- | _ ->
+ | _ ->
Log.warn "[UI] expected args (%s, %s) but got %A" typename<'a> typename<'b> args
Seq.empty
}
@@ -132,16 +132,16 @@ module Event =
let create3 (a : string) (b : string) (c : string) (reaction : 'a -> 'b -> 'c -> 'msg) =
{
clientSide = fun send id -> send id [a; b; c]
- serverSide = fun session id args ->
+ serverSide = fun session id args ->
match args with
| [a; b; c] ->
- try
+ try
Seq.delay (fun () -> Seq.singleton (reaction (Pickler.json.UnPickleOfString a) (Pickler.json.UnPickleOfString b) (Pickler.json.UnPickleOfString c)))
with e ->
Log.warn "[UI] expected args (%s, %s, %s) but got (%A, %A, %A)" typename<'a> typename<'b> typename<'c> a b c
Seq.empty
- | _ ->
+ | _ ->
Log.warn "[UI] expected args (%s, %s, %s) but got %A" typename<'a> typename<'b> typename<'c> args
Seq.empty
}
@@ -156,10 +156,10 @@ module Event =
match args with
| "0" :: args -> l.serverSide session id args
| "1" :: args -> r.serverSide session id args
- | _ ->
+ | _ ->
Log.warn "[UI] expected args ((1|2)::args) but got %A" args
Seq.empty
-
+
}
let combineMany (events : seq>) =
@@ -168,10 +168,10 @@ module Event =
match events.Length with
| 0 -> empty
| 1 -> events.[0]
- | _ ->
+ | _ ->
{
clientSide = fun send id ->
- let clientScripts =
+ let clientScripts =
events |> Seq.mapi (fun i e ->
e.clientSide (fun id args -> send id (string i :: args)) id
)
@@ -190,15 +190,15 @@ module Event =
| [] ->
Log.warn "[UI] expected at least one arg for dispatcher"
Seq.empty
-
-
-
+
+
+
}
- let map (f : 'a -> 'b) (e : Event<'a>) =
+ let map (f : 'a -> 'b) (e : Event<'a>) =
{
- clientSide = e.clientSide;
- serverSide = fun session id args -> Seq.map f (e.serverSide session id args)
+ clientSide = e.clientSide;
+ serverSide = fun session id args -> Seq.map f (e.serverSide session id args)
}
@@ -211,33 +211,33 @@ type AttributeValue<'msg> =
[]
module AttributeValue =
-
+
let combine (name : string) (l : AttributeValue<'msg>) (r : AttributeValue<'msg>) =
match name, l, r with
- | _, AttributeValue.Event l, AttributeValue.Event r ->
+ | _, AttributeValue.Event l, AttributeValue.Event r ->
AttributeValue.Event (Event.combine l r)
//| _, AttributeValue.RenderControlEvent l, AttributeValue.RenderControlEvent r ->
// AttributeValue.RenderControlEvent (fun a -> l a @ r a)
- | "class", AttributeValue.String l, AttributeValue.String r ->
+ | "class", AttributeValue.String l, AttributeValue.String r ->
AttributeValue.String (l + " " + r)
- | "style", AttributeValue.String l, AttributeValue.String r ->
+ | "style", AttributeValue.String l, AttributeValue.String r ->
AttributeValue.String (l + "; " + r)
- | _, AttributeValue.RenderEvent l, AttributeValue.RenderEvent r ->
- AttributeValue.RenderEvent (fun clientInfo ->
+ | _, AttributeValue.RenderEvent l, AttributeValue.RenderEvent r ->
+ AttributeValue.RenderEvent (fun clientInfo ->
seq {
yield! l clientInfo
yield! r clientInfo
}
)
- | _ ->
+ | _ ->
r
- let map (f : 'a -> 'b) (v : AttributeValue<'a>) =
+ let map (f : 'a -> 'b) (v : AttributeValue<'a>) =
match v with
| AttributeValue.Event e -> AttributeValue.Event (Event.map f e)
| AttributeValue.String s -> AttributeValue.String s
@@ -279,7 +279,7 @@ module AttributeMap =
match ovs with
| Some ovs ->
let vs = ovs |> MapExt.remove index
- if MapExt.isEmpty vs then
+ if MapExt.isEmpty vs then
deltas <- HashMap.add ok Remove deltas
None
else
@@ -292,7 +292,7 @@ module AttributeMap =
()
| Set(k, v) ->
store <- store |> HashMap.alter k (fun ovs ->
- let ovs =
+ let ovs =
match ovs with
| None -> MapExt.empty
| Some ovs -> ovs
@@ -304,7 +304,7 @@ module AttributeMap =
deltas |> HashMap.choose (fun k vs ->
match vs with
- | Set vs ->
+ | Set vs ->
(None, vs) ||> MapExt.fold (fun s _ v ->
match s with
| None -> Some v
@@ -317,7 +317,7 @@ module AttributeMap =
/// the empty attributes map
let empty<'msg> = AttributeMap<'msg>.Empty
-
+
/// creates an attribute-map with one single entry
let single (name : string) (value : AttributeValue<'msg>) =
AttributeMap(AMap.ofList [name, value])
@@ -376,7 +376,7 @@ module AttributeMap =
| None -> [value]
)
- let unique =
+ let unique =
groups |> HashMap.map (fun key values ->
match values with
| [v] -> v
@@ -409,7 +409,7 @@ module AttributeMap =
let map (mapping : string -> AttributeValue<'a> -> AttributeValue<'b>) (map : AttributeMap<'a>) =
AttributeMap(AMap.map mapping map.AMap)
-
+
let mapAttributes (mapping : AttributeValue<'a> -> AttributeValue<'b>) (map : AttributeMap<'a>) =
AttributeMap(AMap.map (fun _ v -> mapping v) map.AMap)
@@ -419,10 +419,26 @@ module AttributeMap =
let filter (predicate : string -> AttributeValue<'a> -> bool) (map : AttributeMap<'a>) =
AttributeMap(AMap.filter predicate map.AMap)
+ /// Adds the given class to the attribute map.
+ let addClass (clazz: string) (attributes: AttributeMap<'msg>) =
+ union attributes <| ofList ["class", AttributeValue.String clazz]
+
+ /// Removes the given class from the attribute map.
+ let removeClass (clazz: string) (attributes: AttributeMap<'msg>) =
+ attributes |> map (fun name attr ->
+ match name, attr with
+ | "class", AttributeValue.String str ->
+ String.split " " str
+ |> Array.filter (String.trim >> (<>) clazz)
+ |> String.concat " "
+ |> AttributeValue.String
+
+ | _, value -> value
+ )
type ReferenceKind =
- | Script
+ | Script
| Stylesheet
type Reference = { kind : ReferenceKind; name : string; url : string }
@@ -444,7 +460,7 @@ type SceneEventProcessor<'msg>() =
[]
module SceneEventProcessor =
-
+
[]
module Implementation =
type UnionProcessor<'msg>(inner : list>) =
@@ -456,7 +472,7 @@ module SceneEventProcessor =
)
override x.NeededEvents = needed.Value
- override x.Process(sender, e) =
+ override x.Process(sender, e) =
seq {
for p in inner do
yield! p.Process(sender, e)
@@ -501,7 +517,7 @@ type Channel() =
abstract member GetReader : unit -> ChannelReader
[]
-module ChannelThings =
+module ChannelThings =
type private ModChannelReader<'a>(m : aval<'a>) =
inherit ChannelReader()
@@ -530,15 +546,15 @@ module ChannelThings =
override x.ComputeMessages t =
let ops = reader.GetChanges t
ops |> HashSetDelta.toList |> List.map Pickler.json.PickleToString
-
+
type private AValChannel<'a>(m : aval<'a>) =
inherit Channel()
override x.GetReader() = new ModChannelReader<_>(m) :> ChannelReader
-
+
type private ASetChannel<'a>(m : aset<'a>) =
inherit Channel()
override x.GetReader() = new ASetChannelReader<_>(m) :> ChannelReader
-
+
type IAdaptiveValue<'a> with
member x.Channel = AValChannel(x) :> Channel
@@ -569,7 +585,7 @@ type RenderCommand<'msg> =
| None, Some d, None -> values.runtime.CompileClearDepth(values.signature, d)
| Some c, None, None -> values.runtime.CompileClear(values.signature, c)
| None, None, None -> RenderTask.empty
- | RenderCommand.SceneGraph sg ->
+ | RenderCommand.SceneGraph sg ->
let sg =
sg
|> Sg.viewTrafo values.viewTrafo
@@ -581,7 +597,7 @@ type IApp<'model, 'msg, 'outer> =
abstract member ToOuter : 'model * 'msg -> seq<'outer>
abstract member ToInner : 'model * 'outer -> seq<'msg>
abstract member Start : unit -> MutableApp<'model, 'msg>
-
+
and MutableApp<'model, 'msg> =
{
lock : obj
@@ -593,14 +609,14 @@ and MutableApp<'model, 'msg> =
shutdown : unit -> unit
}
-
+
and [] DomNode<'msg>() =
let mutable required : list = []
let mutable boot : Option string> = None
let mutable shutdown : Option string> = None
let mutable callbacks : Map -> 'msg)> = Map.empty
let mutable channels : Map = Map.empty
-
+
member x.Required
with get() = required
and set v = required <- v
@@ -658,7 +674,7 @@ and [] DomNode<'msg>() =
member x.SubApp n = DomNode.SubApp(n.App).WithAttributesFrom n
member x.Map n = DomNode.Map(n.Mapping, n.Node).WithAttributesFrom n
}
-
+
member x.WithRequired r =
let res = x.Clone()
res.Required <- r
@@ -685,11 +701,11 @@ and [] DomNode<'msg>() =
res
member x.AddRequired r = x.WithRequired (x.Required @ r)
- member x.AddBoot r =
+ member x.AddBoot r =
match x.Boot with
| None -> x.WithBoot (Some r)
| Some b -> x.WithBoot (Some (fun self -> b self + ";" + r self))
- member x.AddShutdown r =
+ member x.AddShutdown r =
match x.Shutdown with
| None -> x.WithShutdown (Some r)
| Some b -> x.WithShutdown (Some (fun self -> b self + ";" + r self))
@@ -755,7 +771,7 @@ and MapNode<'inner, 'outer>(mapping : 'inner -> 'outer, node : DomNode<'inner>)
member x.Node : DomNode<'inner> = node
override x.Visit v = v.Map x
override x.NodeTag = node.NodeTag
-
+
and DomNodeVisitor<'msg, 'r> =
abstract member Empty : EmptyNode<'msg> -> 'r
abstract member Inner : InnerNode<'msg> -> 'r
@@ -790,7 +806,7 @@ and DomNode private() =
| 3 -> MouseButtons.Right
| _ -> MouseButtons.None
- static member Empty<'msg>() : DomNode<'msg> =
+ static member Empty<'msg>() : DomNode<'msg> =
EmptyNode<'msg>() :> DomNode<'msg>
static member Element<'msg>(tag : string, ns : Option, attributes : AttributeMap<'msg>, children : alist>) : DomNode<'msg> =
@@ -798,7 +814,7 @@ and DomNode private() =
static member Element<'msg>(tag : string, ns : Option, attributes : AttributeMap<'msg>) : DomNode<'msg> =
VoidNode(tag, ns, attributes) :> DomNode<_>
-
+
static member Scene<'msg>(attributes : AttributeMap<'msg>, scene : Aardvark.Service.Scene, getClientState : Aardvark.Service.ClientInfo -> Aardvark.Service.ClientState) : DomNode<'msg> =
SceneNode(attributes, scene, getClientState) :> DomNode<_>
@@ -813,40 +829,40 @@ and DomNode private() =
static member SubApp<'model, 'inner, 'outer>(app : IApp<'model, 'inner, 'outer>) : DomNode<'outer> =
SubAppNode<'model, 'inner, 'outer>(app) :> DomNode<_>
-
- static member Text(content : aval) =
+
+ static member Text(content : aval) =
DomNode.Text("span", None, AttributeMap.empty, content)
-
- static member SvgText(content : aval) =
+
+ static member SvgText(content : aval) =
DomNode.Text("tspan", Some "http://www.w3.org/2000/svg", AttributeMap.empty, content)
static member Void(tag : string, attributes : AttributeMap<'msg>) =
- DomNode.Element(tag, None, attributes)
+ DomNode.Element(tag, None, attributes)
static member Node(tag : string, attributes : AttributeMap<'msg>, content : alist>) =
DomNode.Element(tag, None, attributes, content)
static member Void(tag : string, ns : string, attributes : AttributeMap<'msg>) =
- DomNode.Element(tag, Some ns, attributes)
+ DomNode.Element(tag, Some ns, attributes)
static member Node(tag : string, ns : string, attributes : AttributeMap<'msg>, content : alist>) =
DomNode.Element(tag, Some ns, attributes, content)
- static member RenderControl(attributes : AttributeMap<'msg>, processor : SceneEventProcessor<'msg>, getState : Aardvark.Service.ClientInfo -> Aardvark.Service.ClientState,
+ static member RenderControl(attributes : AttributeMap<'msg>, processor : SceneEventProcessor<'msg>, getState : Aardvark.Service.ClientInfo -> Aardvark.Service.ClientState,
scene : Aardvark.Service.Scene, htmlChildren : Option>) =
let perform (sourceSession : Guid, sourceId : string, kind : SceneEventKind, buttons : MouseButtons, alt: bool, shift: bool, ctrl: bool, pos : V2i) : seq<'msg> =
match scene.TryGetClientInfo(sourceSession, sourceId) with
- | Some (info, state) ->
+ | Some (info, state) ->
let pp = PixelPosition(pos.X, pos.Y, info.size.X, info.size.Y)
let ray = state |> ClientState.pickRay pp |> FastRay3d |> RayPart
- let evt =
+ let evt =
{
evtKind = kind
evtPixel = pos
- evtRay = ray
+ evtRay = ray
evtButtons = buttons
evtAlt = alt
evtShift = shift
@@ -865,7 +881,7 @@ and DomNode private() =
// | Some cb ->
// cb.s
// cb evt @ procRes
- // | None ->
+ // | None ->
// procRes
| None ->
@@ -890,7 +906,7 @@ and DomNode private() =
let ctrl = Boolean.Parse ctrl
perform(session, id, kind, button, alt, shift, ctrl, V2i(x,y))
- | x :: y :: alt :: shift :: ctrl :: _ ->
+ | x :: y :: alt :: shift :: ctrl :: _ ->
let vx = round (float x) |> int
let vy = round (float y) |> int
let alt = Boolean.Parse alt
@@ -900,18 +916,18 @@ and DomNode private() =
| _ ->
Seq.empty
-
+
}
let events =
- processor.NeededEvents
- |> ASet.map (fun k ->
- let kind =
+ processor.NeededEvents
+ |> ASet.map (fun k ->
+ let kind =
match k with
| SceneEventKind.Enter | SceneEventKind.Leave -> SceneEventKind.Move
| _ -> k
-
+
let button = needsButton kind
eventNames.[kind], AttributeValue.Event(rayEvent button kind)
)
@@ -921,7 +937,7 @@ and DomNode private() =
| [] -> AttributeValue.Event Event.empty
| h :: rest ->
rest |> List.fold (AttributeValue.combine "urdar") h
-
+
)
|> AttributeMap.ofAMap
@@ -937,18 +953,18 @@ and DomNode private() =
match htmlChildren with
- | Some htmlChildren ->
+ | Some htmlChildren ->
printfn "not implemented"
DomNode.Scene(ownAttributes, scene, getState).WithBoot(Some boot)
- | None ->
+ | None ->
DomNode.Scene(ownAttributes, scene, getState).WithBoot(Some boot)
- static member RenderControl(attributes : AttributeMap<'msg>, getState : Aardvark.Service.ClientInfo -> Aardvark.Service.ClientState,
+ static member RenderControl(attributes : AttributeMap<'msg>, getState : Aardvark.Service.ClientInfo -> Aardvark.Service.ClientState,
scene : Aardvark.Service.Scene, htmlChildren : Option>) =
DomNode.RenderControl(attributes, SceneEventProcessor.empty, getState, scene, htmlChildren)
-
+
static member RenderControl(attributes : AttributeMap<'msg>, camera : aval, scene : Aardvark.Service.Scene, htmlChildren : Option>) =
let getState(c : Aardvark.Service.ClientInfo) =
let cam = camera.GetValue(c.token)
@@ -960,10 +976,10 @@ and DomNode private() =
}
DomNode.RenderControl(attributes, SceneEventProcessor.empty, getState, scene, htmlChildren)
-
-
-
+
+
+
static member RenderControl(attributes : AttributeMap<'msg>, camera : aval, sg : ClientValues -> ISg<'msg>, config: RenderControlConfig, htmlChildren : Option>) =
@@ -978,7 +994,7 @@ and DomNode private() =
let tree = AVal.init <| PickTree.ofSg (Sg.ofList [])
let globalPicks = AVal.init AMap.empty
-
+
let scene =
Scene.custom (fun values ->
let sg =
@@ -988,35 +1004,35 @@ and DomNode private() =
|> Sg.uniform "ViewportSize" values.size
transact ( fun _ -> tree.Value <- PickTree.ofSg sg )
-
- transact ( fun _ -> globalPicks.Value <- sg.GlobalPicks(Ag.Scope.Root) )
-
+
+ transact ( fun _ -> globalPicks.Value <- sg.GlobalPicks(Ag.Scope.Root) )
+
values.runtime.CompileRender(values.signature, sg)
)
let proc =
{ new SceneEventProcessor<'msg>() with
- member x.NeededEvents =
+ member x.NeededEvents =
aset {
let! tree = tree
let! globalPicks = globalPicks
yield! ASet.union (AMap.keys globalPicks) tree.Needed
}
- member x.Process (source : Guid, evt : SceneEvent) =
+ member x.Process (source : Guid, evt : SceneEvent) =
seq {
let consumed, msgs = tree.GetValue().Perform(evt)
yield! msgs
let m = globalPicks.GetValue().Content |> AVal.force
match m |> HashMap.tryFind evt.kind with
- | Some cb ->
+ | Some cb ->
yield! cb evt
- | None ->
+ | None ->
()
}
}
-
+
DomNode.RenderControl(attributes, proc, getState, scene, htmlChildren)
static member RenderControl(attributes : AttributeMap<'msg>, camera : aval, sg : ISg<'msg>, config: RenderControlConfig, htmlChildren : Option>) =
@@ -1047,14 +1063,14 @@ and DomNode private() =
let sgs = sgs values
- let t =
+ let t =
sgs |> AList.choose (function RenderCommand.Clear _ -> None | SceneGraph sg -> PickTree.ofSg sg |> Some)
- let g =
+ let g =
sgs |> AList.toASet |> ASet.choose (function RenderCommand.Clear _ -> None | SceneGraph sg -> sg.GlobalPicks(Ag.Scope.Root) |> Some)
transact (fun _ -> trees.Value <- t; globalPicks.Value <- g)
- let mutable reader : IOpReader, IndexListDelta> =
+ let mutable reader : IOpReader, IndexListDelta> =
let mutable state = IndexList.empty
let input = sgs.GetReader()
{ new AbstractReader, IndexListDelta>(IndexList.trace) with
@@ -1070,7 +1086,7 @@ and DomNode private() =
| Remove ->
match x.State.TryGet index with
- | Some o ->
+ | Some o ->
o.Dispose()
Some Remove
| None -> None
@@ -1085,14 +1101,14 @@ and DomNode private() =
()
{ new AbstractRenderTask() with
- override x.PerformUpdate(t,rt) =
+ override x.PerformUpdate(t,rt) =
update t
- override x.Perform(t,rt,o) =
+ override x.Perform(t,rt,o) =
update t
for task in reader.State do
task.Run(t,rt,o)
- override x.Release() =
- for task in reader.State do
+ override x.Release() =
+ for task in reader.State do
task.Dispose()
reader <- Unchecked.defaultof<_>
@@ -1109,7 +1125,7 @@ and DomNode private() =
let rec pickTrees (trees : list>) (evt) =
match trees with
| [] -> false, Seq.empty
- | x::xs ->
+ | x::xs ->
let consumed,msgs = pickTrees xs evt
if consumed then true,msgs
else
@@ -1119,7 +1135,7 @@ and DomNode private() =
let proc =
{ new SceneEventProcessor<'msg>() with
member x.NeededEvents = needed
- member x.Process (source : Guid, evt : SceneEvent) =
+ member x.Process (source : Guid, evt : SceneEvent) =
let trees = trees |> AVal.force
let trees = trees.Content |> AVal.force |> IndexList.toList
let globalPicks = globalPicks |> AVal.force
@@ -1128,9 +1144,9 @@ and DomNode private() =
for perScene in globalPicks.Content |> AVal.force do
let picks = perScene.Content |> AVal.force
match picks |> HashMap.tryFind evt.kind with
- | Some cb ->
+ | Some cb ->
yield! cb evt
- | None ->
+ | None ->
()
}
}
@@ -1150,7 +1166,7 @@ and DomNode private() =
let scene =
Scene.custom (fun values ->
- let mutable reader : IOpReader, IndexListDelta> =
+ let mutable reader : IOpReader, IndexListDelta> =
let mutable state = IndexList.empty
let input = sgs.GetReader()
{ new AbstractReader, IndexListDelta>(IndexList.trace) with
@@ -1166,7 +1182,7 @@ and DomNode private() =
| Remove ->
match x.State.TryGet index with
- | Some o ->
+ | Some o ->
o.Dispose()
Some Remove
| None -> None
@@ -1179,14 +1195,14 @@ and DomNode private() =
()
{ new AbstractRenderTask() with
- override x.PerformUpdate(t,rt) =
+ override x.PerformUpdate(t,rt) =
update t
- override x.Perform(t,rt,o) =
+ override x.Perform(t,rt,o) =
update t
for task in reader.State do
task.Run(t,rt,o)
- override x.Release() =
- for t in reader.State do
+ override x.Release() =
+ for t in reader.State do
t.Dispose()
reader <- Unchecked.defaultof<_>
@@ -1209,7 +1225,7 @@ and DomNode private() =
let rec pickTrees (trees : list>) (evt) =
match trees with
| [] -> false, Seq.empty
- | x::xs ->
+ | x::xs ->
let consumed,msgs = pickTrees xs evt
if consumed then true,msgs
else
@@ -1219,7 +1235,7 @@ and DomNode private() =
let proc =
{ new SceneEventProcessor<'msg>() with
member x.NeededEvents = needed
- member x.Process (source : Guid, evt : SceneEvent) =
+ member x.Process (source : Guid, evt : SceneEvent) =
let trees = trees.Content |> AVal.force |> IndexList.toList
seq {
let consumed, msgs = pickTrees trees evt
@@ -1228,9 +1244,9 @@ and DomNode private() =
for perScene in globalPicks.Content |> AVal.force do
let picks = perScene.Content |> AVal.force
match picks |> HashMap.tryFind evt.kind with
- | Some cb ->
+ | Some cb ->
yield! cb evt
- | None ->
+ | None ->
()
}
}
diff --git a/src/Examples (dotnetcore)/23 - Inputs/App.fs b/src/Examples (dotnetcore)/23 - Inputs/App.fs
index d50953d5..635d4f72 100644
--- a/src/Examples (dotnetcore)/23 - Inputs/App.fs
+++ b/src/Examples (dotnetcore)/23 - Inputs/App.fs
@@ -66,11 +66,6 @@ let update (model : Model) (msg : Message) =
let view (model : AdaptiveModel) =
let alternatives = model.options |> AMap.map (fun _ v -> text v)
- let enumValues : amap> =
- Enum.GetValues()
- |> Array.map (fun e -> e, text (string e))
- |> AMap.ofArray
-
let description (str : string) =
div [ style "margin-bottom: 10px" ] [ text str ]
@@ -183,23 +178,23 @@ let view (model : AdaptiveModel) =
text "Dropdown menus", div [ clazz "menu" ] [
div [ clazz "item" ] [
description "Non-clearable"
- dropdownUnclearable [ clazz "inverted selection" ] enumValues model.enumValue SetEnumValue
+ Dropdown.dropdownEnum SetEnumValue false None model.enumValue [ clazz "inverted" ] None
]
div [ clazz "item" ] [
description "Clearable"
- dropdown { mode = DropdownMode.Text <| Some "blub"; onTrigger = TriggerDropdown.Hover } [ clazz "inverted selection" ] alternatives model.alt SetAlternative
+ Dropdown.dropdownOption SetAlternative true None "Select..." model.alt [ clazz "inverted clearable" ] alternatives
]
div [ clazz "item" ] [
description "Icon mode"
- dropdown { mode = DropdownMode.Icon "sidebar"; onTrigger = TriggerDropdown.Hover } [ clazz "inverted icon top left pointing dropdown circular button" ] alternatives model.alt SetAlternative
+ Dropdown.dropdownOption SetAlternative true (Some "sidebar") "" model.alt [ clazz "inverted icon top left pointing dropdown circular button" ] alternatives
]
div [ clazz "item" ] [
description "Multi select"
let atts = AttributeMap.ofList [clazz "inverted clearable search"]
- dropdownMultiSelect atts None "Search..." alternatives model.alts SetAlternatives
+ Dropdown.dropdownMultiSelect SetAlternatives false "Search..." model.alts atts alternatives
]
]
diff --git a/src/Examples (dotnetcore)/28 - Notifications/App.fs b/src/Examples (dotnetcore)/28 - Notifications/App.fs
index 91b1c939..a9e0faec 100644
--- a/src/Examples (dotnetcore)/28 - Notifications/App.fs
+++ b/src/Examples (dotnetcore)/28 - Notifications/App.fs
@@ -133,24 +133,17 @@ let view (model : AdaptiveModel) =
text "Remove"
]
- let values =
- Enum.GetValues()
- |> Array.map (fun p ->
- let n =
- match p with
- | Position.TopRight -> text "Top Right"
- | Position.TopLeft -> text "Top Left"
- | Position.TopCenter -> text "Top Center"
- | Position.TopAttached -> text "Top Attached"
- | Position.BottomRight -> text "Bottom Right"
- | Position.BottomLeft -> text "Bottom Left"
- | Position.BottomCenter -> text "Bottom Center"
- | _ -> text "Bottom Attached"
- p, n
- )
- |> AMap.ofArray
-
- dropdownUnclearable [clazz "selection"; style "margin: 10px"] values model.position SetPosition
+ let values = Some <| function
+ | Position.TopRight -> text "Top Right"
+ | Position.TopLeft -> text "Top Left"
+ | Position.TopCenter -> text "Top Center"
+ | Position.TopAttached -> text "Top Attached"
+ | Position.BottomRight -> text "Bottom Right"
+ | Position.BottomLeft -> text "Bottom Left"
+ | Position.BottomCenter -> text "Bottom Center"
+ | _ -> text "Bottom Attached"
+
+ Dropdown.dropdownEnum SetPosition false None model.position [clazz "selection"; style "margin: 10px"] values
]
]
diff --git a/src/Scratch/02 - DrawRects/App.fs b/src/Scratch/02 - DrawRects/App.fs
index fb44b197..cb6089b0 100644
--- a/src/Scratch/02 - DrawRects/App.fs
+++ b/src/Scratch/02 - DrawRects/App.fs
@@ -273,7 +273,7 @@ module ClientApp =
yield br []
yield text "Color Mode: "
yield div [] [
- dropDown [] colorMode (changeMode >> SetColorMode) (Map.ofList [ "Constant", "Constant"; "Vertical Gradient", "Vertical Gradient";"Horizontal Gradient", "Horizontal Gradient";"Points", "Points"])
+ Dropdown.dropdown (changeMode >> SetColorMode) false None colorMode AttributeMap.empty [ "Constant", text "Constant"; "Vertical Gradient", text "Vertical Gradient";"Horizontal Gradient", text "Horizontal Gradient";"Points", text "Points"]
]
yield button [style "ui small red button"; onClick (fun _ -> Delete id)] [text "Delete"]
]
diff --git a/src/Scratch/27 - NavigationDemoNew/App.fs b/src/Scratch/27 - NavigationDemoNew/App.fs
index 9a52b648..13a76be2 100644
--- a/src/Scratch/27 - NavigationDemoNew/App.fs
+++ b/src/Scratch/27 - NavigationDemoNew/App.fs
@@ -180,9 +180,7 @@ let view (model : AdaptiveModel) =
br []
br []
- //Html.SemUi.dropDown model.mode SetMode
- let enumValues = AMap.ofArray((System.Enum.GetValues typeof :?> (CameraMode [])) |> Array.map (fun c -> (c, text (System.Enum.GetName(typeof, c)) )))
- dropdownUnclearable [ clazz "ui inverted selection dropdown" ] enumValues model.mode SetMode
+ Dropdown.dropdownEnum SetMode false None model.mode [ clazz "ui inverted selection dropdown" ] None
br []
br []
]
diff --git a/src/Scratch/27 - NavigationDemoNew/Program.fs b/src/Scratch/27 - NavigationDemoNew/Program.fs
index 65ec9969..4111c583 100644
--- a/src/Scratch/27 - NavigationDemoNew/Program.fs
+++ b/src/Scratch/27 - NavigationDemoNew/Program.fs
@@ -27,6 +27,7 @@ let main argv =
// 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
+ Reflection.assemblyWebPart typeof.Assembly
Suave.Files.browseHome
] |> ignore