CD/Src/Spider - Graphic Library/Lib/Spider.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --  Nom du fichier    : Spider.adb                                          --
   4 --                                                                          --
   5 --  Auteur(s)         : Livio Righetti                                      --
   6 --                                                                          --
   7 --  Date de creation  : 26-MARS-97                                          --
   8 --                                                                          --
   9 --  But               : Mettre a disposition des fonctions graphiques       --
  10 --                      minimales.                                          --
  11 --                                                                          --
  12 --  Date de modif.    : 18-SEPT-97 (G.corbaz)                               --
  13 --  Raison            : Utilisation du paquetage Adagraph                   --
  14 --                                                                          --
  15 --  Date de modif.    : 7-AVRIL-99 (P.Girardet)                             --
  16 --  Raison            : Pour creer une librairie                            --
  17 --                                                                          --
  18 --  Date de modif.    : 28 avril 2000 (SALAMIN Michel)                      --
  19 --  Raison            : Suppression de AdaGraph et utilisation d'une DLL    --
  20 --                      faisant des appels directs aux API de Windows.      --
  21 --                                                                          --
  22 --  Modules appeles   :                                                     --
  23 --  Mat. particulier  : Graphmin.dll                                        --
  24 --                                                                          --
  25 --  Compilateur       :                                                     --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29
  30
  31 package body Spider is
  32
  33
  34
  35   procedure Traiter_Erreur(Valeur : in Natural) is
  36   begin
  37     case Valeur is
  38       when 1      => raise Fenetre_Non_Init;
  39       when 2      => raise Fenetre_Deja_Init;
  40       when 3      => raise Pixel_Invalid;
  41       when others => raise Erreur_Inconnue;
  42     end case;
  43   end Traiter_Erreur;
  44
  45
  46
  47   function ADA_Get_Max_X return Natural;
  48
  49   pragma import(DLL,ADA_Get_Max_X,"ADA_getMaxX");
  50
  51   function Get_Max_X return Natural is
  52   begin
  53     return ADA_Get_Max_X;
  54   end Get_Max_X;
  55
  56
  57
  58   function ADA_Get_Max_Y return Natural;
  59
  60   pragma import(DLL,ADA_Get_Max_Y,"ADA_getMaxY");
  61
  62   function Get_Max_Y return Natural is
  63   begin
  64     return ADA_Get_Max_Y;
  65   end Get_Max_Y;
  66
  67
  68
  69   procedure ADA_Move_To(X : in Natural;
  70                         Y : in Natural);
  71
  72   pragma import(DLL,ADA_Move_To,"ADA_moveTo");
  73
  74   procedure Move_To(X : in Natural;Y : in Natural) is
  75   begin
  76     ADA_Move_To(X,Y);
  77   end Move_To;
  78
  79
  80
  81   procedure ADA_Move(DX : in Integer;
  82                      DY : in Integer);
  83
  84   pragma import(DLL,ADA_Move,"ADA_move");
  85
  86   procedure Move(DX : in Integer;DY : in Integer) is
  87   begin
  88     ADA_Move(DX,DY);
  89   end Move;
  90
  91
  92
  93   procedure ADA_Line_To(X1  : in  Natural;
  94                         Y1  : in  Natural;
  95                         X2  : in  Natural;
  96                         Y2  : in  Natural;
  97                         Err : out Natural);
  98
  99   pragma import(DLL,ADA_Line_To,"ADA_lineTo");
 100
 101   procedure Line_To(X1 : in Natural;
 102                     Y1 : in Natural;
 103                     X2 : in Natural;
 104                     Y2 : in Natural) is
 105     Err : Integer;
 106   begin
 107     ADA_Line_To(X1,Y1,X2,Y2,Err);
 108     if Err /= 0 then
 109       Traiter_Erreur(Err);
 110     end if;
 111   end Line_To;
 112
 113
 114
 115   procedure ADA_Line(DX  : in  Integer;
 116                      DY  : in  Integer;
 117                      ERR : out Natural);
 118
 119   pragma import(DLL,ADA_Line,"ADA_line");
 120
 121   procedure Line(DX : in Integer;
 122                  DY : in Integer) is
 123     Err : Integer;
 124   begin
 125     ADA_Line(DX,DY,Err);
 126     if Err /= 0 then
 127       Traiter_Erreur(Err);
 128     end if;
 129   end Line;
 130
 131
 132
 133   procedure ADA_Clear_Window(Err : out Natural);
 134
 135   pragma import(DLL,ADA_Clear_Window,"ADA_clearWindow");
 136
 137   procedure Clear_Window is
 138     Err : Integer;
 139   begin
 140     ADA_Clear_Window(Err);
 141     if Err /= 0 then
 142       Traiter_Erreur(Err);
 143     end if;
 144   end Clear_Window;
 145
 146
 147
 148   procedure ADA_Init_Window(Title : in  String;
 149                             Err   : out Natural);
 150
 151   pragma import(DLL,ADA_Init_Window,"ADA_initWindow");
 152
 153   procedure Init_Window(Title : in String) is
 154     ADA_Title : String := Title & Character'Val(0);
 155     Err : Integer;
 156   begin
 157     ADA_Init_Window(ADA_Title,Err);
 158     if Err /= 0 then
 159       Traiter_Erreur(Err);
 160     end if;
 161   end Init_Window;
 162
 163
 164
 165   procedure ADA_Close_Window(Err : out Natural);
 166
 167   pragma import(DLL,ADA_Close_Window,"ADA_closeWindow");
 168
 169   procedure Close_Window is
 170     Err : Integer;
 171   begin
 172     ADA_Close_Window(Err);
 173     if Err /= 0 then
 174       Traiter_Erreur(Err);
 175     end if;
 176   end Close_Window;
 177
 178
 179
 180 end Spider;