Ссылочные типы в языке Ада. Передача подпрограмм по ссылке.

Иногда (например, при коллективном написании программы), в зависимости от наступления какого-то события необходимо вызвать ту или иную подпрограмму из какого-то пакета, но реализация её скрыта. Например, программу пишут два программиста. Первый программист даёт второму список подпрограмм, которые будут реализованы в создаваемом им пакете,  и некий интерфейс (подпрограмму) вызова этих подпрограмм. В этом случае логично использовать передачу подпрограмм по ссылке. Немножко сумбурное объяснение получилось. Рассмотрим пример. Он очень простой и в нём можно легко обойтись без ссылок, но думаю, что эта простота поможет понять материал.

Пусть у нас есть массив:

0 0 0 0 0
0 0 0 0 0
0 0 1 0 0
0 0 0 0 0
0 0 0 0 0

Для перемещения единички по этому массиву используются стрелки на клавиатуре. Например, пусть была нажата стрелка вверх, тогда наш массив будет выглядеть уже так:

0 0 0 0 0
0 0 1 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0

Так как стрелок всего 4 то для перемещения по массиву создадим 4 подпрограммы:

procedure Step_Left(mas : in out Matrix);
procedure Step_Right(mas : in out Matrix);
procedure Step_Up(mas : in out Matrix);
procedure Step_Down(mas : in out Matrix)

Для решения задачи создадим тип ссылки на эти подпрограммы и процедуру Move, которая по ссылке вызывает нужную подпрограмму:

type Access_Procedure is Access procedure(mas : in out Matrix); --Тип ссылки на процедуру
...
procedure Move(F : in Access_Procedure; mas : in out Matrix) is
--Перемещение единицы. Подпрограмме в качестве параметра передаётся ссылка на процедуру и массив
begin
    F(mas);
end;

Таким образом, передавая подпрограмме Move ссылку на нужную процедуру и массив, мы получим смещение единицы. При этом сама передача подпрограммы по ссылке осуществляется с помощью атрибута Access:

Move(F => Step_Left'Access, mas => our_mas);

Обработка нажатия стрелок на клавиатуре в Linux и Windows немного отличается. Дело в том, что коды стрелок относятся к расширенным кодам клавиш. При нажатии стрелок в Windows возвращается два кода: 224 и непосредственно код стрелки:

  • Стрелка влево - 75
  • Стрелка вправо - 77
  • Стрелка вверх - 72
  • Стрелка вниз - 80

В Linux-консоли (а там обычно UTF-8), возвращается три кода: 27 (в чистом виде код клавиши ESC), 91(код '[' ) и код стрелки:

  • Стрелка влево - Код символа 'D'
  • Стрелка вправо - Код символа 'C'
  • Стрелка вверх - Код символа 'A'
  • Стрелка вниз - Код символа 'B'

Это нужно учитывать при написании программ.

Для обработки нажатия служебных клавиш в паре с Get_Immediate(ch) можно использовать Get_Immediate(ch, More), где ch имеет тип Character, а More - тип Boolean. Таким образом, если была нажата служебная клавиша (код которой состоит из нескольких чисел), то в буфере клавиатуры после первого Get_Immediate (см. выше) останется "хвост". Для проверки его наличия используется процедура Get_Immediate с двумя переменными. Если буфер клавиатуры не пуст (т.е. хвост есть), то More будет True.

Для простоты я не буду делить итоговую программу на пакеты, хотя реализацию процедур перемещения единицы и процедуры Move можно вынести в отдельный пакет. Выход из программы осуществляется при нажатии клавиши 'x'.

Реализация для ОС Windows

with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling; use Ada.Characters.Handling;
 
procedure main is
    type Matrix is array(1..5, 1..5) of Integer;
    type Access_Procedure is Access procedure(mas : in out Matrix);
 
    procedure Get_One(ipos, jpos : in out Integer; mas : in Matrix) is
    --Получить координаты единицы в массиве
    begin
 
        Main_Loop: for i in mas'Range(1) loop
            for j in mas'Range(2) loop
                if mas(i, j) = 1 then
                    ipos := i;
                    jpos := j;
                    exit Main_Loop;
                end if;
            end loop;
        end loop Main_Loop;
    end Get_One;
 
    procedure Show_Matrix(mas : in Matrix) is
    --Вывести массив на экран
    begin
        for i in mas'Range(1) loop
            for j in mas'Range(2) loop
                Put(Item => mas(i, j), Width => 0);
            end loop;
            New_Line;
        end loop;
    end Show_Matrix;
 
    procedure Move(F : in Access_Procedure; mas : in out Matrix) is
    --Перемещение единицы
    begin
        F(mas); --вызов процедуры по ссылке
    end;
 
    procedure Step_Left(mas : in out Matrix) is
    --Шаг влево
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if jpos = 1 then
            jpos := mas'Last(2);
        else
            jpos := jpos - 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Left;
 
    procedure Step_Right(mas : in out Matrix) is
    --Шаг вправо
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if jpos = mas'Last(2) then
            jpos := 1;
        else
            jpos := jpos + 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Right;
 
    procedure Step_Up(mas : in out Matrix) is
    --шаг вверх
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if ipos = 1 then
            ipos := mas'Last(1);
        else
            ipos := ipos - 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Up;
 
    procedure Step_Down(mas : in out Matrix) is
    --шаг вниз
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if ipos = mas'Last(1) then
            ipos := 1;
        else
            ipos := ipos + 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Down;
 
    mas : Matrix := ((0,0,0,0,0),
                    (0,0,0,0,0),
                    (0,0,1,0,0),
                    (0,0,0,0,0),
                    (0,0,0,0,0)
                    );
    ch : Character;
    More : Boolean;
 
begin
    loop
        Show_Matrix(mas);
        New_Line;
        --Обработка нажатия клавиши в Windows
        Get_Immediate(ch);
        if Character'Pos(ch) = 224 then
            --Если была нажата служебная клавиша (код которой состоит из нескольких 
            --чисел), то в буфере клавиатуры после первого Get_Immediate (см. выше)
            --останется "хвост". Для проверки его наличия используем форму Get_Immediate
            --с двумя переменными.
            Get_Immediate(ch, More); --Если буфер клавиатуры не пуст, то More будет True
            if More then
            case Character'Pos(ch) is
                --Передача процедуры по ссылке в зависимости от нажатой клавиши
                when 75 => Move(F => Step_Left'Access, mas => mas);
                when 72 => Move(F => Step_Up'Access, mas => mas);
                when 77 => Move(F => Step_Right'Access, mas => mas);
                when 80 => Move(F => Step_Down'Access, mas => mas);
                when others => Put_Line("Некорректный ввод");
            end case;
            end if;
        end if;
        exit when ch = 'x';
    end loop;
end main;

Реализация для ОС Linux:

with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Handling; use Ada.Characters.Handling;
 
procedure main is
    type Matrix is array(1..5, 1..5) of Integer;
    type Access_Procedure is Access procedure(mas : in out Matrix);
 
    procedure Get_One(ipos, jpos : in out Integer; mas : in Matrix) is
    --Получить координаты единицы в массиве
    begin
 
        Main_Loop: for i in mas'Range(1) loop
            for j in mas'Range(2) loop
                if mas(i, j) = 1 then
                    ipos := i;
                    jpos := j;
                    exit Main_Loop;
                end if;
            end loop;
        end loop Main_Loop;
    end Get_One;
 
    procedure Show_Matrix(mas : in Matrix) is
    --Вывести массив на экран
    begin
        for i in mas'Range(1) loop
            for j in mas'Range(2) loop
                Put(Item => mas(i, j), Width => 0);
            end loop;
            New_Line;
        end loop;
    end Show_Matrix;
 
    procedure Move(F : in Access_Procedure; mas : in out Matrix) is
    --Перемещение единицы
    begin
        F(mas);
    end;
 
    procedure Step_Left(mas : in out Matrix) is
    --Шаг влево
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if jpos = 1 then
            jpos := mas'Last(2);
        else
            jpos := jpos - 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Left;
 
    procedure Step_Right(mas : in out Matrix) is
    --Шаг вправо
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if jpos = mas'Last(2) then
            jpos := 1;
        else
            jpos := jpos + 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Right;
 
    procedure Step_Up(mas : in out Matrix) is
    --шаг вверх
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if ipos = 1 then
            ipos := mas'Last(1);
        else
            ipos := ipos - 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Up;
 
    procedure Step_Down(mas : in out Matrix) is
    --шаг вниз
        ipos, jpos : Integer := 1;
    begin
        Get_One(ipos, jpos, mas);
        mas(ipos, jpos) := 0;
        if ipos = mas'Last(1) then
            ipos := 1;
        else
            ipos := ipos + 1;
        end if;
        mas(ipos, jpos) := 1;
    end Step_Down;
 
    mas : Matrix := ((0,0,0,0,0),
                    (0,0,0,0,0),
                    (0,0,1,0,0),
                    (0,0,0,0,0),
                    (0,0,0,0,0)
                    );
    ch : Character;
 
begin
    loop
        Show_Matrix(mas);
        New_Line;
        --Обработка нажатия клавиш
        Get_Immediate(ch);
        if Character'Pos(ch) = 27 then --27 в чистом виде - код ESC, поэтому нужны доп. проверки
            declare
            begin
                Get_Immediate(ch);
                if Is_Special(ch) then --91 - код символа '[', считается специальным символом
                    Get_Immediate(ch);
                    case ch is
                        when 'A' => Move(F => Step_Up'Access, mas => mas);
                        when 'C' => Move(F => Step_Right'Access, mas => mas);
                        when 'B' => Move(F => Step_Down'Access, mas => mas);
                        when 'D' => Move(F => Step_Left'Access, mas => mas);
                        when others => Put_Line("Некорректный ввод");
                    end case;
                end if;
                exception
                    when others => Null;
            end;
        end if;
        exit when ch = 'x';
    end loop;
end main;

Как-то так.

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *