diff --git a/src/Avalonia.FuncUI.DSL/Avalonia.FuncUI.DSL.fsproj b/src/Avalonia.FuncUI.DSL/Avalonia.FuncUI.DSL.fsproj index 835b5249..360b24b6 100644 --- a/src/Avalonia.FuncUI.DSL/Avalonia.FuncUI.DSL.fsproj +++ b/src/Avalonia.FuncUI.DSL/Avalonia.FuncUI.DSL.fsproj @@ -105,6 +105,8 @@ + + diff --git a/src/Avalonia.FuncUI.DSL/ComboBox.fs b/src/Avalonia.FuncUI.DSL/ComboBox.fs index 2126e951..6e635265 100644 --- a/src/Avalonia.FuncUI.DSL/ComboBox.fs +++ b/src/Avalonia.FuncUI.DSL/ComboBox.fs @@ -25,4 +25,8 @@ module ComboBox = AttrBuilder<'t>.CreateProperty(ComboBox.VerticalContentAlignmentProperty, alignment, ValueNone) static member virtualizationMode<'t when 't :> ComboBox>(mode: ItemVirtualizationMode) : IAttr<'t> = - AttrBuilder<'t>.CreateProperty(ComboBox.VirtualizationModeProperty, mode, ValueNone) \ No newline at end of file + AttrBuilder<'t>.CreateProperty(ComboBox.VirtualizationModeProperty, mode, ValueNone) + + static member controlledSelectedIndex<'t when 't :> ComboBox>(value: int, onChange: int -> unit) = + AttrBuilder<'t>.CreateControlledProperty(ComboBox.SelectedIndexProperty, value, onChange, ValueNone) + \ No newline at end of file diff --git a/src/Avalonia.FuncUI.DSL/ControlledCheckBox.fs b/src/Avalonia.FuncUI.DSL/ControlledCheckBox.fs new file mode 100644 index 00000000..d76d749d --- /dev/null +++ b/src/Avalonia.FuncUI.DSL/ControlledCheckBox.fs @@ -0,0 +1,23 @@ +namespace Avalonia.FuncUI.DSL + +open Avalonia.FuncUI.Controls + +[] +module ControlledCheckBox = + open Avalonia.FuncUI.Builder + open Avalonia.FuncUI.Types + + let create (attrs: IAttr list): IView = + ViewBuilder.Create(attrs) + + type ControlledCheckBox with + static member value<'t when 't :> ControlledCheckBox> state = + let getter : 't -> CheckBoxState = fun c -> c.State() + let setter : ('t * CheckBoxState) -> unit = (fun (c, v) -> v |> c.MutateControlledValue) + AttrBuilder<'t>.CreateProperty("Value", state, ValueSome getter, ValueSome setter, ValueNone) + + static member onChange<'t when 't :> ControlledCheckBox> fn = + let getter : 't -> (CheckBoxEventArgs -> unit) = fun c -> c.OnChangeCallback + let setter : ('t * (CheckBoxEventArgs -> unit)) -> unit = + (fun (c, f) -> c.OnChangeCallback <- f) + AttrBuilder.CreateProperty unit>("OnChange", fn, ValueSome getter, ValueSome setter, ValueNone) diff --git a/src/Avalonia.FuncUI.DSL/ControlledTextBox.fs b/src/Avalonia.FuncUI.DSL/ControlledTextBox.fs new file mode 100644 index 00000000..1127e954 --- /dev/null +++ b/src/Avalonia.FuncUI.DSL/ControlledTextBox.fs @@ -0,0 +1,28 @@ +namespace Avalonia.FuncUI.DSL + +open Avalonia.FuncUI.Controls +open Avalonia.Input + +[] +module ControlledTextBox = + open Avalonia.FuncUI.Builder + open Avalonia.FuncUI.Types + + let create (attrs: IAttr list): IView = + ViewBuilder.Create(attrs) + + type ControlledTextBox with + + static member value<'t when 't :> ControlledTextBox> str = + let getter : 't -> string = fun c -> c.Text + let setter : ('t * string) -> unit = (fun (c, v) -> v |> c.MutateControlledValue) + + AttrBuilder<'t>.CreateProperty("Value", str, ValueSome getter, ValueSome setter, ValueNone) + + static member onChange<'t when 't :> ControlledTextBox> fn = + let getter : 't -> (TextInputEventArgs -> unit) = fun c -> c.OnChangeCallback + let setter : ('t * (TextInputEventArgs -> unit)) -> unit = + (fun (c, f) -> c.OnChangeCallback <- f) + + AttrBuilder<'t>.CreateProperty unit>("OnChange", fn, ValueSome getter, ValueSome setter, ValueNone) + \ No newline at end of file diff --git a/src/Avalonia.FuncUI.DSL/Expander.fs b/src/Avalonia.FuncUI.DSL/Expander.fs index 73c44e85..77416824 100644 --- a/src/Avalonia.FuncUI.DSL/Expander.fs +++ b/src/Avalonia.FuncUI.DSL/Expander.fs @@ -23,3 +23,7 @@ module Expander = static member onIsExpandedChanged<'t when 't :> Expander>(func: bool -> unit, ?subPatchOptions: SubPatchOptions) : IAttr<'t> = AttrBuilder<'t>.CreateSubscription(Expander.IsExpandedProperty, func, ?subPatchOptions = subPatchOptions) + + static member controlledIsExpanded<'t when 't :> Expander>(value: bool, fn: bool -> unit, ?subPatchOptions: SubPatchOptions) : IAttr<'t> = + AttrBuilder<'t>.CreateControlledProperty(Expander.IsExpandedProperty, value, fn, ValueNone, ?subPatchOptions = subPatchOptions) + \ No newline at end of file diff --git a/src/Avalonia.FuncUI.sln b/src/Avalonia.FuncUI.sln index 50800b75..0ad6ebe8 100644 --- a/src/Avalonia.FuncUI.sln +++ b/src/Avalonia.FuncUI.sln @@ -29,6 +29,8 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Examples.Presso", "Examples EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Examples.MusicPlayer", "Examples\Examples.MusicPlayer\Examples.MusicPlayer.fsproj", "{C9BF89F2-6DE8-4F37-A6AD-6D40E982F265}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Examples.ControlledComponents", "Examples\Examples.ControlledComponents\Examples.ControlledComponents.fsproj", "{F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -75,6 +77,10 @@ Global {C9BF89F2-6DE8-4F37-A6AD-6D40E982F265}.Debug|Any CPU.Build.0 = Debug|Any CPU {C9BF89F2-6DE8-4F37-A6AD-6D40E982F265}.Release|Any CPU.ActiveCfg = Release|Any CPU {C9BF89F2-6DE8-4F37-A6AD-6D40E982F265}.Release|Any CPU.Build.0 = Release|Any CPU + {F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369}.Debug|Any CPU.Build.0 = Debug|Any CPU + {F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369}.Release|Any CPU.ActiveCfg = Release|Any CPU + {F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -87,6 +93,7 @@ Global {1401B46D-1F14-4D29-8E45-96E62D46405F} = {F6F4AAF7-2BDA-4D2F-B78D-F6D8A03F660E} {7A0CA9E2-AFB8-4BA0-A725-F80EB98717C4} = {F6F4AAF7-2BDA-4D2F-B78D-F6D8A03F660E} {C9BF89F2-6DE8-4F37-A6AD-6D40E982F265} = {F6F4AAF7-2BDA-4D2F-B78D-F6D8A03F660E} + {F23A44E1-3D11-4DF9-AC4B-2CDA42EF9369} = {F6F4AAF7-2BDA-4D2F-B78D-F6D8A03F660E} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {4630E817-6780-4C98-9379-EA3B45224339} diff --git a/src/Avalonia.FuncUI/Avalonia.FuncUI.fsproj b/src/Avalonia.FuncUI/Avalonia.FuncUI.fsproj index ea05478a..1d1fe3dd 100644 --- a/src/Avalonia.FuncUI/Avalonia.FuncUI.fsproj +++ b/src/Avalonia.FuncUI/Avalonia.FuncUI.fsproj @@ -17,6 +17,7 @@ + @@ -33,6 +34,9 @@ + + + diff --git a/src/Avalonia.FuncUI/Builder.fs b/src/Avalonia.FuncUI/Builder.fs index 42d1ca19..82288594 100644 --- a/src/Avalonia.FuncUI/Builder.fs +++ b/src/Avalonia.FuncUI/Builder.fs @@ -16,10 +16,10 @@ type [] SubPatchOptions = | Never -> null | OnChangeOf t -> t - namespace Avalonia.FuncUI.Builder open System +open System.Reactive.Linq open System.Threading open Avalonia @@ -29,6 +29,8 @@ open Avalonia.FuncUI.DSL open Avalonia.FuncUI.Types open Avalonia.FuncUI.Library +type Comparer = obj * obj -> bool + module private Helpers = let wrappedGetter<'view, 'value>(func: 'view -> 'value) : IControl -> obj = let wrapper (control: IControl) : obj = @@ -43,8 +45,61 @@ module private Helpers = let value = value :?> 'value func(view, value) wrapper - -type Comparer = obj * obj -> bool + + let controlAvaloniaProperty<'arg> (p: AvaloniaProperty<'arg>) (c: IControl) (func: obj -> unit) = + let mutable isControlling = false + let uncontrolledChanges = + c.GetPropertyChangedObservable(p).Where(fun _ -> isControlling = false) + let onUncontrolledChange (e: AvaloniaPropertyChangedEventArgs) = + // Reset value + isControlling <- true + c.SetValue(p, e.OldValue) |> ignore + isControlling <- false + // Submit value to callback + e.NewValue |> func + let setValue (v: obj) = + isControlling <- true + let value = v :?> 'arg + c.SetValue(p, value) |> ignore + isControlling <- false + let cts = new CancellationTokenSource() + uncontrolledChanges.Subscribe(onUncontrolledChange, cts.Token) + { SetControlledValue = setValue; Cancellation = cts } + + let toScope (spo: SubPatchOptions option) = + let v = spo |> Option.defaultValue SubPatchOptions.Never + v.ToScope() + + let toProperty (accessor, value: obj, comparer: Comparer voption, defaultValueFactory) = + { Accessor = accessor + Value = value + Comparer = comparer + DefaultValueFactory = defaultValueFactory } + + let toSubscription (name, subscribeFunc, func, subPatchOptions) = + { Name = name + Subscribe = subscribeFunc + Func = Action<_>(func) + FuncType = func.GetType() + Scope = subPatchOptions |> toScope } + + let toControlledProperty (makeController, property, func, subPatchOptions) = + { MakeController = makeController + Property = property + Func = func + FuncType = func.GetType() + Scope = subPatchOptions |> toScope } + + let toInstanceAccessor (name, getter, setter) = + Accessor.InstanceProperty { + Name = name + Getter = getter |> ValueOption.map wrappedGetter + Setter = setter |> ValueOption.map wrappedSetter + } + + let toPropertyAttr p = p |> Attr<'view>.Property :> IAttr<'view> + let toSubAttr s = s |> Attr<'view>.Subscription :> IAttr<'view> + let toControlledPropertyAttr cp = cp |> Attr<'view>.ControlledProperty :> IAttr<'view> [] type AttrBuilder<'view>() = @@ -57,48 +112,30 @@ type AttrBuilder<'view>() = attr :> IAttr<'view> static member private CreateProperty(accessor: Accessor, value: obj, comparer, defaultValueFactory) : IAttr<'view> = - let attr = Attr<'view>.Property { - Accessor = accessor - Value = value - Comparer = comparer - DefaultValueFactory = defaultValueFactory - } - attr :> IAttr<'view> + (accessor, value, comparer, defaultValueFactory) |> Helpers.toProperty |> Helpers.toPropertyAttr - /// Create a Property Attribute for an Avalonia Property + // Create a Property Attribute for an Avalonia Property static member CreateProperty<'value>(property: AvaloniaProperty, value: 'value, comparer) : IAttr<'view> = - AttrBuilder<'view>.CreateProperty(Accessor.AvaloniaProperty property, value :> obj, comparer, ValueNone) + let accessor = property |> Accessor.AvaloniaProperty + AttrBuilder.CreateProperty(accessor, value, comparer, ValueNone) - /// Create a Property Attribute for an Avalonia Property + // Create a Property Attribute for an Avalonia Property static member CreateProperty<'value>(property: AvaloniaProperty, value: 'value, comparer, defaultValueFactory: (unit -> 'value)) : IAttr<'view> = + let accessor = property |> Accessor.AvaloniaProperty let objFactory = (fun () -> defaultValueFactory() :> obj) |> ValueSome - AttrBuilder<'view>.CreateProperty(Accessor.AvaloniaProperty property, value :> obj, comparer, objFactory) + AttrBuilder.CreateProperty(accessor, value, comparer, objFactory) - /// Create a Property Attribute for an instance (non Avalonia) Property + // Create a Property Attribute for an instance (non Avalonia) Property static member private CreateInstanceProperty<'value>(name: string, value: 'value, getter: ('view -> 'value) voption, setter: ('view * 'value -> unit) voption, comparer: Comparer voption, defaultValueFactory: (unit -> 'value) voption): IAttr<'view> = - let accessor = Accessor.InstanceProperty { - Name = name - Getter = - match getter with - | ValueSome getter -> Helpers.wrappedGetter<'view, 'value>(getter) |> ValueSome - | ValueNone -> ValueNone - Setter = - match setter with - | ValueSome setter -> Helpers.wrappedSetter<'view, 'value>(setter) |> ValueSome - | ValueNone -> ValueNone - } - - let defValueFactory = defaultValueFactory |> ValueOption.map (fun f -> fun () -> f() :> obj) - + let accessor = (name, getter, setter) |> Helpers.toInstanceAccessor + let defValueFactory = defaultValueFactory |> ValueOption.map (fun f -> fun () -> f() :> obj) AttrBuilder.CreateProperty(accessor, value, comparer, defValueFactory) - /// Create a Property Attribute for an instance (non Avalonia) Property + // Create a Property Attribute for an instance (non Avalonia) Property static member CreateProperty<'value>(name, value, getter, setter, comparer, defaultValueFactory): IAttr<'view> = AttrBuilder<'view>.CreateInstanceProperty<'value>(name, value, getter, setter, comparer, defaultValueFactory |> ValueSome) - /// - /// Create a Property Attribute for an instance (non Avalonia) Property - /// + // Create a Property Attribute for an instance (non Avalonia) Property static member CreateProperty<'value>(name, value, getter, setter, comparer): IAttr<'view> = AttrBuilder<'view>.CreateInstanceProperty<'value>(name, value, getter, setter, comparer, ValueNone) @@ -112,17 +149,7 @@ type AttrBuilder<'view>() = /// Create a Single Content Attribute for an instance (non Avalonia) Property /// static member CreateContentSingle(name: string, getter, setter, singleContent: IView option) : IAttr<'view> = - let accessor = Accessor.InstanceProperty { - Name = name - Getter = - match getter with - | ValueSome getter -> Helpers.wrappedGetter<'view, obj>(getter) |> ValueSome - | ValueNone -> ValueNone - Setter = - match setter with - | ValueSome setter -> Helpers.wrappedSetter<'view, obj>(setter) |> ValueSome - | ValueNone -> ValueNone - } + let accessor = (name, getter, setter) |> Helpers.toInstanceAccessor AttrBuilder<'view>.CreateContent(accessor, ViewContent.Single singleContent) /// @@ -135,47 +162,30 @@ type AttrBuilder<'view>() = /// Create a Multiple Content Attribute for an instance (non Avalonia) Property /// static member CreateContentMultiple(name: string, getter, setter, multipleContent: IView list) : IAttr<'view> = - let accessor = Accessor.InstanceProperty { - Name = name - Getter = - match getter with - | ValueSome getter -> Helpers.wrappedGetter<'view, obj>(getter) |> ValueSome - | ValueNone -> ValueNone - Setter = - match setter with - | ValueSome setter -> Helpers.wrappedSetter<'view, obj>(setter) |> ValueSome - | ValueNone -> ValueNone - } + let accessor = (name, getter, setter) |> Helpers.toInstanceAccessor AttrBuilder<'view>.CreateContent(accessor, ViewContent.Multiple multipleContent) /// /// Create a Property Subscription Attribute for an Avalonia Property /// static member CreateSubscription<'arg>(property: AvaloniaProperty<'arg>, func: 'arg -> unit, ?subPatchOptions: SubPatchOptions) : IAttr<'view> = - // subscribe to avalonia property - // TODO: extract to helpers module + let name = property.Name + ".PropertySub" let subscribeFunc (control: IControl, _handler: 'h) = let cts = new CancellationTokenSource() control .GetObservable(property) .Subscribe(func, cts.Token) cts - - let attr = Attr<'view>.Subscription { - Name = property.Name + ".PropertySub" - Subscribe = subscribeFunc - Func = Action<_>(func) - FuncType = func.GetType() - Scope = (Option.defaultValue SubPatchOptions.Never subPatchOptions).ToScope() - } - attr :> IAttr<'view> + + (name, subscribeFunc, func, subPatchOptions) + |> Helpers.toSubscription + |> Helpers.toSubAttr /// /// Create a Routed Event Subscription Attribute for a Routed Event /// static member CreateSubscription<'arg when 'arg :> RoutedEventArgs>(routedEvent: RoutedEvent<'arg>, func: 'arg -> unit, ?subPatchOptions: SubPatchOptions) : IAttr<'view> = - // subscribe to avalonia property - // TODO: extract to helpers module + let name = routedEvent.Name + ".RoutedEventSub" let subscribeFunc (control: IControl, _handler: 'h) = let cts = new CancellationTokenSource() control @@ -183,40 +193,61 @@ type AttrBuilder<'view>() = .Subscribe(func, cts.Token) cts - let attr = Attr<'view>.Subscription { - Name = routedEvent.Name + ".RoutedEventSub" - Subscribe = subscribeFunc - Func = Action<_>(func) - FuncType = func.GetType() - Scope = (Option.defaultValue SubPatchOptions.Never subPatchOptions).ToScope() - } - attr :> IAttr<'view> + (name, subscribeFunc, func, subPatchOptions) + |> Helpers.toSubscription + |> Helpers.toSubAttr /// /// Create a Event Subscription Attribute for a .Net Event /// static member CreateSubscription<'arg>(name: string, factory: IControl * ('arg -> unit) * CancellationToken -> unit, func: 'arg -> unit, ?subPatchOptions: SubPatchOptions) = - // TODO: extract to helpers module - // subscribe to event + let name = name + ".EventSub" let subscribeFunc (control: IControl, _handler: 'h) = let cts = new CancellationTokenSource() factory(control, func, cts.Token) cts - let attr = Attr<'view>.Subscription { - Name = name + ".EventSub" - Subscribe = subscribeFunc - Func = Action<_>(func) - FuncType = func.GetType() - Scope = (Option.defaultValue SubPatchOptions.Never subPatchOptions).ToScope() - } - - attr :> IAttr<'view> - + (name, subscribeFunc, func, subPatchOptions) + |> Helpers.toSubscription + |> Helpers.toSubAttr + + // Create a ControlledProperty Attribute for an Avalonia Property + static member CreateControlledProperty<'value>(avaloniaProperty: AvaloniaProperty<'value>, value: 'value, func: 'value -> unit, comparer, ?subPatchOptions: SubPatchOptions) : IAttr<'view> = + let makeController = Helpers.controlAvaloniaProperty avaloniaProperty + let accessor = avaloniaProperty :> AvaloniaProperty |> Accessor.AvaloniaProperty + let property = (accessor, value, comparer, ValueNone) |> Helpers.toProperty + let castFn (arg: obj) = arg :?> 'value |> func + (makeController, property, castFn, subPatchOptions) + |> Helpers.toControlledProperty + |> Helpers.toControlledPropertyAttr + + // Create a ControlledProperty Attribute for an Avalonia Property (with a default value factory) + static member CreateControlledProperty<'value>(avaloniaProperty: AvaloniaProperty<'value>, value: 'value, func: 'value -> unit, comparer, defaultValueFactory: (unit -> 'value), ?subPatchOptions: SubPatchOptions) : IAttr<'view> = + let objFactory = (fun () -> defaultValueFactory() :> obj) |> ValueSome + let makeController = Helpers.controlAvaloniaProperty avaloniaProperty + let accessor = avaloniaProperty :> AvaloniaProperty |> Accessor.AvaloniaProperty + let property = (accessor, value, comparer, objFactory) |> Helpers.toProperty + let castFn (arg: obj) = arg :?> 'value |> func + (makeController, property, castFn, subPatchOptions) + |> Helpers.toControlledProperty + |> Helpers.toControlledPropertyAttr + + // Create a ControlledProperty Attribute for an instance (non Avalonia) Property + static member private CreateControlledInstanceProperty<'value>(name: string, value: 'value, func: 'value -> unit, getter: ('view -> 'value) voption, setter: ('view * 'value -> unit) voption, comparer: Comparer voption, defaultValueFactory: (unit -> 'value) voption, ?subPatchOptions: SubPatchOptions) : IAttr<'view> = + failwith "todo" + + // Create a ControlledProperty Attribute for an instance (non Avalonia) Property + static member CreateControlledInstanceProperty<'value>(name, value, func, getter, setter, comparer, defaultValueFactory): IAttr<'view> = + AttrBuilder<'view>.CreateControlledInstanceProperty(name, value, func, getter, setter, comparer, defaultValueFactory |> ValueSome) + + // Create a ControlledProperty Attribute for an instance (non Avalonia) Property (with sub patch options) + static member CreateControlledInstanceProperty<'value>(name, value, func, getter, setter, comparer, defaultValueFactory, subPatchOptions: SubPatchOptions): IAttr<'view> = + AttrBuilder<'view>.CreateControlledInstanceProperty(name, value, func, getter, setter, comparer, defaultValueFactory |> ValueSome, subPatchOptions) + [] type ViewBuilder() = static member Create<'view>(attrs: IAttr<'view> list) : IView<'view> = { View.ViewType = typeof<'view> View.Attrs = attrs } - :> IView<'view> \ No newline at end of file + :> IView<'view> diff --git a/src/Avalonia.FuncUI/Controls/ControlledCheckBox.fs b/src/Avalonia.FuncUI/Controls/ControlledCheckBox.fs new file mode 100644 index 00000000..6ae357e3 --- /dev/null +++ b/src/Avalonia.FuncUI/Controls/ControlledCheckBox.fs @@ -0,0 +1,65 @@ +namespace Avalonia.FuncUI.Controls + +open System +open Avalonia.Controls +open Avalonia.Interactivity +open Avalonia.Styling + +[] +type CheckBoxState = + | Checked + | Unchecked + | Indeterminate + +type CheckBoxEventArgs() = + inherit RoutedEventArgs() + member val State : CheckBoxState = Unchecked with get, set + +type ControlledCheckBox() = + inherit CheckBox() + + let toState (b: Nullable) = + if not b.HasValue then Indeterminate + else match b.Value with + | true -> Checked + | false -> Unchecked + + let next isThree state = + match (state, isThree) with + | (Indeterminate, _) -> Unchecked + | (Unchecked, _) -> Checked + | (Checked, true) -> Indeterminate + | (Checked, false) -> Unchecked + + interface IStyleable with + member this.StyleKey = typeof + + member val OnChangeCallback : CheckBoxEventArgs -> unit = ignore with get, set + + member this.State() = + this.IsChecked |> toState + + member this.SynthesizeEvent(state) = + let e = CheckBoxEventArgs() + e.Source <- this + e.Route <- RoutingStrategies.Bubble + e.State <- state + e + + override this.Toggle() = + let nextState = this.IsChecked |> toState |> next this.IsThreeState + let e = this.SynthesizeEvent(nextState) + this.OnChangeCallback e + e.Handled <- true + + override this.OnClick() = + this.Toggle() + + member this.MutateControlledValue state = + if state = Indeterminate then do + this.IsChecked <- System.Nullable() + elif state = Checked then do + this.IsChecked <- true + else do + this.IsChecked <- false + \ No newline at end of file diff --git a/src/Avalonia.FuncUI/Controls/ControlledTextBox.fs b/src/Avalonia.FuncUI/Controls/ControlledTextBox.fs new file mode 100644 index 00000000..725c5a14 --- /dev/null +++ b/src/Avalonia.FuncUI/Controls/ControlledTextBox.fs @@ -0,0 +1,197 @@ +namespace Avalonia.FuncUI.Controls +open System +open System.Linq +open System.Collections.Generic +open Avalonia +open Avalonia.Controls +open Avalonia.Input +open Avalonia.Input.Platform +open Avalonia.Interactivity +open Avalonia.Styling + +[] +type State = { Text: string; CaretIdx: int } + +type ControlledTextBox() = + inherit TextBox() + + let sort a b = + (min a b, max a b) + + let withoutSelection selectionStart selectionEnd str = + if selectionStart = selectionEnd + then { Text = str; CaretIdx = selectionStart } + else + let (min, max) = sort selectionStart selectionEnd + { Text = str.Substring(0, min) + str.Substring(max); CaretIdx = min } + + let injectAtIdx idx str input = + let len = String.length str + let txt = str.[0..idx - 1] + input + str.[idx..len] + { Text = txt; CaretIdx = idx + String.length input } + + let replaceSelection selectionStart selectionEnd str input = + let less = withoutSelection selectionStart selectionEnd str + injectAtIdx (less.CaretIdx) (less.Text) input + + let synthesizeTextInputEvent (e: RoutedEventArgs) txt = + let syntheticEvent = TextInputEventArgs() + syntheticEvent.Text <- txt + syntheticEvent.Route <- e.Route + syntheticEvent.Source <- e.Source + syntheticEvent.RoutedEvent <- e.RoutedEvent + syntheticEvent + + let nullStrToEmpty str = + match str with null -> "" | s -> s + + interface IStyleable with + member this.StyleKey = typeof + + member val NextCaretIdx = 0 with get, set + member val OnChangeCallback : TextInputEventArgs -> unit = ignore with get, set + + member private this.IsPasswordBox () = + this.PasswordChar <> Unchecked.defaultof + + member private this.InvokeChange (e, text, nextCaretIdx) = + let syntheticEvent = synthesizeTextInputEvent e text + + this.ClearSelection() + this.NextCaretIdx <- nextCaretIdx + syntheticEvent |> this.OnChangeCallback + syntheticEvent.Handled <- true + + member private this.HandleTextInput (e: TextInputEventArgs) = + let input = e.Text |> this.RemoveInvalidCharacters + let thisText = this.Text |> nullStrToEmpty + let selectionLength = Math.Abs(this.SelectionStart - this.SelectionEnd) + let nextLength = thisText.Length + input.Length - selectionLength + let invalid = + String.IsNullOrEmpty(input) || (this.MaxLength <> 0 && nextLength <= this.MaxLength) + if not invalid then do + let someSelection = this.SelectionStart <> this.SelectionEnd + let next = if someSelection + then replaceSelection this.SelectionStart this.SelectionEnd thisText input + else injectAtIdx this.CaretIndex thisText input + this.ClearSelection() + this.NextCaretIdx <- next.CaretIdx + let e' = synthesizeTextInputEvent e next.Text + this.OnChangeCallback e' + e'.Handled <- true + + override this.OnTextInput (e: TextInputEventArgs) = + if not e.Handled then do + this.HandleTextInput e + e.Handled <- true + + member private this.HandleDeleteSelection(e: KeyEventArgs) = + let next = withoutSelection this.SelectionStart this.SelectionEnd this.Text + let syntheticEvent = synthesizeTextInputEvent e next.Text + + this.ClearSelection() + this.NextCaretIdx <- this.SelectionStart + syntheticEvent |> this.OnChangeCallback + syntheticEvent.Handled <- true + + member private this.HandleCut(e: KeyEventArgs) = + let someSelection = this.SelectionStart <> this.SelectionEnd + if someSelection then do + this.Copy() + this.HandleDeleteSelection(e) + + member private this.HandlePaste(e: KeyEventArgs) = + let service = AvaloniaLocator.Current.GetService() + let text = service.GetTextAsync() |> Async.AwaitTask |> Async.RunSynchronously + let syntheticEvent = synthesizeTextInputEvent e text + do this.HandleTextInput syntheticEvent + + member private this.HandleCtrlBackspace(e: KeyEventArgs) = + let text = this.Text.Substring(this.CaretIndex) + do this.InvokeChange (e, text, 0) + + member private this.HandleBackspace(e: KeyEventArgs) = + let shouldCleanupDanglingReturn = + this.CaretIndex > 1 && + this.Text.[this.CaretIndex - 1] = '\n' && + this.Text.[this.CaretIndex - 2] = '\r' + let removeCt = if shouldCleanupDanglingReturn then 2 else 1 + let text = this.Text.Substring(0, this.CaretIndex - removeCt) + + this.Text.Substring(this.CaretIndex) + do this.InvokeChange (e, text, (this.CaretIndex - removeCt)) + + member private this.HandleCtrlDelete(e: KeyEventArgs) = + let text = this.Text.Substring(0, this.CaretIndex) + do this.InvokeChange (e, text, text.Length) + + member private this.HandleDelete(e: KeyEventArgs) = + let shouldCleanupDanglingReturn = + this.CaretIndex < this.Text.Length - 1 && + this.Text.[this.CaretIndex + 1] = '\n' && + this.Text.[this.CaretIndex] = '\r' + let removeCt = if shouldCleanupDanglingReturn then 2 else 1 + let text = this.Text.Substring(0, this.CaretIndex) + + this.Text.Substring(this.CaretIndex + removeCt) + do this.InvokeChange (e, text, this.CaretIndex) + + member private this.HandleTab(e: KeyEventArgs) = + let syntheticEvent = synthesizeTextInputEvent e "\t" + do this.HandleTextInput syntheticEvent + + member private this.HandleReturn(e: KeyEventArgs) = + let syntheticEvent = synthesizeTextInputEvent e this.NewLine + do this.HandleTextInput syntheticEvent + + member this.HandleUndo(e: KeyEventArgs) = + + () + + // This OnKeyDown override intercepts cases which would result in this.Text being mutated. + // In these cases, non-destructive handlers pass the event to this.OnChangeCallback. + // Outside of these cases, this override forwards the event to the base TextBox implementation. + override this.OnKeyDown (e: KeyEventArgs) = + let keymap = AvaloniaLocator.Current.GetService() + let matches (gestures: List) = + gestures.Any(fun g -> g.Matches e) + let isPw = this.IsPasswordBox() + let someSelection = this.SelectionStart <> this.SelectionEnd + let modifiers = e.KeyModifiers + let hasWholeWordModifiers = modifiers.HasFlag(keymap.WholeWordTextActionModifiers); + + // TODO: Undo redo state + if (matches keymap.Cut && not isPw) then + this.HandleCut(e) + e.Handled <- true + elif (matches keymap.Paste) then + this.HandlePaste(e) + e.Handled <- true + elif (e.Key = Key.Back) then + if someSelection then + this.HandleDeleteSelection(e) + elif this.CaretIndex > 0 then + if hasWholeWordModifiers + then do this.HandleCtrlBackspace(e) + else do this.HandleBackspace(e) + e.Handled <- true + elif (e.Key = Key.Delete) then + if someSelection then + this.HandleDeleteSelection(e) + elif this.CaretIndex < this.Text.Length - 1 then + if hasWholeWordModifiers + then do this.HandleCtrlDelete(e) + else do this.HandleDelete(e) + e.Handled <- true + elif (e.Key = Key.Enter && this.AcceptsReturn) then + this.HandleReturn(e) + e.Handled <- true + elif (e.Key = Key.Tab && this.AcceptsTab) then + this.HandleTab(e) + e.Handled <- true + else do + base.OnKeyDown(e) + () + + member this.MutateControlledValue str = + this.Text <- str + this.CaretIndex <- this.NextCaretIdx + diff --git a/src/Avalonia.FuncUI/Controls/Helpers.fs b/src/Avalonia.FuncUI/Controls/Helpers.fs new file mode 100644 index 00000000..a8ce91bb --- /dev/null +++ b/src/Avalonia.FuncUI/Controls/Helpers.fs @@ -0,0 +1,40 @@ +namespace Avalonia.FuncUI.DSL.Controls + +module Helpers = + + module ActionHistory = + [] + type ActionHistory<'t> = + { past: 't list + present: 't + future: 't list + limit: int } + + let init t limit = { past = []; present = t; future = []; limit = limit } + + let setLimit ah l = { ah with limit = l } + + let push t ah = + let past = + if List.length ah.past = ah.limit + then ah.present::(ah.past |> List.take (ah.limit - 1)) + else ah.present::ah.past + { ah with present = t; past = past; future = [] } + + let undo ah = + let futureCapped = (List.length ah.future) = ah.limit + match (ah.past, futureCapped) with + | ([], _) -> ah + | (t::ts, false) -> { ah with present = t; past = ts; future = ah.present::ah.future } + | (t::ts, true) -> + let future = ah.present::(ah.future |> List.take (ah.limit - 1)) + { ah with present = t; past = ts; future = future } + + let redo ah = + let pastCapped = (List.length ah.past) = ah.limit + match (ah.future, pastCapped) with + | ([], _) -> ah + | (t::ts, false) -> { ah with present = t; past = ah.present::ah.past; future = ts } + | (t::ts, true) -> + let past = ah.present::(ah.past |> List.take (ah.limit - 1)) + { ah with present = t; past = past; future = ts } \ No newline at end of file diff --git a/src/Avalonia.FuncUI/Types.fs b/src/Avalonia.FuncUI/Types.fs index 27ee7bd1..dda51efa 100644 --- a/src/Avalonia.FuncUI/Types.fs +++ b/src/Avalonia.FuncUI/Types.fs @@ -23,7 +23,11 @@ module Types = type Accessor = | InstanceProperty of PropertyAccessor - | AvaloniaProperty of Avalonia.AvaloniaProperty + | AvaloniaProperty of Avalonia.AvaloniaProperty + + let accessorName = function + | InstanceProperty p -> p.Name + | AvaloniaProperty p -> p.Name [] type Property = @@ -61,7 +65,7 @@ module Types = [] type Subscription = { Name: string - Subscribe: IControl * Delegate -> CancellationTokenSource + Subscribe: IControl * Delegate -> CancellationTokenSource Func: Delegate FuncType: Type Scope: obj } @@ -76,37 +80,55 @@ module Types = override this.GetHashCode () = (this.Name, this.FuncType, this.Scope).GetHashCode() + + type PropertyController = + { SetControlledValue: obj -> unit + Cancellation: CancellationTokenSource } + + [] + type ControlledProperty = + { Property: Property + MakeController: IControl -> (obj -> unit) -> PropertyController + Func: (obj -> unit) + FuncType: Type + Scope: obj } + + override this.Equals (other: obj) : bool = + match other with + | :? ControlledProperty as other -> + this.Property = other.Property && + this.FuncType = other.FuncType && + this.Scope = other.Scope + | _ -> false + + override this.GetHashCode () = + (this.Property, this.FuncType, this.Scope).GetHashCode() type IAttr = abstract member UniqueName : string abstract member Property : Property option abstract member Content : Content option abstract member Subscription : Subscription option + abstract member ControlledProperty : ControlledProperty option type IAttr<'viewType> = - inherit IAttr + inherit IAttr type Attr<'viewType> = | Property of Property | Content of Content | Subscription of Subscription + | ControlledProperty of ControlledProperty interface IAttr<'viewType> interface IAttr with member this.UniqueName = match this with - | Property property -> - match property.Accessor with - | Accessor.AvaloniaProperty p -> p.Name - | Accessor.InstanceProperty p -> p.Name - - | Content content -> - match content.Accessor with - | Accessor.AvaloniaProperty p -> p.Name - | Accessor.InstanceProperty p -> p.Name - + | Property property -> property.Accessor |> accessorName + | Content content -> content.Accessor |> accessorName | Subscription subscription -> subscription.Name + | ControlledProperty cp -> cp.Property.Accessor |> accessorName member this.Property = match this with @@ -122,6 +144,11 @@ module Types = match this with | Subscription value -> Some value | _ -> None + + member this.ControlledProperty = + match this with + | ControlledProperty value -> Some value + | _ -> None type IView = abstract member ViewType: Type with get @@ -142,15 +169,3 @@ module Types = interface IView<'viewType> with member this.Attrs = this.Attrs - - - // TODO: maybe move active patterns to Virtual DON Misc - - let internal (|Property'|_|) (attr: IAttr) = - attr.Property - - let internal (|Content'|_|) (attr: IAttr) = - attr.Content - - let internal (|Subscription'|_|) (attr: IAttr) = - attr.Subscription \ No newline at end of file diff --git a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Delta.fs b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Delta.fs index a19efa37..536f4cf9 100644 --- a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Delta.fs +++ b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Delta.fs @@ -2,6 +2,7 @@ namespace Avalonia.FuncUI.VirtualDom open System open System.Threading +open ActivePatterns open Avalonia.FuncUI.Types @@ -10,15 +11,16 @@ module internal rec Delta = type AttrDelta = | Property of PropertyDelta | Content of ContentDelta - | Subscription of SubscriptionDelta + | Subscription of SubscriptionDelta + | ControlledProperty of ControlledPropertyDelta static member From (attr: IAttr) : AttrDelta = match attr with | Property' property -> Property (PropertyDelta.From property) | Content' content -> Content (ContentDelta.From content) | Subscription' subscription -> Subscription (SubscriptionDelta.From subscription) - | _ -> raise (Exception "unknown IAttr type. (not a Property, Content ore Subscription attribute)") - + | ControlledProperty' cp -> ControlledProperty (ControlledPropertyDelta.From cp) + | _ -> raise (Exception "unknown IAttr type (not a Property, Content, Subscription, or ControlledProperty attribute)") [] type PropertyDelta = @@ -40,7 +42,6 @@ module internal rec Delta = override this.GetHashCode () = (this.Accessor, this.Value).GetHashCode() - [] type SubscriptionDelta = @@ -64,13 +65,37 @@ module internal rec Delta = member this.UniqueName = this.Name - type ContentDelta = + type ContentDelta = { Accessor: Accessor Content: ViewContentDelta } static member From (content: Content) : ContentDelta = { Accessor = content.Accessor; Content = ViewContentDelta.From content.Content } + + [] + type ControlledPropertyDelta = + { Accessor: Accessor + Control: (obj * (obj -> unit)) option + MakeController: Avalonia.Controls.IControl -> (obj -> unit) -> PropertyController } + + member this.Value () = + Option.map fst this.Control + + override this.Equals (other: obj) : bool = + match other with + | :? ControlledPropertyDelta as other -> + this.Accessor = other.Accessor && + this.Value() = other.Value() + | _ -> false + + override this.GetHashCode () = + (this.Accessor, this.Value()).GetHashCode() + + static member From (controlledProperty: ControlledProperty) : ControlledPropertyDelta = + { Accessor = controlledProperty.Property.Accessor + MakeController = controlledProperty.MakeController + Control = (controlledProperty.Property.Value, controlledProperty.Func) |> Some } type ViewContentDelta = | Single of ViewDelta option diff --git a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Differ.fs b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Differ.fs index 72cb277c..5544e4d1 100644 --- a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Differ.fs +++ b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Differ.fs @@ -1,6 +1,6 @@ namespace Avalonia.FuncUI.VirtualDom -open System.Collections.Generic +open Avalonia.FuncUI.VirtualDom.ActivePatterns open Avalonia.FuncUI.Types open Delta @@ -22,6 +22,9 @@ module internal rec Differ = | Subscription' subscription -> AttrDelta.Subscription (SubscriptionDelta.From subscription) + | ControlledProperty' controlledProperty -> + AttrDelta.ControlledProperty (ControlledPropertyDelta.From controlledProperty) + | _ -> failwithf "no update operation is defined for '%A' next" next let private reset (last: IAttr) : AttrDelta = @@ -47,6 +50,12 @@ module internal rec Differ = { Name = subscription.Name Subscribe = subscription.Subscribe Func = None } + + | ControlledProperty' controlledProperty -> + AttrDelta.ControlledProperty { + MakeController = controlledProperty.MakeController + Accessor = controlledProperty.Property.Accessor + Control = (controlledProperty.Property.Value, controlledProperty.Func) |> Some } | _ -> failwithf "no reset operation is defined for last '%A'" last diff --git a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Misc.fs b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Misc.fs index 55157d6e..6d8da370 100644 --- a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Misc.fs +++ b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Misc.fs @@ -5,6 +5,20 @@ open System open Avalonia open Avalonia.Controls open System.Collections.Concurrent +open Avalonia.FuncUI.Types + +module ActivePatterns = + let internal (|Property'|_|) (attr: IAttr) = + attr.Property + + let internal (|Content'|_|) (attr: IAttr) = + attr.Content + + let internal (|Subscription'|_|) (attr: IAttr) = + attr.Subscription + + let internal (|ControlledProperty'|_|) (attr: IAttr) = + attr.ControlledProperty type ViewMetaData() = inherit AvaloniaObject() @@ -13,12 +27,13 @@ type ViewMetaData() = /// Avalonia automatically adds subscriptions that are setup in XAML to a disposable bag (or something along the lines). /// This basically is what FuncUI uses instead to make sure it cancels subscriptions. - static let viewSubscriptions = AvaloniaProperty.RegisterAttached>("ViewSubscriptions") + static let viewSubscriptions = AvaloniaProperty.RegisterAttached>("ViewSubscriptions") + static let viewPropertyControllers = AvaloniaProperty.RegisterAttached>("ViewPropertyControllers") static member ViewIdProperty = viewId static member ViewSubscriptionsProperty = viewSubscriptions - + static member ViewPropertyControllersProperty = viewPropertyControllers static member GetViewId(control: IControl) : Guid = control.GetValue(ViewMetaData.ViewIdProperty) @@ -29,7 +44,10 @@ type ViewMetaData() = control.GetValue(ViewMetaData.ViewSubscriptionsProperty) static member SetViewSubscriptions(control: IControl, value) : unit = - control.SetValue(ViewMetaData.ViewSubscriptionsProperty, value) |> ignore - - + control.SetValue(ViewMetaData.ViewSubscriptionsProperty, value) |> ignore + static member GetViewPropertyControllers(control: IControl) : ConcurrentDictionary<_, _> = + control.GetValue(ViewMetaData.ViewPropertyControllersProperty) + + static member SetViewPropertyControllers(control: IControl, value) : unit = + control.SetValue(ViewMetaData.ViewPropertyControllersProperty, value) |> ignore diff --git a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Patcher.fs b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Patcher.fs index 55eff08a..074a5f34 100644 --- a/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Patcher.fs +++ b/src/Avalonia.FuncUI/VirtualDom/VirtualDom.Patcher.fs @@ -10,7 +10,7 @@ module internal rec Patcher = open Avalonia.FuncUI.Library open Avalonia.FuncUI.Types open System.Threading - + let private patchSubscription (view: IControl) (attr: SubscriptionDelta) : unit = let subscriptions = match ViewMetaData.GetViewSubscriptions(view) with @@ -40,6 +40,13 @@ module internal rec Patcher = if hasValue then value.Cancel() subscriptions.TryRemove(attr.UniqueName) |> ignore + + let private defaultInstancePropertyValue (view: IControl) (name: string) = + // TODO: get rid of reflection here + let propertyInfo = view.GetType().GetProperty(name) + match propertyInfo.PropertyType.IsValueType with + | true -> Activator.CreateInstance(propertyInfo.PropertyType) + | false -> null let private patchProperty (view: IControl) (attr: PropertyDelta) : unit = match attr.Accessor with @@ -51,8 +58,7 @@ module internal rec Patcher = | None -> match attr.DefaultValueFactory with | ValueNone -> - // TODO: create PR - include 'ClearValue' in interface 'IAvaloniaObject' - (view :?> AvaloniaObject).ClearValue(avaloniaProperty) + view.ClearValue(avaloniaProperty) | ValueSome factory -> let value = factory() view.SetValue(avaloniaProperty, value) @@ -65,13 +71,7 @@ module internal rec Patcher = | None -> match attr.DefaultValueFactory with | ValueSome factory -> factory() - | ValueNone -> - // TODO: get rid of reflection here - let propertyInfo = view.GetType().GetProperty(instanceProperty.Name) - - match propertyInfo.PropertyType.IsValueType with - | true -> Activator.CreateInstance(propertyInfo.PropertyType) - | false -> null + | ValueNone -> defaultInstancePropertyValue view instanceProperty.Name match instanceProperty.Setter with | ValueSome setter -> setter (view, value) @@ -204,6 +204,41 @@ module internal rec Patcher = patchContentSingle view attr.Accessor single | ViewContentDelta.Multiple multiple -> patchContentMultiple view attr.Accessor multiple + + let private patchControlledProperty (view: IControl) (attr: ControlledPropertyDelta) : unit = + let name = attr.Accessor |> accessorName + let controllers = + match ViewMetaData.GetViewPropertyControllers(view) with + | null -> + let dict = ConcurrentDictionary<_,_>() + ViewMetaData.SetViewPropertyControllers(view, dict) + dict + | value -> value + + match attr.Control with + | Some (value, fn) -> + let controller = attr.MakeController view fn + let addFactory = Func(fun _ -> controller) + let updateFactory = Func(fun _ oldCtr -> + oldCtr.Cancellation.Cancel() + controller + ) + controllers.AddOrUpdate(name, addFactory, updateFactory) |> ignore + controller.SetControlledValue value + + | None -> + let hasController, controller = controllers.TryGetValue(name) + if hasController then + controller.Cancellation.Cancel() + controllers.TryRemove(name) |> ignore + match attr.Accessor with + | Accessor.AvaloniaProperty ap -> + view.ClearValue(ap) + | Accessor.InstanceProperty ip -> + let value = defaultInstancePropertyValue view ip.Name + match ip.Setter with + | ValueSome setter -> setter (view, value) + | ValueNone _ -> failwithf "instance property ('%s') has no setter. " ip.Name let patch (view: IControl, viewElement: ViewDelta) : unit = for attr in viewElement.Attrs do @@ -211,6 +246,7 @@ module internal rec Patcher = | AttrDelta.Property property -> patchProperty view property | AttrDelta.Content content -> patchContent view content | AttrDelta.Subscription subscription -> patchSubscription view subscription + | AttrDelta.ControlledProperty cp -> patchControlledProperty view cp let create (viewElement: ViewDelta) : IControl = let control = viewElement.ViewType |> Activator.CreateInstance |> Utils.cast diff --git a/src/Examples/Examples.ControlledComponents/ControlledDemo.fs b/src/Examples/Examples.ControlledComponents/ControlledDemo.fs new file mode 100644 index 00000000..205e2140 --- /dev/null +++ b/src/Examples/Examples.ControlledComponents/ControlledDemo.fs @@ -0,0 +1,202 @@ +namespace Examples.ControlledComponents + +open System.Text.RegularExpressions +open Avalonia.FuncUI.Components +open Avalonia.FuncUI.DSL +open Avalonia.FuncUI.Controls +open Avalonia.FuncUI.DSL.Controls +open Avalonia.FuncUI.Helpers + +module ControlledDemo = + open Avalonia.Controls + open Avalonia.Layout + + type State = + { maskedString : string + expanderOpen: bool + checkItems: (string * bool) list + selectedComboBoxIndex: int + pickerString : string + changeCt : int } + let init = + { maskedString = "" + expanderOpen = false + checkItems = [("A", false); ("B", true); ("C", false)] + selectedComboBoxIndex = 0 + pickerString = "A" + changeCt = 0 } + + type Msg = + | SetMaskedString of string + | SetPickerString of string + | SetIsChecked of (string * bool) + | SetExpander of bool + | SetComboBoxIdx of int + | ToggleCheckAll + | IncrChange + + let selectAllState selectedCt listCt = + if selectedCt = 0 then Unchecked + elif selectedCt = listCt then Checked + else Indeterminate + + let update (msg: Msg) (state: State) : State = + match msg with + | SetMaskedString str -> { state with maskedString = str } + | SetPickerString str -> { state with pickerString = str } + | SetExpander b -> { state with expanderOpen = b } + | SetIsChecked (name, isChecked) -> + let list = + state.checkItems + |> List.map (fun t -> if (fst t) = name then (name, isChecked) else t) + { state with checkItems = list } + | SetComboBoxIdx i -> { state with selectedComboBoxIndex = i } + | ToggleCheckAll -> + let nextList = + let isChecked = state.checkItems |> List.forall snd |> not + state.checkItems |> List.map (fun (n, _) -> n, isChecked) + { state with checkItems = nextList } + + | IncrChange -> { state with changeCt = state.changeCt + 1 } + + let mask = @"[^aeiouAEIOU]" + let noVowels = String.filter (fun c -> Regex.IsMatch(string c, mask)) + + let labelView label children = + DockPanel.create [ + DockPanel.dock Dock.Top + DockPanel.horizontalAlignment HorizontalAlignment.Stretch + DockPanel.children ( + (TextBlock.create [ + TextBlock.text label + TextBlock.dock Dock.Top + TextBlock.horizontalAlignment HorizontalAlignment.Stretch + ] |> generalize) :: children + ) + ] + + let boolToState b = if b then Checked else Unchecked + let stateToBool s = s = Checked + + let selectAllView state dispatch = + let selectAll = + (DockPanel.create [ + DockPanel.dock Dock.Top + DockPanel.horizontalAlignment HorizontalAlignment.Stretch + DockPanel.children [ + TextBlock.create [ + TextBlock.text "Select All" + ] + ControlledCheckBox.create [ + ControlledCheckBox.value ( + let selectedCt = state.checkItems |> List.filter snd |> List.length + let listCt = state.checkItems |> List.length + selectAllState selectedCt listCt + ) + ControlledCheckBox.onChange (fun _ -> ToggleCheckAll |> dispatch) + ] + ] + ]) |> generalize + let rows = + (state.checkItems |> List.map (fun (name, isChecked) -> + DockPanel.create [ + DockPanel.horizontalAlignment HorizontalAlignment.Stretch + DockPanel.children [ + TextBlock.create [ + TextBlock.text name + ] + ControlledCheckBox.create [ + ControlledCheckBox.value (isChecked |> boolToState) + ControlledCheckBox.onChange (fun e -> + let b = e.State |> stateToBool + (name, b) |> SetIsChecked |> dispatch + ) + ] + ] + ] |> generalize)) + labelView + "Checkboxes: Select All as a function of state" + (selectAll::rows) + + + let labelTextBoxView header onChange value = + labelView header [ + ControlledTextBox.create [ + TextBox.dock Dock.Top + TextBox.horizontalAlignment HorizontalAlignment.Stretch + ControlledTextBox.onChange onChange + ControlledTextBox.value value + ] + ] + + let picker value onChange = + labelView "Picker: Update value without extra messages dispatched" [ + StackPanel.create [ + StackPanel.horizontalAlignment HorizontalAlignment.Stretch + StackPanel.children [ + Button.create [ + Button.content "A" + Button.onClick (fun _ -> onChange "A") + ] + Button.create [ + Button.content "B" + Button.onClick (fun _ -> onChange "B") + ] + Button.create [ + Button.content "C" + Button.onClick (fun _ -> onChange "C") + ] + ] + ] + ControlledTextBox.create [ + TextBox.horizontalAlignment HorizontalAlignment.Stretch + ControlledTextBox.onChange (fun e -> onChange e.Text) + ControlledTextBox.value value + ] + ] + + let view (state: State) (dispatch) = + DockPanel.create [ + DockPanel.children [ + ComboBox.create [ + ComboBox.controlledSelectedIndex (state.selectedComboBoxIndex, SetComboBoxIdx >> dispatch) + ComboBox.dataItems [ + "Item 0" + "Item 1" + "Item 2" + ] + ComboBox.itemTemplate ((fun s -> + s |> TextBlock.text |> List.singleton |> TextBlock.create + ) |> DataTemplateView.create) + ] + Expander.create [ + Expander.controlledIsExpanded (state.selectedComboBoxIndex = 1, (SetExpander >> dispatch)) + Expander.header ( + TextBlock.create [ + TextBlock.text "Header" + ] + ) + Expander.content ( + TextBlock.create [ + TextBlock.text "Content" + ] + ) + ] + selectAllView state dispatch + labelTextBoxView + "Masked input: Filters vowels" + (fun e -> e.Text |> noVowels |> SetMaskedString |> dispatch) + state.maskedString + labelTextBoxView + "Change counter: Counts onChange events received" + (fun _ -> IncrChange |> dispatch) + (string state.changeCt) + DockPanel.create [ + DockPanel.dock Dock.Bottom + DockPanel.horizontalAlignment HorizontalAlignment.Stretch + DockPanel.children [ + picker state.pickerString (SetPickerString >> dispatch) + ] + ] + ] + ] \ No newline at end of file diff --git a/src/Examples/Examples.ControlledComponents/Examples.ControlledComponents.fsproj b/src/Examples/Examples.ControlledComponents/Examples.ControlledComponents.fsproj new file mode 100644 index 00000000..d00fbec5 --- /dev/null +++ b/src/Examples/Examples.ControlledComponents/Examples.ControlledComponents.fsproj @@ -0,0 +1,24 @@ + + + + Exe + net5.0 + + + + + + + + + + + + + + + + + + + diff --git a/src/Examples/Examples.ControlledComponents/Library.fs b/src/Examples/Examples.ControlledComponents/Library.fs new file mode 100644 index 00000000..a7ca93ad --- /dev/null +++ b/src/Examples/Examples.ControlledComponents/Library.fs @@ -0,0 +1,70 @@ +namespace Examples.CounterApp + +open Avalonia.FuncUI.DSL + +module Counter = + open Avalonia.Controls + open Avalonia.Layout + + type State = { count : int } + let init = { count = 0 } + + type Msg = + | Increment + | Decrement + | SetCount of int + | Reset + + let update (msg: Msg) (state: State) : State = + match msg with + | Increment -> { state with count = state.count + 1 } + | Decrement -> { state with count = state.count - 1 } + | SetCount count -> { state with count = count } + | Reset -> init + + let view (state: State) (dispatch) = + DockPanel.create [ + DockPanel.children [ + Button.create [ + Button.dock Dock.Bottom + Button.onClick (fun _ -> dispatch Reset) + Button.content "reset" + Button.horizontalAlignment HorizontalAlignment.Stretch + ] + Button.create [ + Button.dock Dock.Bottom + Button.onClick (fun _ -> dispatch Decrement) + Button.content "-" + Button.horizontalAlignment HorizontalAlignment.Stretch + ] + Button.create [ + Button.dock Dock.Bottom + Button.onClick (fun _ -> dispatch Increment) + Button.content "+" + Button.horizontalAlignment HorizontalAlignment.Stretch + ] + Button.create [ + Button.dock Dock.Bottom + Button.onClick ((fun _ -> state.count * 2 |> SetCount |> dispatch), SubPatchOptions.OnChangeOf state.count) + Button.content "x2" + Button.horizontalAlignment HorizontalAlignment.Stretch + ] + TextBox.create [ + TextBox.dock Dock.Bottom + TextBox.onTextChanged ((fun text -> + let isNumber, number = System.Int32.TryParse text + if isNumber then + number |> SetCount |> dispatch) + ) + TextBox.text (string state.count) + TextBox.horizontalAlignment HorizontalAlignment.Stretch + ] + TextBlock.create [ + TextBlock.dock Dock.Top + TextBlock.fontSize 48.0 + TextBlock.verticalAlignment VerticalAlignment.Center + TextBlock.horizontalAlignment HorizontalAlignment.Center + TextBlock.text (string state.count) + ] + ] + ] \ No newline at end of file diff --git a/src/Examples/Examples.ControlledComponents/Program.fs b/src/Examples/Examples.ControlledComponents/Program.fs new file mode 100644 index 00000000..65c2e59f --- /dev/null +++ b/src/Examples/Examples.ControlledComponents/Program.fs @@ -0,0 +1,46 @@ +namespace Examples.ControlledComponents + +open Avalonia +open Avalonia.Themes.Fluent +open Elmish +open Avalonia.FuncUI.Components.Hosts +open Avalonia.FuncUI +open Avalonia.FuncUI.Elmish +open Avalonia.Controls.ApplicationLifetimes + +type MainWindow() as this = + inherit HostWindow() + do + base.Title <- "Controlled Components Example" + base.Height <- 200.0 + base.Width <- 400.0 + + //this.VisualRoot.VisualRoot.Renderer.DrawFps <- true + //this.VisualRoot.VisualRoot.Renderer.DrawDirtyRects <- true + Elmish.Program.mkSimple (fun () -> ControlledDemo.init) ControlledDemo.update ControlledDemo.view + |> Program.withHost this + |> Program.withConsoleTrace + |> Program.run + +type App() = + inherit Application() + + override this.Initialize() = + this.Styles.Add (FluentTheme(baseUri = null, Mode = FluentThemeMode.Dark)) + + override this.OnFrameworkInitializationCompleted() = + match this.ApplicationLifetime with + | :? IClassicDesktopStyleApplicationLifetime as desktopLifetime -> + let mainWindow = MainWindow() + desktopLifetime.MainWindow <- mainWindow + | _ -> () + +module Program = + + [] + let main(args: string[]) = + AppBuilder + .Configure() + .UsePlatformDetect() + .UseSkia() + .StartWithClassicDesktopLifetime(args) \ No newline at end of file