lace: Add basic job manager.

1-base/lace/applet/test/job/test_job.adb

@@ -0,0 +1,49 @@
+with
+     lace.Job.Manager,
+     ada.Calendar,
+     ada.Text_IO;
+
+
+procedure test_Job
+is
+   procedure log (Message : in String := "") renames ada.Text_IO.put_Line;
+
+
+   type hello_Job is new lace.Job.item with null record;
+
+   overriding
+   procedure perform (Self : in out hello_Job)
+   is
+      use ada.Calendar;
+   begin
+      lace.Job.item (Self).perform;        -- Call base class 'perform'.
+
+      log ("Hello.");
+
+      if Self.performed_Count = 5
+      then
+         Self.Due_is (lace.Job.Never);     -- Job manager will remove the job.
+      else
+         Self.Due_is (Self.Due + 2.0);     -- Repeat job every 2 seconds.
+      end if;
+   end perform;
+
+
+   the_Job     : aliased hello_Job;
+   the_Manager :         lace.Job.Manager.item;
+
+begin
+   log ("Begin Test");
+   log;
+
+   the_Job.Due_is  (ada.Calendar.Clock);
+   the_Manager.add (the_Job'unchecked_Access);
+
+   while the_Manager.has_Jobs
+   loop
+      the_Manager.do_Jobs;
+   end loop;
+
+   log;
+   log ("End Test");
+end test_Job;

1-base/lace/applet/test/job/test_job.gpr

@@ -0,0 +1,19 @@
+with
+     "lace",
+     "lace_shared";
+
+project test_Job
+is
+   for Object_Dir use "build";
+   for Exec_Dir   use ".";
+   for Main       use ("test_job.adb");
+
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+   package Linker is
+      for Default_Switches ("ada") use ("-g");
+   end Linker;
+
+end test_Job;

1-base/lace/source/jobs/lace-job-manager.adb

@@ -0,0 +1,63 @@
+with ada.Text_IO; use ada.Text_IO;
+
+
+package body lace.Job.Manager
+is
+
+
+   procedure add (Self : in out Item;   the_Job: in Job_view)
+   is
+   begin
+      Self.Jobs.append (the_Job);
+   end add;
+
+
+
+
+   function has_Jobs (Self : in Item) return Boolean
+   is
+   begin
+      return not Self.Jobs.is_Empty;
+   end has_Jobs;
+
+
+
+   procedure do_Jobs (Self : in out Item)
+   is
+      function "<" (Left, Right : in Job_view) return Boolean
+      is
+      begin
+         return Left.Due < Right.Due;
+      end "<";
+
+      package Sorter is new job_Vectors.generic_Sorting;
+
+
+      Now    : constant ada.Calendar.Time  := ada.Calendar.Clock;
+      Cursor :          job_Vectors.Cursor := Self.Jobs.to_Cursor (1);
+
+      use job_Vectors;
+
+   begin
+      Sorter.sort (Self.Jobs);
+
+      while has_Element (Cursor)
+      loop
+         declare
+            the_Job : Job_view renames Element (Cursor);
+         begin
+            exit when the_Job.Due > Now;
+            --  put_Line (the_Job.Due'Image);
+
+            if the_Job.Due = Never
+            then
+               Self.Jobs.delete (Cursor);
+            else
+               the_Job.perform;
+            end if;
+         end;
+      end loop;
+   end do_Jobs;
+
+
+end lace.Job.Manager;

1-base/lace/source/jobs/lace-job-manager.ads

@@ -0,0 +1,33 @@
+with
+     ada.Containers.Vectors;
+
+
+package lace.Job.Manager
+--
+--
+--
+is
+   type Item     is tagged private;
+   type Job_view is access all Job.item'Class;
+
+
+   procedure add      (Self : in out Item;   the_Job: in Job_view);
+   procedure do_Jobs  (Self : in out Item);
+
+   function  has_Jobs (Self : in     Item) return Boolean;
+
+
+
+private
+
+   package job_Vectors is new ada.Containers.Vectors (Positive, Job_view);
+   subtype job_Vector  is job_Vectors.Vector;
+
+
+   type Item is tagged
+      record
+         Jobs : job_Vector;
+      end record;
+
+
+end lace.Job.Manager;

1-base/lace/source/jobs/lace-job.adb

@@ -0,0 +1,35 @@
+package body lace.Job
+is
+
+   procedure Due_is (Self : in out Item;   Now : in ada.Calendar.Time)
+   is
+   begin
+      Self.Due := Now;
+   end Due_is;
+
+
+
+   function Due (Self : in Item) return ada.Calendar.Time
+   is
+   begin
+      return Self.Due;
+   end Due;
+
+
+
+   function  performed_Count (Self : in Item) return Natural
+   is
+   begin
+      return Self.performed_Count;
+   end performed_Count;
+
+
+
+   procedure perform (Self : in out Item)
+   is
+   begin
+      Self.performed_Count := Self.performed_Count + 1;
+   end perform;
+
+
+end lace.Job;

1-base/lace/source/jobs/lace-job.ads

@@ -0,0 +1,42 @@
+with
+     ada.Calendar;
+
+
+package lace.Job
+--
+--
+--
+is
+   type Item is abstract tagged private;
+
+   procedure perform (Self : in out Item);
+
+
+   procedure Due_is (Self : in out Item;   Now : in ada.Calendar.Time);
+   function  Due    (Self : in     Item)    return  ada.Calendar.Time;
+
+   function  performed_Count (Self : in Item) return Natural;
+
+
+
+   Never : constant ada.Calendar.Time;
+
+
+
+private
+
+   type Item is abstract tagged
+      record
+         Due             : ada.Calendar.Time;
+         performed_Count : Natural          := 0;
+      end record;
+
+
+
+   use ada.Calendar;
+
+   Never : constant ada.Calendar.Time := ada.Calendar.Time_of (year_Number 'First,
+                                                               month_Number'First,
+                                                               day_Number  'First);
+
+end lace.Job;