------------------------------------------------------------------------------ -- -- -- Nom du fichier : Draw.adb -- -- -- -- Auteur(s) : SALAMIN Michel / Assistant HEV -- -- Ecole d'ingenieurs du canton de Vaud (EIVD) -- -- -- -- Date de creation : 20 avril 2000 -- -- -- -- But : Mettre a disposition les fonctions graphiques -- -- permettant de: -- -- - gerer la couleur sous Spider -- -- - dessiner des cercles -- -- - dessiner des rectangles -- -- - changer la couleur d'un pixel -- -- -- -- Date de modif. : -- -- Raison : -- -- -- -- Modules appeles : -- -- Mat. particulier : Graphmin.dll -- -- -- -- Compilateur : -- -- -- ------------------------------------------------------------------------------ package body Spider.Draw is procedure ADA_Get_Color_Pen(R : out Integer; G : out Integer; B : out Integer); pragma import(DLL,ADA_Get_Color_Pen,"ADA_getColorPen"); function Get_Color_Pen return tColor is R,G,B : Integer; begin ADA_Get_Color_Pen(R,G,B); return tColor'(R,G,B); end Get_Color_Pen; procedure ADA_Get_Color_Background(R : out Integer; G : out Integer; B : out Integer); pragma import(DLL,ADA_Get_Color_Background,"ADA_getColorBackground"); function Get_Color_Background return tColor is R,G,B : Integer; begin ADA_Get_Color_Background(R,G,B); return tColor'(R,G,B); end Get_Color_Background; procedure ADA_Get_Color_Text(R : out Integer; G : out Integer; B : out Integer); pragma import(DLL,ADA_Get_Color_Text,"ADA_getColorText"); function Get_Color_Text return tColor is R,G,B : Integer; begin ADA_Get_Color_Text(R,G,B); return tColor'(R,G,B); end Get_Color_Text; procedure ADA_Get_Width_Char(Width_Car : out Natural; Err : out Natural); pragma import(DLL,ADA_Get_Width_Char,"ADA_getWidthChar"); function Get_Width_Char return Natural is Width_Car : Natural; Err : Natural; begin ADA_Get_Width_Char(Width_Car,Err); if Err /= 0 then Traiter_Erreur(Err); end if; return Width_Car; end Get_Width_Char; procedure ADA_Get_Height_Char(HeightCar : out Natural; Err : out Natural); pragma import(DLL,ADA_Get_Height_Char,"ADA_getHeightChar"); function Get_Height_Char return Natural is HeightCar : Natural; Err : Natural; begin ADA_Get_Height_Char(HeightCar,Err); if Err /= 0 then Traiter_Erreur(Err); end if; return HeightCar; end Get_Height_Char; procedure ADA_Set_Color_Pen(R : in Integer; G : in Integer; B : in Integer); pragma import(DLL,ADA_Set_Color_Pen,"ADA_setColorPen"); procedure Set_Color_Pen(Color : in tColor) is begin ADA_Set_Color_Pen(Color.R,Color.G,Color.B); end Set_Color_Pen; procedure ADA_Set_Color_Background(R : in Integer; G : in Integer; B : in Integer); pragma import(DLL,ADA_Set_Color_Background,"ADA_setColorBackground"); procedure Set_Color_Background(Color : in tColor) is begin ADA_Set_Color_Background(Color.R,Color.G,Color.B); end Set_Color_Background; procedure ADA_Set_Color_Text(R : in Integer; G : in Integer; B : in Integer); pragma import(DLL,ADA_Set_Color_Text,"ADA_setColorText"); procedure Set_Color_Text(Color : in tColor) is begin ADA_Set_Color_Text(Color.G,Color.G,Color.B); end Set_Color_Text; procedure ADA_Display_Text(Text : in String; Err : out Natural); pragma import(DLL,ADA_Display_Text,"ADA_displayText"); procedure Display_Text(Text : in String) is ADA_Text : String := Text & Character'Val(0); Err : Natural; begin ADA_Display_Text(ADA_Text,Err); if Err /= 0 then Traiter_Erreur(Err); end if; end Display_Text; procedure ADA_Circle(Radius : in Natural; Filled : in Natural; Err : out Natural); pragma import(DLL,ADA_Circle,"ADA_circle"); procedure Circle(Radius : in Natural; Filled : in tFill) is ADA_filled : Natural; Err : Natural; begin if Filled=Fill then ADA_filled := 0; else ADA_filled := 1; end if; ADA_Circle(Radius,ADA_Filled,Err); if Err /= 0 then Traiter_Erreur(Err); end if; end Circle; procedure ADA_Box(Width : in Integer; Height : in Integer; Filled : in Natural; Err : out Natural); pragma import(DLL,ADA_Box,"ADA_box"); procedure Box(Width : in Integer; Height : in Integer; Filled : in tFill) is ADA_filled : Natural; Err : Natural; begin if Filled=Fill then ADA_filled := 0; else ADA_filled := 1; end if; ADA_Box(Width,Height,ADA_Filled,Err); if Err /= 0 then Traiter_Erreur(Err); end if; end Box; procedure ADA_Put_Pixel(Err : out Natural); pragma import(DLL,ADA_Put_Pixel,"ADA_putPixel"); procedure Put_Pixel is Err : Natural; begin ADA_Put_Pixel(Err); if Err /= 0 then Traiter_Erreur(Err); end if; end Put_Pixel; procedure ADA_Get_Pixel(Couleur_R : out Natural; Couleur_G : out Natural; Couleur_B : out Natural; Err : out Natural); pragma import(DLL,ADA_Get_Pixel,"ADA_getPixel"); function Get_Pixel return tColor is Couleur_R : Natural; Couleur_G : Natural; Couleur_B : Natural; Err : Natural; begin ADA_Get_Pixel(Couleur_R,Couleur_G,Couleur_B,Err); if Err /= 0 then Traiter_Erreur(Err); end if; return tColor'(Couleur_R,Couleur_G,Couleur_B); end Get_Pixel; end Spider.Draw;