I have a procedure in Ada which reads from a touch screen input. The code is very old and I do not have the touch screen anymore. I would like to replace the touch screen code with reading from a mouse input. Would it be simpler to write the function in C and Import it into the Ada code? The code below is the touch screen code.
HIL_NAME : STRING (1.. 10) := "/dev/touch";
procedure READ (X, Y : out INTEGER) is
type BYTE is new INTEGER range 0 .. 255;
for BYTE'SIZE use 8;
package IN_IO is new SEQUENTIAL_IO (BYTE);
use IN_IO;
type DATA_TYPE is array (2 .. 9) of BYTE;
HIL_FILE : IN_IO.FILE_TYPE;
COUNT : BYTE;
DATA : DATA_TYPE;
begin
IN_IO.OPEN (HIL_FILE, IN_FILE, HIL_NAME); -- open the touchscreen
loop
IN_IO.READ (HIL_FILE, COUNT); -- read the incoming record size
-- read the incoming record
for I in INTEGER range 2 .. BYTE'POS (COUNT) loop
IN_IO.READ (HIL_FILE, DATA (I));
end loop;
-- is this a fingerdown? overkill test.
if ((COUNT = 9) and (DATA (6) = 2#01000010#) and (DATA (9) = 142)) then
X := BYTE'POS (DATA (7)); -- pick out coordinates
Y := BYTE'POS (DATA (8));
IN_IO.CLOSE (HIL_FILE); -- close touchscreen to flush buffer
return; -- return to caller
end if;
end loop;
end READ;
It would be useful to know OS, version, compiler, window manager toolkit and version. For example I'm running Debian 10, and with Gnome 3 as my WM I can most easily access the mouse using the GTKAda toolkit. Last time I wrote code directly accessing a mouse was on DOS, in Modula-2.
However, GTKAda is not particularly easy to learn...
If you're willing to use a web browser as the GUI to your app (which also helps portability across systems ... you might even run the app on a PC but access it via a tablet or phone, giving you a touchscreen!) I recommend looking at Gnoga available from www.gnoga.com. Take a look at some of its tutorials, they should be easy to build and get you started accessing mouse and simple drawing.
EDIT
Having found the magic words (Centos, ncurses) in various comments (which you could usefully add to the question, in case there are better answers) what you are looking for is an Ada binding to ncurses such as this one. This binding is part of the official ncurses source since version 5.8 so should already be available on Centos.
It should then be a simple matter of writing a Read procedure which calls the ncurses mouse handling package, returning mouse position (scaled to an 8-bit Integer or Natural, and probably offset from the console window origin) whenever the LH button is pressed, otherwise presumably returning ... whatever an OUT parameter is initialised to, (presumably BYTE'FIRST)
Job done.
Now we can see the touch screen filename si part of the /dev/ hierarchy it may be even simpler to see if there is any mileage in finding documentation on /dev/mouse as #zerte suggests (or /dev/input/mouse[0|1] on my laptop) ... but I think ncurses will be less machine-dependent.
I have solved the problem using Ncurses. I downloaded the terminal-interface-curses and used the files to create the following procedure.
with Terminal_Interface.Curses;
use Terminal_Interface.Curses;
tmp2 : Event_Mask;
c : Key_Code;
firsttime : Bollean;
procedure READ (X1 : out Column_Position;
Y1 : Line_Position) is
begin
tmp2 := Start_Mouse (All_Events);
c:= Character'Pos ('?');
Set_Raw_Mode (SwitchOn => True);
Set_KeyPad_Mode (SwitchOn => True);
firsttime := true;
loop
if not firsttime then
if c = KeyMouse then
declare
event : Mouse_Event;
Y : Line_Position;
X : Column_Position;
Button : Mouse_Button;
State : Mouse_State;
begin
event := Get_Mouse;
Get_Event (event, Y, X, Button, State);
X1 := X;
Y1 := Y;
exit;
end;
end if;
end if;
firsttime := False;
loop
c := Get_Keystroke;
exit when c /= Key_None;
end loop;
end loop;
End_Mouse (tmp2);
end READ;
You can read the mouse by using the Linux input subsystem (as was suggested by #Zerte). See also this question on SO and some kernel documentation here and here. Reading the mouse' input doesn't seem hard (at least not on a Raspberry Pi 3 running Raspbian GNU/Linux 10). Of course, you still need to apply proper scaling and you need to figure out the device that exposes the mouse events (in my case: /dev/input/event0)
NOTE: You can find the number by inspecting the output of sudo dmesg | grep "input:". If a mouse (or other pointing device) is connected to inputX, then the events of this device will be exposed on eventX.
main.adb
with Ada.Text_IO;
with Ada.Sequential_IO;
with Interfaces.C;
procedure Main is
package C renames Interfaces.C;
use type C.unsigned_short;
use type C.int;
-- Input event codes (linux/input-event-codes.h)
EV_SYN : constant := 16#00#;
EV_KEY : constant := 16#01#;
EV_REL : constant := 16#02#;
EV_ABS : constant := 16#03#;
EV_MSC : constant := 16#04#;
BTN_MOUSE : constant := 16#110#;
BTN_LEFT : constant := 16#110#;
BTN_RIGHT : constant := 16#111#;
BTN_MIDDLE : constant := 16#112#;
REL_X : constant := 16#00#;
REL_Y : constant := 16#01#;
REL_WHEEL : constant := 16#08#;
-- Time value (sys/time.h)
subtype suseconds_t is C.long;
subtype time_t is C.long;
type timeval is record
tv_sec : time_t;
tv_usec : suseconds_t;
end record;
pragma Convention (C, timeval);
-- Input event struct (linux/input.h)
type input_event is record
time : timeval;
typ : C.unsigned_short;
code : C.unsigned_short;
value : C.int;
end record;
pragma Convention (C, input_event);
-- ... and a package instantiation for sequential IO.
package Input_Event_IO is new Ada.Sequential_IO (input_event);
use Input_Event_IO;
File : File_Type;
Event : input_event;
-- Position of the mouse and wheel.
X, Y, W : C.int := 0;
begin
Open (File, In_File, "/dev/input/event0");
-- Infinite loop, use Ctrl-C to exit.
loop
-- Wait for a new event.
Read (File, Event);
-- Process the event.
case Event.typ is
when EV_SYN =>
Ada.Text_IO.Put_Line
(X'Image & "," & Y'Image & " [" & W'Image & "]");
when EV_KEY =>
case Event.code is
when BTN_LEFT =>
Ada.Text_IO.Put_Line ("Left button.");
when BTN_MIDDLE =>
Ada.Text_IO.Put_Line ("Middle button.");
when BTN_RIGHT =>
Ada.Text_IO.Put_Line ("Right button.");
when others =>
null;
end case;
when EV_REL =>
case Event.code is
when REL_X =>
X := X + Event.value;
when REL_Y =>
Y := Y + Event.value;
when REL_WHEEL =>
W := W + Event.value;
when others =>
null;
end case;
when EV_ABS =>
case Event.code is
when REL_X =>
X := Event.value;
when REL_Y =>
Y := Event.value;
when REL_WHEEL =>
W := Event.value;
when others =>
null;
end case;
when others =>
null;
end case;
end loop;
end Main;
output (running on a headless RPi 3)
pi#raspberrypi:~/mouse $ sudo obj/main
[...]
-85, 9 [-5]
-84, 9 [-5]
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Left button.
-83, 9 [-5]
Right button.
-83, 9 [-5]
Right button.
-83, 9 [-5]
Middle button.
-83, 9 [-5]
Middle button.
-83, 9 [-5]
-84, 9 [-5]
^C
pi#raspberrypi:~/mouse $
I have an array like this:
{
"Test":
[
0,
1,
2,
3,
4
]
}
I'm using GNATCOLL.JSON but I don't see any function to handle arrays and do something like this, for example:
integer = Test (2);
You might want to try:
function Get (Val : JSON_Value; Field : UTF8_String) return JSON_Array
and then
function Get (Arr : JSON_Array; Index : Positive) return JSON_Value
and then
function Get (Val : JSON_Value; Field : UTF8_String) return Integer
As an example, running the program:
main.adb
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with Ada.Strings.Unbounded;
with GNATCOLL.JSON;
procedure Main is
use Ada.Text_IO;
use Ada.Strings.Unbounded;
Input : Unbounded_String := Null_Unbounded_String;
begin
-- Read.
declare
use Ada.Text_IO.Unbounded_IO;
Fd : File_Type;
begin
Open (Fd, In_File, "./example.json");
while not End_Of_File (Fd) loop
Input := Input & Unbounded_String'(Get_Line (Fd));
end loop;
Close (fd);
end;
-- Process.
declare
use GNATCOLL.JSON;
Root : JSON_Value := Read (Input);
Test : JSON_Array := Root.Get ("Test");
begin
for I in 1 .. Length (Test) loop
Put_Line ("Array element :" & Integer'Image (Get (Test, I).Get));
end loop;
end;
end Main;
with
example.json
{
"Test":
[
0,
1,
2,
3,
4
]
}
yields
$ ./main
Array element : 0
Array element : 1
Array element : 2
Array element : 3
Array element : 4
My requirement is to compare the two array values using case statement. So I am using a for loop for all iterations.
Both are Input arrays : Memory_in array(expression) values are compared with sorted_array(choice) array values and Shaped_data is the output array (case statements).
I am getting static case error for my code below:
process (clk)
variable in_array: sorted;
variable out_array: sorted;
begin
-- in_array := sorted_array;
if rising_edge(clk) then
for i in 0 to 15 loop
case (Memory_in(i)) is
when sorted_array(0) => out_array(i) := x"F";
when sorted_array(1) => out_array(i) := x"E";
when sorted_array(2) => out_array(i) := x"D";
when sorted_array(3) => out_array(i) := x"C";
when sorted_array(4) => out_array(i) := x"B";
when sorted_array(5) => out_array(i) := x"A";
when sorted_array(6) => out_array(i) := x"9";
when sorted_array(7) => out_array(i) := x"8";
when sorted_array(8) => out_array(i) := x"7";
when sorted_array(9) => out_array(i) := x"6";
when sorted_array(10) => out_array(i) := x"5";
when sorted_array(11) => out_array(i) := x"4";
when sorted_array(12) => out_array(i) := x"3";
when sorted_array(13) => out_array(i) := x"2";
when sorted_array(14) => out_array(i) := x"1";
when sorted_array(15) => out_array(i) := x"0";
when others => null;--out_array(i) := "ZZZZ";
end case;
end loop;
Shaped_Data <= out_array;
end if;
end process;
The logic can be implemented using if else statement also but case statement would require less hardware. So I thought case statement would be better.
Is this error because of i value ? how do i do this ?
Whenever you find a big but regular structure, you can usually exploit that regularity. In this case, it simply means another loop.
What you have written reduces to something very like this:
process (clk)
variable out_array: sorted;
begin
-- in_array := sorted_array;
if rising_edge(clk) then
for i in 0 to 15 loop
for j in 0 to 15 loop
if Memory_in(i) = sorted_array(j) then
out_array(i) := 15 - j; -- maybe via type conversion
end if;
end loop;
end loop;
Shaped_Data <= out_array;
end if;
end process;
The syntax of a VHDL case statement is:
[Label:] case Expression is
when Choices => SequentialStatements... {any number of
when parts}
end case [Label];
Choices = Choice | Choice | ...
Choice = {one of}
ConstantExpression
Range
others {the last branch}
It's an error because the choice must be one of
constant expression
range
others
In your code the choice (sorted_array) is none of these; you say it is an "input".
Tip: Assign your case selection vector to a local process variable. (I don't know why, but, VHDL just requires you to do this.) Also, while you are assigning it to a local variable of the process, convert std_logic_vector to "unsigned" then "resize" it to the width of your case literals. Example:
process(amm_addr)
variable addr :unsigned(31 downto 0);
begin
addr := resize(unsigned(amm_addr),32);
...
case addr is
when X"00000008" => null;
when others => null;
end case;
end process;
A more detailed example:
library ieee;
use ieee.std_logic_1164.all;
use ieee.numeric_std.all; --for "unsigned" type and "resize" funciton
entity testit is
generic(
aw :natural := 12;
dw :natural := 32
);
port(
clk :std_logic;
rstn :std_logic;
amm_addr :std_logic_vector(aw-1 downto 0);
amm_wen :std_logic;
amm_wdata :std_logic_vector(dw-1 downto 0);
amm_ren :std_logic;
amm_rdata :std_logic_vector(dw-1 downto 0);
amm_rvalid :std_logic
);
end entity;
architecture sim of testit is
signal reg1 :std_logic_vector(dw-1 downto 0);
signal reg2 :std_logic_vector(dw-1 downto 0);
signal reg3 :std_logic_vector(dw-1 downto 0);
signal reg4 :std_logic_vector(dw-1 downto 0);
begin
process(clk, rstn)
variable addr :unsigned(31 downto 0);
begin
addr := resize(unsigned(amm_addr),32);
if (rstn = '0') then
reg1 <= (others => '0');
reg2 <= (others => '0');
reg3 <= (others => '0');
reg4 <= (others => '0');
elsif (rising_edge(clk)) then
if (amm_wen = '1') then
case addr is
when X"00000000" => reg1 <= amm_wdata;
when X"00000001" => reg2 <= amm_wdata;
when X"00000002" => reg3 <= amm_wdata;
when X"00000003" => reg4 <= amm_wdata;
when others => null;
end case;
end if;
end if;
end process;
end architecture;
I have a function in ada which has to check a large array of booleans to return a (sparse) value. It is difficult to explain in words, so here's an 'ideal' solution that doesn't work in ada (note that I have more than 3 challenger types and tougher logic):
type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
type Challengers is array (ChallengerType) of Boolean;
pragma Pack(Challengers);
-- NOT legal, challengers is not an enumeration type
matchups : array (Challengers) of ChallengerType := (
-- Single challenger victories
(Rock => True, others => False) => Rock,
(Paper => True, others => False) => Paper,
(Scissors => True, others => False) => Scissors,
-- Double challenger victories
(Rock => True, Paper => True, others => False) => Paper,
(Rock => True, Scissors => True, others => False) => Rock,
(Paper => True, Scissors => True, others => False) => Scissors,
-- All the rest either are ambiguous (RPS) or suicided
others => None)
This is not legal in Ada, so I went with the more c-style version where my array was of Integer range 0..2#11111# and wrote a converter. However the code becomes much less clean (EG: (2#00101# => Scissors) is not as clear).
What would be the 'best' way to implement such a matchup array?
Summary: I want a mapping from the power set of an enumeration type to one of its values. IE: if my enumeration was {A,B,C} I would want a mapping from {{},{A},{B},{C},{A,B},{A,C},{B,C},{A,B,C}} to {A,B,C}. I also know in advance that most of the values in the mapping will be the same type, so the others keyword would be very nice to use. Currently I use binary indexing with '1' meaning that the specified enum element is present, but I wish I could be more explicit.
A somewhat simpler answer uses the Vector type from the Ada.Containers.Vectors package:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
use Type Ada.Containers.Count_Type;
procedure Mapping_Vector is
type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
type Challengers is array (ChallengerType) of Boolean with Pack;
package Challenge_Vect is new Ada.Containers.Vectors(Positive, ChallengerType);
use Challenge_Vect;
function Map_Challengers(Item : in Challengers) return Vector is
Result : Vector := Empty_Vector;
begin
for I in Item'Range loop
if Item(I) then
Result.Append(I);
end if;
end loop;
return Result;
end Map_Challengers;
Foo : Challengers := (Rock..Scissors => True, Others => False);
Mapped_Challengers : Vector := Map_Challengers(Foo);
begin
If Mapped_Challengers.Length > 0 then
for C of Mapped_Challengers loop
Put_Line(ChallengerType'Image(C));
end loop;
else
Put_Line("No challengers were TRUE");
end if;
end Mapping_Vector;
This is not a purely static solution, but it makes it possible to configure the mapping elegantly in terms of enumeration values, even if the mapping array in reality is indexed by a modular type:
Specification:
with Ada.Text_IO;
with Ada.Unchecked_Conversion;
generic
type Element_Type is (<>);
type Numeric_Type is mod <>;
package Set_With_Modular_Representation is
type Instance is array (Element_Type) of Boolean with Pack;
Empty_Set : constant Numeric_Type := 0;
E : Numeric_Type renames Empty_Set; -- Got a request not to use Ø.
function "&" (Left : in Instance;
Right : in Instance) return Numeric_Type;
function "&" (Left : in Numeric_Type;
Right : in Instance) return Numeric_Type;
function "&" (Left : in Element_Type;
Right : in Element_Type) return Numeric_Type;
function "&" (Left : in Numeric_Type;
Right : in Element_Type) return Numeric_Type;
private
pragma Assert (Numeric_Type'Modulus = 2 ** Instance'Size);
pragma Assert (Numeric_Type'Size = Instance'Size);
function Numeric is
new Ada.Unchecked_Conversion (Source => Instance,
Target => Numeric_Type);
function Numeric (Item : in Element_Type) return Numeric_Type;
end Set_With_Modular_Representation;
Implementation:
package body Set_With_Modular_Representation is
function "&" (Left : in Instance;
Right : in Instance) return Numeric_Type is
begin
return Numeric (Left) or Numeric (Right);
end "&";
function "&" (Left : in Numeric_Type;
Right : in Instance) return Numeric_Type is
begin
return Left or Numeric (Right);
end "&";
function "&" (Left : in Element_Type;
Right : in Element_Type) return Numeric_Type is
begin
return Numeric (Left) or Numeric (Right);
end "&";
function "&" (Left : in Numeric_Type;
Right : in Element_Type) return Numeric_Type is
begin
return Left or Numeric (Right);
end "&";
function Numeric (Item : in Element_Type) return Numeric_Type is
Buffer : Instance := (others => False);
begin
Buffer (Item) := True;
return Numeric (Buffer);
end Numeric;
end Set_With_Modular_Representation;
Demonstration:
with Ada.Command_Line;
with Ada.Text_IO;
with Set_With_Modular_Representation;
procedure Set_With_Modular_Representation_Demo is
type Outcomes is (Paper, Rock, Scissors, Suicide, None);
subtype Choices is Outcomes range Paper .. Scissors;
type Numeric_Choices is mod 2 ** 3;
package Choice_Set is
new Set_With_Modular_Representation (Element_Type => Choices,
Numeric_Type => Numeric_Choices);
use Choice_Set;
Mapping : array (Numeric_Choices) of Outcomes := (others => None);
begin
Set_Up_Mapping :
begin
-- Single challenger victories
Mapping (E & Rock) := Rock;
Mapping (E & Paper) := Paper;
Mapping (E & Scissors) := Scissors;
-- Double challenger victories
Mapping (Rock & Paper) := Paper;
Mapping (Rock & Scissors) := Rock;
Mapping (Paper & Scissors) := Scissors;
end Set_Up_Mapping;
Test :
declare
package Outcome_Text_IO is
new Ada.Text_IO.Enumeration_IO (Outcomes);
use Ada.Command_Line, Ada.Text_IO, Outcome_Text_IO;
Chosen : Numeric_Choices := E;
begin
for Index in 1 .. Argument_Count loop
Chosen := Chosen & Choices'Value (Argument (Index)); -- '
end loop;
Put ("Outcome: ");
Put (Mapping (Chosen));
New_Line;
end Test;
end Set_With_Modular_Representation_Demo;
NOT an answer... posting in case it helps someone see a way forward.
This expands on my comment above : as far as generating a discrete type from an array goes, it appears to work...
with Ada.Unchecked_Conversion;
package RPS is
type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
for ChallengerType use (Rock => 1, Paper => 2,Scissors => 4,Suicide => 8,None => 16);
type Challengers is array (ChallengerType) of Boolean with Pack;
type Challengers_int is range 0 .. 31;
function IDX is new Ada.Unchecked_Conversion(Challengers, Challengers_int);
Rock_Only : constant Challengers := (Rock => True, others => False);
Rock_IDX : constant Challengers_int := IDX(Rock_Only);
matchups : constant array (Challengers_int) of ChallengerType := (
-- Single challenger victories
-- Rock_IDX => Rock, -- fails
1 => Rock,
IDX((Paper => True, others => False)) => Paper, -- fails
IDX((Scissors => True, others => False)) => Scissors,
-- Double challenger victories
IDX((Rock => True, Paper => True, others => False)) => Paper,
IDX((Rock => True, Scissors => True, others => False)) => Rock,
IDX((Paper => True, Scissors => True, others => False)) => Scissors,
-- All the rest either are ambiguous (RPS) or suicided
others => None);
end RPS;
However, it fails to compile, dynamic or empty choice in aggregate must be the only choice at either of the commented lines in the array - even if the index is a constant rather than an expression.
A Case statement fails similarly :
case IDX(C) is
when Rock_IDX => return Rock;
when IDX((Paper => True, others => False)) => return Paper;
...
compiler reports:
rps.adb:11:10: choice given in case statement is not static
rps.adb:11:10: "Rock_IDX" is not a static constant (RM 4.9(5))
rps.adb:12:10: choice given in case statement is not static
rps.adb:12:10: non-static function call (RM 4.9(6,18)) rps.adb:12:14:
static expression must have scalar or string type (RM 4.9(2))
Here is one solution:
with Ada.Text_IO; use Ada.text_IO;
procedure Mapping_Question is
type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
type Challengers is array (ChallengerType range <>) of Boolean with Pack;
Type Mapped_Challenges is array(Positive range <>) of ChallengerType;
function Map_Challengers(Item : Challengers) return Mapped_Challenges is
function Mapper(Item : Challengers) return Mapped_Challenges is
Single : Mapped_Challenges(1..1);
begin
for I in Item'Range loop
if Item(I) then
if I < Item'Last then
return I & Mapper(Item(ChallengerType'Succ(I)..Item'Last));
else
Single(Single'First) := I;
return Single;
end if;
end if;
end loop;
Single(Single'First) := None;
return Single;
end Mapper;
begin
return Mapper(Item);
end Map_Challengers;
procedure Print_Challenges(Item : Mapped_Challenges) is
begin
for I in Item'Range loop
Put_Line(ChallengerType'Image(Item(I)));
end loop;
end Print_Challenges;
Foo : Challengers(Rock..None) := (Rock..Scissors => True, Others => False);
begin
declare
Mapping : Mapped_Challenges := Map_Challengers(Foo);
begin
if Mapping'Length > 1 then
Print_Challenges(Mapping(Mapping'First..Mapping'Last - 1));
else
Print_challenges(Mapping);
end if;
end;
end Mapping_Question;
The following approach uses currying of sorts. To further simplify the example, I have shortened the enumeration type to three values. The solution is static, but the “elegance” of using the enumeration values directly is gone. If a static constant is not needed, then, as other approaches show, constant function tables F and T from ChallengerType into Boolean will be a possibility, the named components then appearing as T (Paper) => ... etc.
pragma Pure (Rps);
type ChallengerType is (Rock,Paper,None);
type Challengers1 is array (Boolean) of Challengertype;
type Challengers2 is array (Boolean) of Challengers1;
type Challengers3 is array (Boolean) of Challengers2;
Matchups : constant Challengers3 :=
-- Rock:
(True => --> Paper:
(True => --> None:
(False => Paper,
True => None),
False => --> None:
(others => Rock)),
-- Rock:
False => --> Paper:
(True => --> None:
(False => Paper,
True => None),
False =>
(others => None))
);
Solution using constants
This is not an elegant solution but it may help as a part of a better solution.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with System;
with System.Unsigned_Types;
procedure Main is
subtype S is System.Unsigned_Types.Unsigned range 0 .. 31;
use type S;
function Shift_Left (Value : S; Amount : Natural) return S renames System.Unsigned_Types.Shift_Left;
Rock : constant S := Shift_Left (1, 0);
Paper : constant S := Shift_Left (1, 1);
Scissors : constant S := Shift_Left (1, 2);
Suicide : constant S := Shift_Left (1, 3);
None : constant S := Shift_Left (1, 4);
P : array (S) of S := (others => None);
begin
P (Rock or Paper) := Paper;
P (Rock or Scissors) := Rock;
P (Paper or Scissors) := Scissors;
Put_Line ("P(Paper or Scissors) = Scissors");
Put ("P(");
Put (Integer (Paper), 0, 2);
Put (" or ");
Put (Integer (Scissors), 0, 2);
Put (") = P(");
Put (Integer (Paper or Scissors), 0, 2);
Put (") = ");
Put (Integer (P (Paper or Scissors)), 0, 2);
Put ("");
end;
Result
P(Paper or Scissors) = Scissors
P(2#10# or 2#100#) = P(2#110#) = 2#100#
Solution using enumeration
with Ada.Text_IO; use Ada.Text_IO;
with System;
with System.Unsigned_Types;
procedure Main is
type T is (Rock, Paper, Scissors, Suicide, None);
subtype S is System.Unsigned_Types.Unsigned range 0 .. 31;
use type S;
function B (Value : T) return S is (System.Unsigned_Types.Shift_Left (1, T'Pos (Value)));
function "&" (Left : T; Right : T) return S is (System.Unsigned_Types."or" (B (Left), B (Right)));
P : array (S) of T := (others => None);
begin
P (Rock & Paper) := Paper;
P (Rock & Scissors) := Rock;
P (Paper & Scissors) := Scissors;
Put_Line (T'Image (P (Rock & Paper)));
Put_Line (T'Image (P (Rock & Scissors)));
Put_Line (T'Image (P (Paper & Scissors)));
end;
Result
PAPER
ROCK
SCISSORS
With help from many sources, I have a working generic thing for a ring-buffer, with push and read of single elements:
q.ads:
generic
Q_SIZE : POSITIVE;
type T is private;
package Q is
subtype SIZE_TYPE is NATURAL range 0 .. Q_SIZE;
subtype Q_INDEX_TYPE is SIZE_TYPE range 1 .. SIZE_TYPE'last;
type Q_ARRAY_TYPE is array (Q_INDEX_TYPE) of T;
procedure INITIALIZE;
procedure PUSH(element : T);
function READ return T;
end Q;
q.adb:
package body Q is
Q_ARRAY : Q_ARRAY_TYPE;
TAIL : Q_INDEX_TYPE;
HEAD : Q_INDEX_TYPE;
...
end Q;
My test program instantiates the above for bytes and exercises the ring. It is basically as follows:
package body main is
package RING is new Q (15, UNSIGNED.BYTE);
procedure TEST is
byteval : UNSIGNED.BYTE;
begin
byteval := 16;
RING.PUSH(byteval);
...
I would now like to add the ability to pass an array of T in. I've add this to the ADS and ADB files:
procedure PUSH_ARRAY(DATA_ARRAY : Q_ARRAY_TYPE; COUNT : SIZE_TYPE);
My problem is in the test program. I've changed it to this:
BYTE_ARRAY : array (1 .. 10) of UNSIGNED.BYTE;
procedure TEST is begin
-- initialize the first 5 elements of BYTE_ARRAY, then
RING.PUSH_ARRAY(BYTE_ARRAY, 5);
this last line gives me an error message: expected type Q_ARRAY_TYPE defined at Q.ADS:xx. How do I pass a BYTE ARRAY to my method which expects an instance of the generic array?
Question: What is the purpose of SIZE_TYPE?
In Ada, the 'Length attribute will return the size of the array in Natural (the nonnegative Integer subtype). With that in mind, it doesn't seem to make sense to declare an extra subtype with an extra value for the index.
Ring_Buffer.ads
Generic
Type T is private;
Default : T;
Size : Positive;
Package Ring_Buffer is
SubType Index is Positive range 1..Size;
Type Ring is private;
Function Length( Obj : Ring ) return Natural;
Function Pop( Obj : in out Ring ) return T
with Pre => Length(Obj) in Positive,
Post => Length(Obj'Old)-1 = Length(Obj); --' --Highlight fix
Procedure Push( Obj : in out Ring; Item : in T )
with Pre => Length(Obj) < Size,
Post => Length(Obj'Old)+1 = Length(Obj); --'
Private
Type Internal_Data is Array(Index) of T;
Type Ring is record
Start : Positive:= Internal_Data'First; --'
Size : Natural:= 0;
Data : Internal_Data:= (Others => Default);
end record
with Type_Invariant => Ring.Size <= Size;
Function Length( Obj : Ring ) return Natural is
( Obj.Size );
End Ring_Buffer;
Ring_Buffer.adb
Package Body Ring_Buffer is
Function Pop( Obj : in out Ring ) return T is
Begin
return Result : constant T := Obj.Data(Obj.Start) do
Obj.Size:= Natural'Pred( Obj.Size ); --'
Obj.Start:= (if Obj.Start = Size then 1 else Obj.Start + 1);
end return;
End Pop;
Procedure Push( Obj : in out Ring; Item : in T ) is
Begin
Obj.Data( Natural'Succ((Obj.Start-1) + Obj.Size mod Size) ):= Item; --'
Obj.Size:= Obj.Size + 1;
End Push;
End Ring_Buffer;