--/******************************************
--
-- Cedric Pradalier 2001
-- mail : http://cedric.pradalier.free.fr/mail.html
--
--****************************************/
--compilation de graphc.c en premier :
-- gcc -c graphc.c
--compilation adamake xxxx -largs graphc.o -largs -lX11
with interfaces.C;
use interfaces.C;
package graph is
--Constante pour les appels a FillPolygon : parametre Shape
--+Convex : Polygone convexe : le plus simple.
--+NonConvex : Polygone non convexe mais sans intersections des aretes
--+Complex : Polygones restants.
Complex : constant integer ;
NonConvex : constant integer ;
Convex : constant integer ;
--Constante pour les appels a FillPolygon : parametre Mode
--+CoordModeOrigin : les points sont definis a partir d'une origine absolue
--+CoordModePrevious : Les points sont definis pa rapport au point precedent
CoordModeOrigin : constant integer ;
CoordModePrevious : constant integer ;
--Couleur courante d'ecriture
Current_FGColor : long;
pragma import(c,Current_FGColor,"Current_FGColor");
--Couleur courante de fond
Current_BGColor : long;
pragma import(c,Current_BGColor,"Current_BGColor");
--Coordonnées de la fenetre courante
winX : integer;
pragma import(c,winX,"winX");
winY : integer;
pragma import(c,winY,"winY");
--Largeur et Hauteur de la Fenetre courante
winHeight : integer;
pragma import(c,winHeight,"winHeight");
winWidth : integer;
pragma import(c,winWidth,"winWidth");
type Point2D is record
x,y:integer;
end record;
type arrayofpoint2D is array(positive range <>) of Point2D;
Type Point2DArray(N:Natural) is record
Pts : arrayofpoint2D(1..N);
end record;
procedure OpenGraphBW(x,y,width,height : integer);
pragma import(c,OpenGraphBW,"OpenGraphBW");
-- Ouvre une fenetre graphique avec noir comme couleur de dessin et
-- blanc comme couleur de fond.
-- Meme fonctionnalite que OpenGraph(...)
procedure SaveImage(x,y,width,height:Natural;nom :string);
-- + Sauvegarde la partie graphique de l'image comprise
-- dans le rectangle dont le coin en haut a gauche a pour
-- coordonnee (x,y) de largeur width et de hauteur height
-- dans le fichier nomme nom (attention la sauvegarde est au format
-- tga) : l'extension ".tga" est donc toujours rajoutee
-- + Danger : toute l'image doit existe dans le graphique :
-- Les coordonnees doivent etre valide
procedure SetColor(s:string);
-- Defini la couleur de dessin
-- nom est une chaine
-- si nom commence par # (Ex, #FF0EA7) , la fonction s'attend
-- a l'expression des composantes rouge,vert,bleu de la couleur
-- en hexadecimal : #RRGGBB
-- sinon, nom est recherche dans la table des noms courants accessible
-- par la commande UNIX : showrgb | m
-- Ex "aquamarine4"
-- Si l'allocation de la couleur a echouee, la couleur choisie est le blanc.
--
function GetColorIndex(s:string) return integer;
-- Renvoie l'indice d'une couleur dans la palette courante
-- comme GetColor;
function Black return integer;
-- L'indice du noir
function White return integer;
-- L'indice du blanc
procedure SetBkColor(s:string);
--/* Defini la couleur de fond
-- Meme comportement que SetColor
--*/
procedure StoreColor(red,green,blue,position : integer);
pragma import(c,StoreColor,"StoreColor");
--/* stocke la couleur de coordonnes R,G,B red,green,blue dans la table
-- de couleur courante a la position position
-- Attention ces valeurs sont comprises entre 0 et 65535 donc pour avoir
-- un gri moyen il faut (128 * 256 , 128 * 256 , 128 * 256)
--/*
Procedure SetColorByIndex(index : integer);
pragma import(c,SetColorByIndex,"SetColorByIndex");
--/*
-- Definit la couleur d'affichage a partir de la couleur de la position
-- i de la palette courante;
--*/
procedure OpenGraph(x,y,width,height:integer;FgColor,BgColor:string);
--/*
-- + Ouvre une fenetre graphique, cense etre situee en (x,y)
-- de largeur width et de hauteur helght.
-- + fgcolor et bgcolor sont les couleurs de dessins et de fond
-- et repondent aux memes contraintes que nom dans SetColor
-- La Fenetre doit etre fermee avec CloseGraph.
--*/
Procedure Redraw ;
pragma import(c,Redraw,"Redraw");
--
--Redessine la fenetre courante
--
Procedure CloseGraph ;
pragma import(c,CloseGraph,"CloseGraph");
--
-- Ferme la fenetre graphique
-- Tout appel posterieur a une des primitives suivantes
-- risques de provoquer une erreur systeme.
--/************************************************\
--+Toute les fonctions suivantes sont des fonctions de
--dessin les point sont designes par leurs coordonnees
--(x,y) ou (x1,y1)... Les coordonnes sont des nombres
--positifs comptes a partir du point en haut a gauche.
--+Le dessin est fait dans la couleur courante.
--\************************************************/
Procedure PutPixel(x,y : integer);
pragma import(c,PutPixel,"PutPixel");
--/*
-- Dessine un point
--*/
Procedure DrawLine(x1,y1,x2,y2:integer);
pragma import(c,DrawLine,"DrawLine");
--/*
-- Dessine une ligne
--*/
Procedure DrawRectangle(x,y,width,height:integer);
pragma import(c,DrawRectangle,"DrawRectangle");
--/*
-- Dessine un rectangle
-- (x,y) est le point en haut a gauche
-- width et height sont les hauteurs et largeurs du rectangle.
--*/
Procedure DrawArc(x,y,a,b,debut,fin:integer);
pragma import(c,DrawArc,"DrawArc");
--/*
-- Dessine l'ellipse centre en (x,y)
-- de demi-grand-axe a et de demi-petit-axe b
-- entre les angles debut et fin en degres.
--*/
Procedure DrawCircle(x,y,r:integer);
pragma import(c,DrawCircle,"DrawCircle");
--/*
-- Dessine un cercle de rayon r
-- centre en (x,y)
--*/
Procedure DrawString(x,y:integer;s:string);
--/*
--Affiche la chaine s en (x,y) en la supperposant au dessin original
--*/
Procedure DrawImageString(x,y:integer;s:string);
--/*
--Affiche la chaine s en (x,y) en effacant le dessin original
--*/
Procedure FillRectangle(x,y,width,height:integer);
pragma import(c,FillRectangle,"FillRectangle");
--/*
-- Rempli un rectangle (cf DrawRectangle)
--*/
Procedure ClearGraph;
pragma import(c,ClearGraph,"ClearGraph");
--/*
--Efface la fenetre courante
--/*
Procedure FillArc(x,y,a,b,debut,fin:integer);
pragma import(c,FillArc,"FillArc");
--/*
--Comme DrawArc, en remplissant la part d'ellipse
--*/
procedure FillPoly(points:Point2DArray ; shape : integer ; mode : integer);
--/*
--Rempli le Polygone defini par les points A1,A2,..An de type XPoint
--Avec A1 different de An. Exemple : voirFillTriangle
--+ npoints vaut n
--+ shape vaut Convex, Noconvex ou Complex selon l'algorithme de
-- remplissage a utilise
--+ mode vaut CoordModeOrigin ou CoordModeRelative selon que les
-- coordonnees des points sont definies a partirdu point precedent
-- ou par une origine absolue
--*/
--/*
--Dessine un triangle (x1,y1),...
--
procedure DrawTriangle(x1,y1,x2,y2,x3,y3:integer);
pragma import(c,DrawTriangle,"DrawTriangle");
--/*
-- Comme DrawTriangle en remplissant
--*/
procedure FillTriangle(x1,y1,x2,y2,x3,y3:integer);
pragma import(c,FillTriangle,"FillTriangle");
--Attend un click droit, rend la main apres son apparition
procedure WaitRClick ;
pragma import(c,WaitRClick,"WaitRClick");
--Attend un click gauche, rend la main apres son apparition
procedure WaitLClick ;
pragma import(c,WaitLClick,"WaitLClick");
--Attend un click milieu, rend la main apres son apparition
procedure WaitMClick ;
pragma import(c,WaitMClick,"WaitMClick");
--Attend un click de la souris:
--L,M,R se rapporte aux trois boutons de la souris (left,middle,right)
-- Ils valent 0 ou non : Si R (par exemple vaut 0)
-- Alors les clicks droits sont ignores.
-- Ex : WaitClick(1,0,1);
-- Attend un click droit ou gauche mais pas milieu.
procedure WaitClick(L,M,R:integer) ;
pragma import(c,WaitClick,"WaitClick");
private
Complex : constant integer := 0;
NonConvex : constant integer := 1;
Convex : constant integer := 2;
CoordModeOrigin : constant integer := 0;
CoordModePrevious : constant integer := 1;
end graph;