Bonjour,
Cet étage est celui des objets qui constituent l’interface applicative.
L’automaticien est habitué aux fonctions et blocs fonctions.
Un bloc fonction, ce n’est jamais qu’un objet qui ne propose qu’une seule méthode.
On instancie ce bloc fonction ou l’on crée un bloc de données d’instance et on appelle le bloc en accolant cet appel à l’instance.
Comme il ne propose qu’une seule méthode, l’interface du bloc fonction doit présenter tous les paramètres, commandes et résultats (IN, OUT, IN_OUT), ce qui alourdit très rapidement celle-ci d’autant plus si la représentation est graphique.
Ada dispose de la notion d’objet depuis 1995. On a toujours des données d’instance mais il est possible pour un objet de posséder diverses méthodes comme nous allons le voir.
En fait, on l’a déjà vu avec l’objet « A4A.Protocols.HilscherX.Channel_Messaging » mais celui-ci n’a pas vocation à être utilisé au niveau application.
Dans tous les exemples précédents, nous avons mis en œuvre la requête permettant de lire les informations concernant le firmware de la carte Hilscher cifX.
Pour gérer cette requête il faut un certain nombre de variables, remplir la requête, l’envoyer, attendre la réponse, recevoir et analyser celle-ci.
Encapsulons tout cela dans un objet et nous augmenterons l’abstraction.
C’est ce que réalise le « Function Block » dont la spécification suit « A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB ».
Comme le paquetage contenant notre objet est fils de « A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify » il hérite de ce qui y est défini et peut donc y utiliser à sa guise.
On trouve dans cette spécification la définition de l’interface de notre objet, constituée des quatre procédures et fonctions, ainsi que celle des données d’instance.
La procédure « Initialise » permet d’associer le bloc au canal de communication.
La procédure « Cyclic » doit bien sûr être appelée cycliquement, tout au moins durant l’exécution de la commande, pour actualiser la machine d’état du bloc.
Les fonctions « Get_Last_Error » et « Get_Data » fournissent les données résultat.
-----------------------------------------------------------------------
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
-- <summary>
-- This package is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>
with A4A.Log;
with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX;
package A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is
type Instance is tagged limited private;
type Instance_Access is access all Instance;
procedure Initialise
(Function_Block : in out Instance;
Channel_Access : in Channel_Messaging.Instance_Access);
procedure Cyclic
(Function_Block : in out Instance;
Do_Command : in Boolean;
Done : out Boolean;
Error : out Boolean);
function Get_Last_Error
(Function_Block : in Instance) return DWord;
function Get_Data
(Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T;
private
My_Ident : String :=
"A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB";
type Block_Status is
(X00,
-- Initial
X01,
-- Get packet from pool
X02,
-- Fill packet
X03,
-- Send packet
X04,
-- Get answer
X05
-- Done
);
type Instance is tagged limited
record
My_Channel : Channel_Messaging.Instance_Access;
Status : Block_Status := X00;
Request : cifX_Packet_Access;
Confirmation : cifX_Packet_Access;
Fw_Ident_Req : RCX_FIRMWARE_IDENTIFY_REQ_T_Access;
Fw_Ident_Cnf : RCX_FIRMWARE_IDENTIFY_CNF_T_Access;
Message_Id : DWord := 0;
Packet_Got : Boolean := False;
Packet_Sent : Boolean := False;
Answer_Got : Boolean := False;
My_Receive_Queue : aliased
Channel_Messaging.Queue_Package_Single.Message_Queue_Type;
Fw_Identification : RCX_FW_IDENTIFICATION_T;
Error_Flag : Boolean;
Last_Error : DWord;
end record;
end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
-- <summary>
-- This package is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>
with A4A.Log;
with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX;
package A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is
type Instance is tagged limited private;
type Instance_Access is access all Instance;
procedure Initialise
(Function_Block : in out Instance;
Channel_Access : in Channel_Messaging.Instance_Access);
procedure Cyclic
(Function_Block : in out Instance;
Do_Command : in Boolean;
Done : out Boolean;
Error : out Boolean);
function Get_Last_Error
(Function_Block : in Instance) return DWord;
function Get_Data
(Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T;
private
My_Ident : String :=
"A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB";
type Block_Status is
(X00,
-- Initial
X01,
-- Get packet from pool
X02,
-- Fill packet
X03,
-- Send packet
X04,
-- Get answer
X05
-- Done
);
type Instance is tagged limited
record
My_Channel : Channel_Messaging.Instance_Access;
Status : Block_Status := X00;
Request : cifX_Packet_Access;
Confirmation : cifX_Packet_Access;
Fw_Ident_Req : RCX_FIRMWARE_IDENTIFY_REQ_T_Access;
Fw_Ident_Cnf : RCX_FIRMWARE_IDENTIFY_CNF_T_Access;
Message_Id : DWord := 0;
Packet_Got : Boolean := False;
Packet_Sent : Boolean := False;
Answer_Got : Boolean := False;
My_Receive_Queue : aliased
Channel_Messaging.Queue_Package_Single.Message_Queue_Type;
Fw_Identification : RCX_FW_IDENTIFICATION_T;
Error_Flag : Boolean;
Last_Error : DWord;
end record;
end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
Le corps de notre objet dans lequel les méthodes sont implémentées est disponible ci-dessous.
On y trouve dans la fonction cyclique le traitement de la machine d’état.
-----------------------------------------------------------------------
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
-- <summary>
-- This package is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>
package body A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is
procedure Initialise
(Function_Block : in out Instance;
Channel_Access :Channel_Messaging.Instance_Access) is
begin
Function_Block.My_Channel := Channel_Access;
Function_Block.Status := X00;
Function_Block.Error_Flag := False;
end Initialise;
procedure Cyclic
(Function_Block : in out Instance;
Do_Command : in Boolean;
Done : out Boolean;
Error : out Boolean) is
begin
case Function_Block.Status is
when X00 =>
if Do_Command then
Function_Block.Error_Flag := False;
Function_Block.Status := X01;
Function_Block.Message_Id := Function_Block.Message_Id + 1;
end if;
when X01 =>
Function_Block.My_Channel.Get_Packet
(Item => Function_Block.Request,
Result => Function_Block.Packet_Got);
if Function_Block.Packet_Got then
Function_Block.Status := X02;
end if;
when X02 =>
Function_Block.Fw_Ident_Req :=
From_cifX_Packet (Function_Block.Request);
Function_Block.Fw_Ident_Req.Head.Dest := 16#20#;
Function_Block.Fw_Ident_Req.Head.Src :=
Channel_Messaging.Queue_Package_Type_Single;
Function_Block.Fw_Ident_Req.Head.Dest_Id := 0;
Function_Block.Fw_Ident_Req.Head.Src_Id :=
Channel_Messaging.Queue_Package_Single.From_Message_Queue
(Function_Block.My_Receive_Queue'Unrestricted_Access);
Function_Block.Fw_Ident_Req.Head.Len := 4;
Function_Block.Fw_Ident_Req.Head.Id :=
Function_Block.Message_Id;
Function_Block.Fw_Ident_Req.Head.State := 0;
Function_Block.Fw_Ident_Req.Head.Cmd :=
RCX_FIRMWARE_IDENTIFY_REQ;
Function_Block.Fw_Ident_Req.Head.Ext := 0;
Function_Block.Fw_Ident_Req.Head.Rout := 0;
Function_Block.Fw_Ident_Req.Data.Channel_Id := 0;
Function_Block.Status := X03;
when X03 =>
Function_Block.My_Channel.Send
(Item => Function_Block.Request,
Result => Function_Block.Packet_Sent);
if Function_Block.Packet_Sent then
Function_Block.Status := X04;
end if;
when X04 =>
Function_Block.My_Receive_Queue.Get
(Item => Function_Block.Confirmation,
Result => Function_Block.Answer_Got);
if Function_Block.Answer_Got then
Function_Block.Fw_Ident_Cnf :=
From_cifX_Packet (Function_Block.Confirmation);
if Function_Block.Fw_Ident_Cnf.Head.Cmd /=
RCX_FIRMWARE_IDENTIFY_CNF then
Function_Block.Error_Flag := True;
A4A.Log.Logger.Put
(Who => My_Ident & ".Cyclic",
What => "Wrong Command received");
elsif Function_Block.Fw_Ident_Cnf.Head.Id /=
Function_Block.Message_Id then
Function_Block.Error_Flag := True;
A4A.Log.Logger.Put
(Who => My_Ident & ".Cyclic",
What => "Wrong Message Id received");
elsif Function_Block.Fw_Ident_Cnf.Head.State /= 0 then
Function_Block.Error_Flag := True;
Function_Block.Last_Error :=
Function_Block.Fw_Ident_Cnf.Head.State;
else
Function_Block.Fw_Identification :=
Function_Block.Fw_Ident_Cnf.Data.Fw_Identification;
end if;
Function_Block.My_Channel.Return_Packet
(Item => Function_Block.Confirmation);
Function_Block.Status := X05;
end if;
when X05 =>
if not Do_Command then
Function_Block.Status := X00;
end if;
end case;
Done := (Function_Block.Status = X05);
Error := Function_Block.Error_Flag;
end Cyclic;
function Get_Last_Error
(Function_Block : in Instance) return DWord is
begin
return Function_Block.Last_Error;
end Get_Last_Error;
function Get_Data
(Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T is
begin
return Function_Block.Fw_Identification;
end Get_Data;
end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
-- <summary>
-- This package is part of the binding to Hilscher cifX Device Driver,
-- a library allowing access to the cifX boards with numerous protocols.
-- </summary>
-- <description>
-- It provides :
-- - rcX_Public data types
-- </description>
-- <group>Protocols</group>
-- <c_version>3.0.1</c_version>
package body A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB is
procedure Initialise
(Function_Block : in out Instance;
Channel_Access :Channel_Messaging.Instance_Access) is
begin
Function_Block.My_Channel := Channel_Access;
Function_Block.Status := X00;
Function_Block.Error_Flag := False;
end Initialise;
procedure Cyclic
(Function_Block : in out Instance;
Do_Command : in Boolean;
Done : out Boolean;
Error : out Boolean) is
begin
case Function_Block.Status is
when X00 =>
if Do_Command then
Function_Block.Error_Flag := False;
Function_Block.Status := X01;
Function_Block.Message_Id := Function_Block.Message_Id + 1;
end if;
when X01 =>
Function_Block.My_Channel.Get_Packet
(Item => Function_Block.Request,
Result => Function_Block.Packet_Got);
if Function_Block.Packet_Got then
Function_Block.Status := X02;
end if;
when X02 =>
Function_Block.Fw_Ident_Req :=
From_cifX_Packet (Function_Block.Request);
Function_Block.Fw_Ident_Req.Head.Dest := 16#20#;
Function_Block.Fw_Ident_Req.Head.Src :=
Channel_Messaging.Queue_Package_Type_Single;
Function_Block.Fw_Ident_Req.Head.Dest_Id := 0;
Function_Block.Fw_Ident_Req.Head.Src_Id :=
Channel_Messaging.Queue_Package_Single.From_Message_Queue
(Function_Block.My_Receive_Queue'Unrestricted_Access);
Function_Block.Fw_Ident_Req.Head.Len := 4;
Function_Block.Fw_Ident_Req.Head.Id :=
Function_Block.Message_Id;
Function_Block.Fw_Ident_Req.Head.State := 0;
Function_Block.Fw_Ident_Req.Head.Cmd :=
RCX_FIRMWARE_IDENTIFY_REQ;
Function_Block.Fw_Ident_Req.Head.Ext := 0;
Function_Block.Fw_Ident_Req.Head.Rout := 0;
Function_Block.Fw_Ident_Req.Data.Channel_Id := 0;
Function_Block.Status := X03;
when X03 =>
Function_Block.My_Channel.Send
(Item => Function_Block.Request,
Result => Function_Block.Packet_Sent);
if Function_Block.Packet_Sent then
Function_Block.Status := X04;
end if;
when X04 =>
Function_Block.My_Receive_Queue.Get
(Item => Function_Block.Confirmation,
Result => Function_Block.Answer_Got);
if Function_Block.Answer_Got then
Function_Block.Fw_Ident_Cnf :=
From_cifX_Packet (Function_Block.Confirmation);
if Function_Block.Fw_Ident_Cnf.Head.Cmd /=
RCX_FIRMWARE_IDENTIFY_CNF then
Function_Block.Error_Flag := True;
A4A.Log.Logger.Put
(Who => My_Ident & ".Cyclic",
What => "Wrong Command received");
elsif Function_Block.Fw_Ident_Cnf.Head.Id /=
Function_Block.Message_Id then
Function_Block.Error_Flag := True;
A4A.Log.Logger.Put
(Who => My_Ident & ".Cyclic",
What => "Wrong Message Id received");
elsif Function_Block.Fw_Ident_Cnf.Head.State /= 0 then
Function_Block.Error_Flag := True;
Function_Block.Last_Error :=
Function_Block.Fw_Ident_Cnf.Head.State;
else
Function_Block.Fw_Identification :=
Function_Block.Fw_Ident_Cnf.Data.Fw_Identification;
end if;
Function_Block.My_Channel.Return_Packet
(Item => Function_Block.Confirmation);
Function_Block.Status := X05;
end if;
when X05 =>
if not Do_Command then
Function_Block.Status := X00;
end if;
end case;
Done := (Function_Block.Status = X05);
Error := Function_Block.Error_Flag;
end Cyclic;
function Get_Last_Error
(Function_Block : in Instance) return DWord is
begin
return Function_Block.Last_Error;
end Get_Last_Error;
function Get_Data
(Function_Block : in Instance) return RCX_FW_IDENTIFICATION_T is
begin
return Function_Block.Fw_Identification;
end Get_Data;
end A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
Le programme exemple « Test_rcX_Firmware_Identify » met à profit notre nouvel objet.
Après les habituelles initialisations, on entre dans une boucle qui simule le traitement cyclique de votre application d’automatisme.
On en sort lorsqu’un résultat ou une erreur sont obtenus et on les affiche puis on termine proprement.
-----------------------------------------------------------------------
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
with Interfaces.C;
with Ada.Exceptions; use Ada.Exceptions;
with A4A; use A4A;
with A4A.Log;
with A4A.Protocols.HilscherX.cifX_Errors;
use A4A.Protocols.HilscherX.cifX_Errors;
with A4A.Protocols.HilscherX.cifX_User;
with A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
use A4A.Protocols.HilscherX.rcX_Public;
with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX.Channel_Messaging;
procedure Test_rcX_Firmware_Identify is
My_Ident : String := "Test_rcX_Firmware_Identify";
package cifX renames A4A.Protocols.HilscherX.cifX_User;
Driver_Handle : aliased cifX.Driver_Handle_Type;
Channel_Handle : aliased cifX.Channel_Handle_Type;
Result : DInt;
cifX_Driver_Init_Done : Boolean := False;
cifX_Driver_Open_Done : Boolean := False;
cifX_Channel_Open_Done : Boolean := False;
Do_Command : Boolean := False;
Command_Done : Boolean := False;
Command_Error : Boolean := False;
My_Channel_Messaging : aliased
A4A.Protocols.HilscherX.Channel_Messaging.Instance;
rcX_Firmware_Identify_FB : rcX_Firmware_Identify.FB.Instance;
Fw_Identification : rcX_Firmware_Identify.RCX_FW_IDENTIFICATION_T;
Error_String : String (1.. 20);
procedure cifX_Show_Error (Error : DInt) is
begin
A4A.Log.Logger.Put
(Who => My_Ident,
What => cifX.Driver_Get_Error_Description(Error));
end cifX_Show_Error;
procedure cifX_Show_Firmware_Identification is
What : String := CRLF
& "***********************************************" & CRLF
& " Firmware Identification" & CRLF & CRLF
& "Firmware Version :" & CRLF
& "Major : "
& Fw_Identification.Fw_Version.Major'Img & CRLF
& "Minor : "
& Fw_Identification.Fw_Version.Minor'Img & CRLF
& "Build : "
& Fw_Identification.Fw_Version.Build'Img & CRLF
& "Revision : "
& Fw_Identification.Fw_Version.Revision'Img & CRLF
& CRLF
& "Firmware Name : "
& Interfaces.C.To_Ada
(Fw_Identification.Fw_Name.Name) & CRLF
& CRLF
& "Firmware Date :" & CRLF
& "Year : "
& Fw_Identification.Fw_Date.Year'Img & CRLF
& "Month : "
& Fw_Identification.Fw_Date.Month'Img & CRLF
& "Day : "
& Fw_Identification.Fw_Date.Day'Img & CRLF
& "***********************************************" & CRLF;
begin
A4A.Log.Logger.Put (Who => My_Ident,
What => What);
end cifX_Show_Firmware_Identification;
procedure Close is
begin
My_Channel_Messaging.Quit;
--Wait for completion
loop
exit when My_Channel_Messaging.Is_Terminated;
delay 1.0;
end loop;
if cifX_Channel_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Closing Channel");
Result := cifX.Channel_Close (Channel_Handle);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
end if;
cifX_Channel_Open_Done := False;
end if;
if cifX_Driver_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Closing Driver");
Result := cifX.Driver_Close (Driver_Handle);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
end if;
cifX_Driver_Open_Done := False;
end if;
if cifX_Driver_Init_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Deinitializing cifX Driver");
cifX.Driver_Deinit;
cifX_Driver_Init_Done := False;
end if;
A4A.Log.Logger.Put (Who => My_Ident,
What => "finished !");
A4A.Log.Quit;
end Close;
begin
A4A.Log.Logger.Put (Who => My_Ident,
What => "Test_Messaging...");
A4A.Log.Logger.Put (Who => My_Ident,
What => "Initializing cifX Driver");
Result := cifX.Driver_Init;
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Driver_Init_Done := True;
end if;
if cifX_Driver_Init_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Opening Driver");
Result := cifX.Driver_Open (Driver_Handle'Access);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Driver_Open_Done := True;
end if;
end if;
if cifX_Driver_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Opening Channel");
Result := cifX.Channel_Open
(Driver_Handle => Driver_Handle,
Board_Name => "cifX0",
Channel_Number => 0,
Channel_Handle_Access => Channel_Handle'Access);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Channel_Open_Done := True;
end if;
end if;
if cifX_Channel_Open_Done then
My_Channel_Messaging.Initialise (Channel_Handle => Channel_Handle);
rcX_Firmware_Identify_FB.Initialise
(Channel_Access => My_Channel_Messaging'Unrestricted_Access);
loop
Do_Command := not Command_Done;
rcX_Firmware_Identify_FB.Cyclic
(Do_Command => Do_Command,
Done => Command_Done,
Error => Command_Error);
exit when not Do_Command;
delay 0.1;
end loop;
if not Command_Error then
Fw_Identification := rcX_Firmware_Identify_FB.Get_Data;
cifX_Show_Firmware_Identification;
else
DWord_Text_IO.Put
(To => Error_String,
Item => rcX_Firmware_Identify_FB.Get_Last_Error,
Base => 16);
A4A.Log.Logger.Put (Who => My_Ident,
What => "Got an error : " & Error_String);
end if;
end if;
Close;
exception
when Error: others =>
A4A.Log.Logger.Put (Who => My_Ident,
What => Exception_Information(Error));
Close;
end Test_rcX_Firmware_Identify;
-- Ada for Automation --
-- --
-- Copyright (C) 2012-2014, Stephane LOS --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
-----------------------------------------------------------------------
with Interfaces.C;
with Ada.Exceptions; use Ada.Exceptions;
with A4A; use A4A;
with A4A.Log;
with A4A.Protocols.HilscherX.cifX_Errors;
use A4A.Protocols.HilscherX.cifX_Errors;
with A4A.Protocols.HilscherX.cifX_User;
with A4A.Protocols.HilscherX.rcX_Public.rcX_Firmware_Identify.FB;
use A4A.Protocols.HilscherX.rcX_Public;
with A4A.Protocols.HilscherX.Channel_Messaging;
use A4A.Protocols.HilscherX.Channel_Messaging;
procedure Test_rcX_Firmware_Identify is
My_Ident : String := "Test_rcX_Firmware_Identify";
package cifX renames A4A.Protocols.HilscherX.cifX_User;
Driver_Handle : aliased cifX.Driver_Handle_Type;
Channel_Handle : aliased cifX.Channel_Handle_Type;
Result : DInt;
cifX_Driver_Init_Done : Boolean := False;
cifX_Driver_Open_Done : Boolean := False;
cifX_Channel_Open_Done : Boolean := False;
Do_Command : Boolean := False;
Command_Done : Boolean := False;
Command_Error : Boolean := False;
My_Channel_Messaging : aliased
A4A.Protocols.HilscherX.Channel_Messaging.Instance;
rcX_Firmware_Identify_FB : rcX_Firmware_Identify.FB.Instance;
Fw_Identification : rcX_Firmware_Identify.RCX_FW_IDENTIFICATION_T;
Error_String : String (1.. 20);
procedure cifX_Show_Error (Error : DInt) is
begin
A4A.Log.Logger.Put
(Who => My_Ident,
What => cifX.Driver_Get_Error_Description(Error));
end cifX_Show_Error;
procedure cifX_Show_Firmware_Identification is
What : String := CRLF
& "***********************************************" & CRLF
& " Firmware Identification" & CRLF & CRLF
& "Firmware Version :" & CRLF
& "Major : "
& Fw_Identification.Fw_Version.Major'Img & CRLF
& "Minor : "
& Fw_Identification.Fw_Version.Minor'Img & CRLF
& "Build : "
& Fw_Identification.Fw_Version.Build'Img & CRLF
& "Revision : "
& Fw_Identification.Fw_Version.Revision'Img & CRLF
& CRLF
& "Firmware Name : "
& Interfaces.C.To_Ada
(Fw_Identification.Fw_Name.Name) & CRLF
& CRLF
& "Firmware Date :" & CRLF
& "Year : "
& Fw_Identification.Fw_Date.Year'Img & CRLF
& "Month : "
& Fw_Identification.Fw_Date.Month'Img & CRLF
& "Day : "
& Fw_Identification.Fw_Date.Day'Img & CRLF
& "***********************************************" & CRLF;
begin
A4A.Log.Logger.Put (Who => My_Ident,
What => What);
end cifX_Show_Firmware_Identification;
procedure Close is
begin
My_Channel_Messaging.Quit;
--Wait for completion
loop
exit when My_Channel_Messaging.Is_Terminated;
delay 1.0;
end loop;
if cifX_Channel_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Closing Channel");
Result := cifX.Channel_Close (Channel_Handle);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
end if;
cifX_Channel_Open_Done := False;
end if;
if cifX_Driver_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Closing Driver");
Result := cifX.Driver_Close (Driver_Handle);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
end if;
cifX_Driver_Open_Done := False;
end if;
if cifX_Driver_Init_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Deinitializing cifX Driver");
cifX.Driver_Deinit;
cifX_Driver_Init_Done := False;
end if;
A4A.Log.Logger.Put (Who => My_Ident,
What => "finished !");
A4A.Log.Quit;
end Close;
begin
A4A.Log.Logger.Put (Who => My_Ident,
What => "Test_Messaging...");
A4A.Log.Logger.Put (Who => My_Ident,
What => "Initializing cifX Driver");
Result := cifX.Driver_Init;
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Driver_Init_Done := True;
end if;
if cifX_Driver_Init_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Opening Driver");
Result := cifX.Driver_Open (Driver_Handle'Access);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Driver_Open_Done := True;
end if;
end if;
if cifX_Driver_Open_Done then
A4A.Log.Logger.Put (Who => My_Ident,
What => "Opening Channel");
Result := cifX.Channel_Open
(Driver_Handle => Driver_Handle,
Board_Name => "cifX0",
Channel_Number => 0,
Channel_Handle_Access => Channel_Handle'Access);
if Result /= CIFX_NO_ERROR then
cifX_Show_Error(Result);
else
cifX_Channel_Open_Done := True;
end if;
end if;
if cifX_Channel_Open_Done then
My_Channel_Messaging.Initialise (Channel_Handle => Channel_Handle);
rcX_Firmware_Identify_FB.Initialise
(Channel_Access => My_Channel_Messaging'Unrestricted_Access);
loop
Do_Command := not Command_Done;
rcX_Firmware_Identify_FB.Cyclic
(Do_Command => Do_Command,
Done => Command_Done,
Error => Command_Error);
exit when not Do_Command;
delay 0.1;
end loop;
if not Command_Error then
Fw_Identification := rcX_Firmware_Identify_FB.Get_Data;
cifX_Show_Firmware_Identification;
else
DWord_Text_IO.Put
(To => Error_String,
Item => rcX_Firmware_Identify_FB.Get_Last_Error,
Base => 16);
A4A.Log.Logger.Put (Who => My_Ident,
What => "Got an error : " & Error_String);
end if;
end if;
Close;
exception
when Error: others =>
A4A.Log.Logger.Put (Who => My_Ident,
What => Exception_Information(Error));
Close;
end Test_rcX_Firmware_Identify;
La trace suivante montre notre code à l’œuvre, et ça fonctionne !
C:\GNAT\Projects\A4A\hilscherx\exe\test_rcx_firmware_identify
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Test_Messaging...
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Initializing cifX Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Channel
2014-06-13 07:31:36.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : Got a message :
Dest : 16#20#
Src : 16#0#
Dest_Id : 16#1#
Src_Id : 16#28FD48#
Cmd : 16#1EB7#
2014-06-13 07:31:36.30 => Test_rcX_Firmware_Identify :
***********************************************
Firmware Identification
Firmware Version :
Major : 2
Minor : 6
Build : 7
Revision : 1
Firmware Name : EtherNet/IP Scanner
Firmware Date :
Year : 2013
Month : 12
Day : 3
***********************************************
2014-06-13 07:31:37.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : No packet pending.
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Channel
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Deinitializing cifX Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : finished !
Logging_Task terminated...
[2014-06-13 09:31:38] process terminated successfully, elapsed time: 03.73s
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Test_Messaging...
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Initializing cifX Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Driver
2014-06-13 07:31:35.09 => Test_rcX_Firmware_Identify : Opening Channel
2014-06-13 07:31:36.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : Got a message :
Dest : 16#20#
Src : 16#0#
Dest_Id : 16#1#
Src_Id : 16#28FD48#
Cmd : 16#1EB7#
2014-06-13 07:31:36.30 => Test_rcX_Firmware_Identify :
***********************************************
Firmware Identification
Firmware Version :
Major : 2
Minor : 6
Build : 7
Revision : 1
Firmware Name : EtherNet/IP Scanner
Firmware Date :
Year : 2013
Month : 12
Day : 3
***********************************************
2014-06-13 07:31:37.12 => A4A.Protocols.HilscherX.Channel_Messaging.Receive_Msg_Task_Type : No packet pending.
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Channel
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Closing Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : Deinitializing cifX Driver
2014-06-13 07:31:37.31 => Test_rcX_Firmware_Identify : finished !
Logging_Task terminated...
[2014-06-13 09:31:38] process terminated successfully, elapsed time: 03.73s
Quelques blocs fonctions de ce type sont aujourd’hui disponibles dans « Ada for Automation ».
L’API Hilscher est riche, les protocoles supportés nombreux, et il faudra un peu de temps et beaucoup de contributions 😉 pour disposer de toute la fonctionnalité au niveau utilisateur.
N’hésitez pas à nous solliciter si vous souhaitez mettre en œuvre une solution « Ada for Automation » et qu’il vous manque des blocs. Ça doit pouvoir s’arranger…
Merci d’avance pour vos retours constructifs.
Cordialement,
Stéphane