diff --git a/1-base/lace/applet/test/job/test_job.adb b/1-base/lace/applet/test/job/test_job.adb new file mode 100644 index 0000000..fc283e5 --- /dev/null +++ b/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; diff --git a/1-base/lace/applet/test/job/test_job.gpr b/1-base/lace/applet/test/job/test_job.gpr new file mode 100644 index 0000000..7d4f128 --- /dev/null +++ b/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; \ No newline at end of file diff --git a/1-base/lace/source/jobs/lace-job-manager.adb b/1-base/lace/source/jobs/lace-job-manager.adb new file mode 100644 index 0000000..de3c757 --- /dev/null +++ b/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; diff --git a/1-base/lace/source/jobs/lace-job-manager.ads b/1-base/lace/source/jobs/lace-job-manager.ads new file mode 100644 index 0000000..af9a867 --- /dev/null +++ b/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; diff --git a/1-base/lace/source/jobs/lace-job.adb b/1-base/lace/source/jobs/lace-job.adb new file mode 100644 index 0000000..e136262 --- /dev/null +++ b/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; diff --git a/1-base/lace/source/jobs/lace-job.ads b/1-base/lace/source/jobs/lace-job.ads new file mode 100644 index 0000000..af1b20d --- /dev/null +++ b/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;