I explored the possibility of making my program distinguish between a ‘click’ and a ‘double-click.’ For example, if the user presses the ‘i’ key only once, the program does ‘this’ (p1), and if the user presses ‘i’ repeatedly in quick succession, the program does ‘that’ (p2). Note that the program must wait a bit to see if another “i” comes after first receiving one. I ended up with this task:
task body task_react1_t is
t : constant ada.real_time.time := ada.real_time.clock;
i : integer := 0;
p1b,p2b : Procedure_Access;
begin
while i < 2 and ada.real_time.clock < t + dclick1 loop
select
accept key1(p1,p2 : Procedure_Access) do
i := @ + 1;
p1b := p1;
p2b := p2;
end;
else
null;
end select;
end loop;
– Conclusion:
case i is
when 1 => p1b.all;
when 2 => p2b.all;
when others => raise error with "In task_react1_t, i: " & i’Image;
end case;
abort task_react1_t;
end task_react1_t;
I am just smart enough to understand that I am not so smart. Hence, some comments would be nice.
@reinert, could you edit your code to insert three backticks (“```”) before and after it? that will retain the formatting. As it is, it’s hard to see what’s going on.
I think you’re starting a new instance of the task every time a first-key in a potential key-sequence is pressed. Most people would prefer to have a permanent task, with a loop inside it.
You don’t need to abort the task at the end, just let it drop through.
task body task_react1_t is
t : constant ada.real_time.time := ada.real_time.clock;
i : integer := 0;
p1b,p2b : Procedure_Access;
begin
while i < 2 and ada.real_time.clock < t + dclick1 loop
select
accept key1(p1,p2 : Procedure_Access) do
i := @ + 1;
p1b := p1;
p2b := p2;
end;
else
null;
end select;
end loop;
-- Conclusion:
case i is
when 1 => p1b.all;
when 2 => p2b.all;
when others => raise error with "In task_react1_t, i: " & i'Image;
end case;
abort task_react1_t;
end task_react1_t;
An alternative to the rendezvous option could be to use a protected object.
The specification would be something along the lines of:
with Ada.Real_Time.Timing_Events;
use Ada.Real_Time.Timing_Events;
package Keyboard_Monitors is
type Typing_Pattern is (Once, Twice);
protected type Keyboard_Monitor is
procedure Key_Pressed;
entry Completed(TP: out Typing_Pattern);
private
procedure Event_Handler(Event: in out Timing_Event);
Event: Timing_Event;
First: Boolean := True;
OK: Boolean := False;
Outcome: Typing_Pattern := Once;
end Keyboard_Monitor;
end Keyboard_Monitors;
with an implementation of:
with Ada.Real_Time;
use Ada.Real_Time;
package body Keyboard_Monitors is
Double_Click_Deadline: constant Time_Span := Milliseconds(1_000);
protected body Keyboard_Monitor is
procedure Key_Pressed is
Cancelled: Boolean := False;
begin
if First then
Cancel_Handler(Event, Cancelled);
Outcome := Twice;
OK := True;
else
First := True;
Set_Handler(Event, Double_Click_Deadline, Event_Handler'Access);
end if;
end Key_Pressed;
procedure Reset is
begin
First := False;
OK := False;
Outcome := Once;
end Reset;
entry Completed(TP: out Typing_Pattern) when OK is
begin
TP := Outcome;
Reset;
end Completed;
procedure Event_Handler(Event: in out Timing_Event) is
begin
Outcome := Once;
OK := True;
end Event_Handler;
end Keyboard_Monitor;
end Keyboard_Monitors;
and then in the client task (perhaps the main task)
with Keyboard_Monitors; use Keyboard_Monitors;
procedure keyboard_action is
KM: Keyboard_Monitor;
TP: Typing_Pattern;
begin
loop
KM.Completed(TP);
case TP is
when Once => null; -- i.e. p1b.all
when Twice => null; -- i.e. p2b.all
end case;
end loop;
end keyboard_action;
A bit more verbose arguably, but avoids the spin-loop and the need to create a task for a typing monitoring session.
Disclaimer: Haven’t tested that so not entirely convinced it’s race-free but assuming tasks blocked on a barrier are given precedence over the timing-event handler (which I believe is the case) it should be.
Just an observation that if re-entrant entries (and accept statements within the abortable section of the ATC) were somehow allowed this could be implemented somewhat more elegantly using a rendezvous + ATC pattern:
with Ada.Real_Time; use Ada.Real_Time;
procedure Typing_Counter is
task T1 is
entry S1;
end T1;
task body T1 is
Double_Click_Deadline: constant Time_Span := Milliseconds(1_000);
begin
loop
select
accept S1 do
select
delay until Clock + Double_Click_Deadline;
-- action for Once
then abort
accept S1 do
-- action for Twice
null;
end S1;
end select;
end S1;
else
null;
end select;
end loop;
end T1;
begin
null;
end Typing_Counter;
I think the state machine implemented in the PO is much better (especially since - at first glance - it can be implemented in Ravenscar). I might be inclined to name the states in an enumeration, especially if the SM got more complicated (triple-press?!)
That would make more sense. The pattern enum can be extended to type Typing_Pattern is (None, Once, Twice, Thrice) -- or more
and a current state variable introduced in the private part Current: Typing_Pattern := None so that Key_Pressed now becomes:
procedure Key_Pressed is
Cancelled: Boolean := False;
begin
if Current = Typing_Pattern'Last then
Current := Typing_Pattern'First;
else
Current := Typing_Pattern'Succ(Current);
end if;
Cancel_Handler(Event, Cancelled); -- Safe even when event is not set
if Current = Cutoff then
Outcome := Current;
OK := True;
else
Set_Handler(Event, Double_Click_Deadline, Event_Handler'Access);
end if;
end Key_Pressed;
where Cutoff can be passed as a discriminant on the PO.
I would like the alternatives are only “once” or “twice” (i.e. only two alternatives). This means that if there is a double-click, the program does not need to wait more to see if there soon comes another (third) click.
Just a cosmetic modification of the original version (shorter):
task body task_react1_t is
t : constant ada.real_time.time := ada.real_time.clock;
i : integer := 0;
p : Procedure_Access;
begin
while i < 2 and ada.real_time.clock < t + dclick1 loop
select
accept key1(p1,p2 : Procedure_Access) do
i := @ + 1;
p := (if i = 1 then p1 else p2);
end;
else
null;
end select;
end loop;
p.all;
abort task_react1_t;
end task_react1_t;
Another version using protected object (pause1_t):
protected body pause1_t is
entry wait1 when ok is
begin
null;
end wait1;
procedure halt1 is
begin
ok := false;
end halt1;
procedure resume1 is
begin
ok := true;
end resume1;
end pause1_t;
react_pause1 : pause1_t;
task body task_react1_t is
t : ada.real_time.time := ada.real_time.clock;
i : integer := 0;
p : Procedure_Access;
begin
loop
react_pause1.wait1;
select
accept init1 do
t := ada.real_time.clock;
i := 0;
end;
or
accept key1(p1,p2 : Procedure_Access) do
i := @ + 1;
p := (if i = 1 then p1 else p2);
end;
or delay 0.05;
end select;
if (ada.real_time.clock > t + dclick1 and i = 1) or i > 1 then
p.all;
react_pause1.halt1;
i := 0;
end if;
end loop;
end task_react1_t;
)