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

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --  Nom du fichier    : Draw.adb                                            --
   4 --                                                                          --
   5 --  Auteur(s)         : SALAMIN Michel / Assistant HEV                      --
   6 --                      Ecole d'ingenieurs du canton de Vaud (EIVD)         --
   7 --                                                                          --
   8 --  Date de creation  : 20 avril 2000                                       --
   9 --                                                                          --
  10 --  But               : Mettre a disposition les fonctions graphiques       --
  11 --                      permettant de:                                      --
  12 --                      - gerer la couleur sous Spider                      --
  13 --                      - dessiner des cercles                              --
  14 --                      - dessiner des rectangles                           --
  15 --                      - changer la couleur d'un pixel                     --
  16 --                                                                          --
  17 --  Date de modif.    :                                                     --
  18 --  Raison            :                                                     --
  19 --                                                                          --
  20 --  Modules appeles   :                                                     --
  21 --  Mat. particulier  : Graphmin.dll                                        --
  22 --                                                                          --
  23 --  Compilateur       :                                                     --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27
  28
  29 package body Spider.Draw is
  30
  31
  32
  33   procedure ADA_Get_Color_Pen(R : out Integer;
  34                               G : out Integer;
  35                               B : out Integer);
  36
  37   pragma import(DLL,ADA_Get_Color_Pen,"ADA_getColorPen");
  38
  39   function Get_Color_Pen return tColor is
  40     R,G,B : Integer;
  41   begin
  42     ADA_Get_Color_Pen(R,G,B);
  43     return tColor'(R,G,B);
  44   end Get_Color_Pen;
  45
  46
  47
  48   procedure ADA_Get_Color_Background(R : out Integer;
  49                                      G : out Integer;
  50                                      B : out Integer);
  51
  52   pragma import(DLL,ADA_Get_Color_Background,"ADA_getColorBackground");
  53
  54   function Get_Color_Background return tColor is
  55     R,G,B : Integer;
  56   begin
  57     ADA_Get_Color_Background(R,G,B);
  58     return tColor'(R,G,B);
  59   end Get_Color_Background;
  60
  61
  62
  63   procedure ADA_Get_Color_Text(R : out Integer;
  64                                G : out Integer;
  65                                B : out Integer);
  66
  67   pragma import(DLL,ADA_Get_Color_Text,"ADA_getColorText");
  68
  69   function Get_Color_Text return tColor is
  70     R,G,B : Integer;
  71   begin
  72     ADA_Get_Color_Text(R,G,B);
  73     return tColor'(R,G,B);
  74   end Get_Color_Text;
  75
  76
  77
  78   procedure ADA_Get_Width_Char(Width_Car : out Natural;
  79                                Err       : out Natural);
  80
  81   pragma import(DLL,ADA_Get_Width_Char,"ADA_getWidthChar");
  82
  83   function Get_Width_Char return Natural is
  84      Width_Car : Natural;
  85      Err       : Natural;
  86   begin
  87     ADA_Get_Width_Char(Width_Car,Err);
  88
  89     if Err /= 0 then
  90       Traiter_Erreur(Err);
  91     end if;
  92
  93     return Width_Car;
  94   end Get_Width_Char;
  95
  96
  97
  98   procedure ADA_Get_Height_Char(HeightCar : out Natural;
  99                                 Err       : out Natural);
 100
 101   pragma import(DLL,ADA_Get_Height_Char,"ADA_getHeightChar");
 102
 103   function Get_Height_Char return Natural is
 104     HeightCar : Natural;
 105     Err       : Natural;
 106   begin
 107     ADA_Get_Height_Char(HeightCar,Err);
 108
 109     if Err /= 0 then
 110       Traiter_Erreur(Err);
 111     end if;
 112
 113     return HeightCar;
 114   end Get_Height_Char;
 115
 116
 117
 118   procedure ADA_Set_Color_Pen(R : in Integer;
 119                               G : in Integer;
 120                               B : in Integer);
 121
 122   pragma import(DLL,ADA_Set_Color_Pen,"ADA_setColorPen");
 123
 124   procedure Set_Color_Pen(Color : in tColor) is
 125   begin
 126     ADA_Set_Color_Pen(Color.R,Color.G,Color.B);
 127   end Set_Color_Pen;
 128
 129
 130
 131   procedure ADA_Set_Color_Background(R : in Integer;
 132                                      G : in Integer;
 133                                      B : in Integer);
 134
 135   pragma import(DLL,ADA_Set_Color_Background,"ADA_setColorBackground");
 136
 137   procedure Set_Color_Background(Color : in tColor) is
 138   begin
 139     ADA_Set_Color_Background(Color.R,Color.G,Color.B);
 140   end Set_Color_Background;
 141
 142
 143
 144   procedure ADA_Set_Color_Text(R : in Integer;
 145                                G : in Integer;
 146                                B : in Integer);
 147
 148   pragma import(DLL,ADA_Set_Color_Text,"ADA_setColorText");
 149
 150   procedure Set_Color_Text(Color : in tColor) is
 151   begin
 152     ADA_Set_Color_Text(Color.G,Color.G,Color.B);
 153   end Set_Color_Text;
 154
 155
 156
 157   procedure ADA_Display_Text(Text : in  String;
 158                              Err  : out Natural);
 159
 160   pragma import(DLL,ADA_Display_Text,"ADA_displayText");
 161
 162   procedure Display_Text(Text : in String) is
 163     ADA_Text : String := Text & Character'Val(0);
 164     Err : Natural;
 165   begin
 166     ADA_Display_Text(ADA_Text,Err);
 167     if Err /= 0 then
 168       Traiter_Erreur(Err);
 169     end if;
 170   end Display_Text;
 171
 172
 173
 174   procedure ADA_Circle(Radius : in  Natural;
 175                        Filled : in  Natural;
 176                        Err    : out Natural);
 177
 178   pragma import(DLL,ADA_Circle,"ADA_circle");
 179
 180   procedure Circle(Radius : in Natural;
 181                    Filled : in tFill) is
 182       ADA_filled : Natural;
 183       Err        : Natural;
 184   begin
 185     if Filled=Fill then
 186       ADA_filled := 0;
 187     else
 188       ADA_filled := 1;
 189     end if;
 190
 191     ADA_Circle(Radius,ADA_Filled,Err);
 192
 193     if Err /= 0 then
 194       Traiter_Erreur(Err);
 195     end if;
 196   end Circle;
 197
 198
 199
 200   procedure ADA_Box(Width  : in  Integer;
 201                     Height : in  Integer;
 202                     Filled : in  Natural;
 203                     Err    : out Natural);
 204
 205   pragma import(DLL,ADA_Box,"ADA_box");
 206
 207   procedure Box(Width  : in Integer;
 208                 Height : in Integer;
 209                 Filled : in tFill) is
 210      ADA_filled : Natural;
 211      Err        : Natural;
 212   begin
 213     if Filled=Fill then
 214       ADA_filled := 0;
 215     else
 216       ADA_filled := 1;
 217     end if;
 218
 219     ADA_Box(Width,Height,ADA_Filled,Err);
 220
 221     if Err /= 0 then
 222       Traiter_Erreur(Err);
 223     end if;
 224   end Box;
 225
 226
 227
 228   procedure ADA_Put_Pixel(Err : out Natural);
 229
 230   pragma import(DLL,ADA_Put_Pixel,"ADA_putPixel");
 231
 232   procedure Put_Pixel is
 233       Err : Natural;
 234   begin
 235     ADA_Put_Pixel(Err);
 236     if Err /= 0 then
 237       Traiter_Erreur(Err);
 238     end if;
 239   end Put_Pixel;
 240
 241
 242
 243   procedure ADA_Get_Pixel(Couleur_R : out Natural;
 244                           Couleur_G : out Natural;
 245                           Couleur_B : out Natural;
 246                           Err       : out Natural);
 247
 248   pragma import(DLL,ADA_Get_Pixel,"ADA_getPixel");
 249
 250   function Get_Pixel return tColor is
 251     Couleur_R : Natural;
 252     Couleur_G : Natural;
 253     Couleur_B : Natural;
 254     Err       : Natural;
 255   begin
 256     ADA_Get_Pixel(Couleur_R,Couleur_G,Couleur_B,Err);
 257
 258     if Err /= 0 then
 259       Traiter_Erreur(Err);
 260     end if;
 261
 262     return tColor'(Couleur_R,Couleur_G,Couleur_B);
 263
 264   end Get_Pixel;
 265
 266
 267
 268 end Spider.Draw;
 269
 270
 271