[Animation] Optimize Animator

Author: hyazinthh

src/Aardvark.UI.Primitives/Animation/Animator/AnimatorApp.fs

@@ -68,28 +68,29 @@ module Animator =
         let inline untyped (animation : #IAnimation<'Model>) =
             animation :> IAnimation<'Model>
 
-        let tick (lens : Lens<'Model, Animator<'Model>>) (time : GlobalTime) (model : 'Model) =
-            let getSlots model = (Optic.get lens model).Slots
+        let inline getSlots (lens : Lens<'Model, Animator<'Model>>) (model : 'Model) =
+            HashMap.toValueSeq (Optic.get lens model).Slots
 
+        let tick (lens : Lens<'Model, Animator<'Model>>) (time : GlobalTime) (model : 'Model) =
             // Set the current tick
-            let animator = { Optic.get lens model with CurrentTick = ValueSome time }
+            let animator = { Optic.get lens model with CurrentTick = time }
             let mutable model = model |> Optic.set lens animator
 
             // Process pending actions
-            for _, s in getSlots model do
+            for s in getSlots lens model do
                 model <- s.Commit(model, time)
 
             // Update all running animations by generating and enqueuing Update actions
-            for _, s in getSlots model do
+            for s in getSlots lens model do
                 s.Update time
 
             // Process Update actions
-            for _, s in getSlots model do
+            for s in getSlots lens model do
                 model <- s.Commit(model, time)
 
             // Reset current tick
             model |> Optic.map lens (fun animator ->
-                { animator with CurrentTick = ValueNone }
+                { animator with CurrentTick = GlobalTime.infinite }
             )
 
         let set (lens : Lens<'Model, Animator<'Model>>)
@@ -99,11 +100,11 @@ module Animator =
 
             let animator = model |> Optic.get lens
 
-            match animator.Slots |> HashMap.tryFind name with
-            | Some slot ->
+            match animator.Slots |> HashMap.tryFindV name with
+            | ValueSome slot ->
                 slot.Set(animation)
                 slot.Perform(action)
-                slot.Commit(model, &animator.CurrentTick)
+                slot.Commit(model, animator.CurrentTick)
 
             | _ ->
                 let slot = AnimatorSlot(name, animation.Create name)
@@ -114,7 +115,7 @@ module Animator =
                     )
 
                 slot.Perform(action)
-                slot.Commit(model, &animator.CurrentTick)
+                slot.Commit(model, animator.CurrentTick)
 
         let enqueue (lens : Lens<'Model, Animator<'Model>>)
                     (name : Symbol) (animation : 'Model -> IAnimation<'Model>)
@@ -123,10 +124,10 @@ module Animator =
 
             let animator = model |> Optic.get lens
 
-            match animator.Slots |> HashMap.tryFind name with
-            | Some slot ->
+            match animator.Slots |> HashMap.tryFindV name with
+            | ValueSome slot ->
                 slot.Enqueue(animation, action)
-                slot.Commit(model, &animator.CurrentTick)
+                slot.Commit(model, animator.CurrentTick)
 
             | _ ->
                 let slot = AnimatorSlot(name, (animation model).Create name)
@@ -137,7 +138,7 @@ module Animator =
                     )
 
                 slot.Perform(action)
-                slot.Commit(model, &animator.CurrentTick)
+                slot.Commit(model, animator.CurrentTick)
 
         let remove (lens : Lens<'Model, Animator<'Model>>) (name : Symbol) (model : 'Model) =
             model |> Optic.map lens (fun animator ->
@@ -147,24 +148,24 @@ module Animator =
         let perform (lens : Lens<'Model, Animator<'Model>>) (name : Symbol) (action : IAnimationInstance<'Model> -> unit) (model : 'Model) =
             let animator = model |> Optic.get lens
 
-            match animator.Slots |> HashMap.tryFind name with
-            | Some slot ->
+            match animator.Slots |> HashMap.tryFindV name with
+            | ValueSome slot ->
                 slot.Perform(action)
-                slot.Commit(model, &animator.CurrentTick)
+                slot.Commit(model, animator.CurrentTick)
 
             | _ ->
                 model
 
         let iterate (lens : Lens<'Model, Animator<'Model>>) (action : IAnimationInstance<'Model> -> unit) (model : 'Model) =
             let animator = model |> Optic.get lens
 
-            for _, s in animator.Slots do
+            for s in getSlots lens model do
                 s.Perform(action)
 
             let mutable model = model
 
-            for _, s in animator.Slots do
-                model <- s.Commit(model, &animator.CurrentTick)
+            for s in getSlots lens model do
+                model <- s.Commit(model, animator.CurrentTick)
 
             model
 
@@ -374,8 +375,8 @@ module Animator =
         lens |> Lenses.set
         {
             Slots       = HashMap.empty
-            TickRate    = 60
-            CurrentTick = ValueNone
+            TickRate    = 30
+            CurrentTick = GlobalTime.infinite
         }
 
     /// Thread pool that generates real-time tick messages at a fixed rate.

src/Aardvark.UI.Primitives/Animation/Animator/AnimatorModel.fs

@@ -7,7 +7,7 @@ type Animator<'Model> =
     {
         Slots       : HashMap<Symbol, AnimatorSlot<'Model>>
         TickRate    : int
-        CurrentTick : GlobalTime voption
+        CurrentTick : GlobalTime
     }
 
 [<RequireQualifiedAccess>]

src/Aardvark.UI.Primitives/Animation/Animator/AnimatorSlot.fs

@@ -48,26 +48,23 @@ type AnimatorSlot<'Model>(name : Symbol, instance : IAnimationInstance<'Model>)
 
     /// Commits the current animation instance and prepares the next in the queue if required.
     member internal x.Commit(model : 'Model, tick : GlobalTime) =
-        let model = current.Commit(model, tick)
-
-        if current.IsFinished then
-            if queue.Count > 0 then
-                let delayed = queue.Dequeue()
-                let animation = delayed.Animation model
-                current <- animation.Create(name)
-                x.Perform(delayed.Action)
-                x.Commit(model, tick)
+        if tick.IsFinite then
+            let model = current.Commit(model, tick)
+
+            if current.IsFinished then
+                if queue.Count > 0 then
+                    let delayed = queue.Dequeue()
+                    let animation = delayed.Animation model
+                    current <- animation.Create(name)
+                    x.Perform(delayed.Action)
+                    x.Commit(model, tick)
+                else
+                    model
             else
                 model
         else
             model
 
-    /// Commits the current animation instance and prepares the next in the queue if required.
-    member internal x.Commit(model : 'Model, tick : ValueOption<GlobalTime> inref) =
-        match tick with
-        | ValueSome t -> x.Commit(model, t)
-        | _ -> model
-
     /// Creates an instance of the given animation and sets it as current.
     /// Pending instances are removed.
     member internal x.Set(animation : IAnimation<'Model>) =

src/Aardvark.UI.Primitives/Animation/Animator/Querying.fs

@@ -34,15 +34,15 @@ module AnimatorQuerying =
         /// The name can be a string or Symbol. Returns None if the
         /// slot does not exist.
         let inline tryGetUntyped (name : ^Name) (model : 'Model) =
-            model |> tryGetSlot name |> Option.map (fun s -> s.Current)
+            model |> tryGetSlot name |> Option.map _.Current
 
         /// <summary>
         /// Gets the current (untyped) animation instance in the slot with the given name.
         /// The name can be a string or Symbol.
         /// </summary>
         /// <exception cref="KeyNotFoundException">Thrown if the slot does not exist.</exception>
         let inline getUntyped (name : ^Name) (model : 'Model) =
-            model |> getSlot name |> fun s -> s.Current
+            model |> getSlot name |> _.Current
 
         /// Tries to get the current animation instance in the slot with the given name.
         /// The name can be a string or Symbol. Returns None if
@@ -70,32 +70,32 @@ module AnimatorQuerying =
         /// Tries to get the state of the current animation instance in the slot with the given name.
         /// The name can be a string or Symbol. Returns None if the slot does not exist.
         let inline tryGetState (name : ^Name) (model : 'Model) =
-            model |> tryGetUntyped name |> Option.map (fun a -> a.State)
+            model |> tryGetUntyped name |> Option.map _.State
 
         /// <summary>
         /// Gets the state of the current animation instance in the slot with the given name.
         /// The name can be a string or Symbol.
         /// </summary>
         /// <exception cref="KeyNotFoundException">Thrown if the slot does not exist.</exception>
         let inline getState (name : ^Name) (model : 'Model) =
-            model |> getUntyped name |> fun a -> a.State
+            model |> getUntyped name |> _.State
 
         /// Returns whether the current animation instance in the slot with the given name is running.
         /// The name can be a string or Symbol. Returns false if the slot does not exist.
         let inline isRunning (name : ^Name) (model : 'Model) =
-            model |> tryGetUntyped name |> Option.map (fun a -> a.IsRunning) |> Option.defaultValue false
+            model |> tryGetUntyped name |> Option.map _.IsRunning |> Option.defaultValue false
 
         /// Returns whether the current animation instance in the slot with the given name is stopped.
         /// The name can be a string or Symbol. Returns true if the slot does not exist.
         let inline isStopped (name : ^Name) (model : 'Model) =
-            model |> tryGetUntyped name |> Option.map (fun a -> a.IsStopped) |> Option.defaultValue true
+            model |> tryGetUntyped name |> Option.map _.IsStopped |> Option.defaultValue true
 
         /// Returns whether the current animation instance in the slot with the given name is finished.
         /// The name can be a string or Symbol. Returns true if the slot does not exist.
         let inline isFinished (name : ^Name) (model : 'Model) =
-            model |> tryGetUntyped name |> Option.map (fun a -> a.IsFinished) |> Option.defaultValue true
+            model |> tryGetUntyped name |> Option.map _.IsFinished |> Option.defaultValue true
 
         /// Returns whether the current animation instance in the slot with the given name is paused.
         /// The name can be a string or Symbol. Returns false if the slot does not exist.
         let inline isPaused (name : ^Name) (model : 'Model) =
-            model |> tryGetUntyped name |> Option.map (fun a -> a.IsPaused) |> Option.defaultValue false
+            model |> tryGetUntyped name |> Option.map _.IsPaused |> Option.defaultValue false