rxada_0.1.1_dd9da799/src/body/rx-op-hold.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
with Ada.Numerics.Float_Random;

with Rx.Debug;

package body Rx.Op.Hold is

   ---------------
   -- Generator --
   ---------------

   protected Generator is
      procedure Get (F : out Float);
   private
      State : Ada.Numerics.Float_Random.Generator;
   end Generator;

   protected body Generator is

      procedure Get (F : out Float) is
      begin
         F := Ada.Numerics.Float_Random.Random (State);
      end Get;

   end Generator;

   ------------
   -- Random --
   ------------

   function Random return Ada.Numerics.Float_Random.Uniformly_Distributed is
      F : Float;
   begin
      Generator.Get (F);
      return F;
   end Random;

   type Operator is new Preserver.Operator with record
      Fixed,
      Random: Float;
   end record;

   overriding procedure On_Next (This  : in out Operator;
                                 V     :        Preserver.T);

   ------------
   -- Create --
   ------------

   function Create (Fixed  : Duration;
                    Random : Duration := 0.0)
                       return Preserver.Operator'Class is
   begin
      return Operator'(Preserver.Operator with
                       Fixed  => Float (Fixed),
                       Random => Float (Random));
   end Create;

   -------------
   -- On_Next --
   -------------

   overriding procedure On_Next (This  : in out Operator;
                                 V     :        Preserver.T)
   is
      Pause : constant Float    := This.Fixed + This.Random * Random;
      Dur   : constant Duration := Duration (Pause);
   begin
      Debug.Trace ("on_next hold:" & Dur'Img);
      delay Dur;
      This.Get_Observer.On_Next (V);
   end On_Next;

end Rx.Op.Hold;