{
 version adaptee a TP6 (plus rapide), mais toute procedure TP6 utilisee
 est accompagnee d'instructions standard en commentaire. Toute procedure
 non standard est signalee  par le commentaire (*tp6*)
}

{points non encore au point :
  les types de lignes (en particulier sur table HP il faut faire une correspondance des types)
  les epaisseurs de traits (en particulier sur table)

}


{pour forcer les memes options que le reste du programme}
{$I options.inc}
{$R-} {je veux gagner de la place en ne mettant R+ que dans les autres}
{$O-} {celui-ci ne sera pas recouvert}

(* commentaires de portabilite **************************************
Pour appeler les fonctions du BIOS, on utilise le type predefini REGISTERS
qui correspond a :
        type registers=record
               case integer of
               1:(ax,bx,cx,dx,bp,si,di,ds,es:integer;flag:integer);
               2:(al,ah,bl,bh,cl,ch,dl,dh:byte;
                  ibp,isi,idi,ids,ies,iflag:integer)
             end;
***************************************)

UNIT g2d;

INTERFACE

uses dos,crt,graph;


type gpixel=integer;        {type coord ecran}
     gcoord=real;           {type coord utilsateur}


TYPE  gtypecr=byte; {type d'ecran,
                   {0=texte,1=couleur 320x200,2=mono 640x200,3=mono logabax,etc}
                   {utilise par gset_typecr,gpointstce,   }

     gp_infos_fen=^gr_infos_fen;
     gr_infos_fen=record
       xgauchep,xdroitep,yhautp,ybasp:gpixel;  {limites papier}
       xminp,xmaxp,yminp,ymaxp:gpixel;
       xgauchet,xdroitet,yhautt,ybast:gpixel;  {limites table}
       xmint,xmaxt,ymint,ymaxt:gpixel;
       xgaucheu,xdroiteu,yhautu,ybasu:gcoord;  {limites objet}
       xminu,xmaxu,yminu,ymaxu:gcoord;
       xgauchef,xdroitef,yhautf,ybasf:real;    {limites fen entre 0 et 1}
       ax,bx,ay,by:real;                       {coefs objet->papier}
       tax,tbx,tay,tby:real;                   {coefs objet->table}
       num:integer; {les numeros sont croissants, fenetre 0 = ecran complet}
       xtaillecar,ytaillecar:gcoord;
       dernxcar,dernycar:gcoord;
       typetrait,eptrait:integer;
       cos_car,sin_car:real; {taille et direction caracteres}
       c_fond,c_draw,c_fill:integer; {couleurs}

       {pour G3D}
       g3xoeil,g3yoeil,g3zoeil,g3xvise,g3yvise,g3zvise:gcoord;
       g3dx,g3dy,g3dz,g3n:gcoord; {direction de visee + norme}
       g3vertx,g3verty,g3vertz,g3horx,g3hory,g3horz:gcoord;
       g3type:integer;
       g3xmin,g3ymin,g3zmin,g3xmax,g3ymax,g3zmax:gcoord;

       suiv:gp_infos_fen
     end;

{declaration des types pour les zones de clipping}
     gtzone=(zd,zg,zh,zb); {a droite, gauche, trop haut ou trop bas}
     gszone=set of gtzone;

function gtyp_ecr_par_def:gtypecr; { 3 sur logabax, 4 sur IBM, 2 sinon }
procedure gpalette(num_coul:integer;rouge,vert,bleu:real);
procedure gpalette_initiale;
procedure gpalette_progressive;
procedure gtypetrait(typ:integer);
procedure geptrait(typ:integer);
procedure gefface;   {ne marche que sur ecran}
procedure gcouleur_tot(trait,rempli,fond:integer);
procedure gcouleur(trait:integer);
procedure gcouleur_remplissage(rempli:integer);
procedure gcouleur_fond(fond:integer);
procedure gchoix_fenetre(num_fen:integer);
function gexiste_fenetre(num_fen:integer):boolean;
procedure gferme_fenetre(num_fen:integer);
procedure gcree_fenetre(xgauche,xdroit,ybas,yhaut:real;num_fen:integer);
procedure gcadre;
procedure gechelle(xgauche,xdroite,ybas,yhaut:gcoord);
procedure gechelleort(xgauche,xdroite,ybas,yhaut:gcoord);
procedure glimites(var xgauche,xdroite,ybas,yhaut:gcoord);
procedure ginit(x:gtypecr);
{passe en graphique et cree la fenetre totale}
procedure gdebut_table(n:gtypecr;nomfic:string;xgauche,xdroite,ybas,yhaut:real);
procedure gfin_table;
procedure gfin;
procedure gpoint(x,y:gcoord);
function gtestpoint(x,y:gcoord):gpixel;
procedure gligne(x1,y1,x2,y2:gcoord);
procedure gcarpoint(x,y:gcoord;typ:integer);
procedure grectangle(xg,yb,xd,yh:gcoord);
procedure gfleche(x0,y0,x1,y1:gcoord);
procedure garcellipse(xcentre,ycentre,rayonx,rayony,angledeb,anglefin:gcoord);
procedure garc(xcentre,ycentre,rayonx,angledeb,anglefin:real);
procedure gcercle(xcentre,ycentre,rayon:real);
procedure gellipse(xcentre,ycentre,rayonx,rayony:real);
procedure gtaillecarpc(x,y:real); {x,y entre 0 et 1 proportionnel a la fenetre}
procedure gtaillecar(x,y:gcoord);

{pour developpements de bas niveau}
procedure gpalette_1(num_coul,rouge,vert,bleu:integer);
procedure gpointce(x,y:gpixel) {sans test de clipping !};
procedure gpointct(x,y:gpixel);
function gtestpointce(x,y:gpixel):gpixel;
procedure glignece(x1,y1,x2,y2:gpixel);
procedure glignect(x1,y1,x2,y2:gpixel);
procedure gproj_u_p(xu,yu:gcoord;var xp,yp:gpixel);
procedure gproj_p_u(xp,yp:gpixel;var xu,yu:gcoord);
procedure gproj_u_t(xu,yu:gcoord;var xp,yp:gpixel);
procedure gproj_t_u(xp,yp:gpixel;var xu,yu:gcoord);
procedure gclip(var x1,y1,x2,y2:gcoord;var visible:boolean);

var ginfos_fen:gp_infos_fen; {disponibles entre autre pour GRECRIT}
    gcoul_max:integer;
    gsauve_coul_max:integer; {pendant table tracante, sauvegarde du nb de coul de l'ecran pour le remettre apres}
    gecran:gtypecr;
    gtable:gtypecr;
    gniveaux_gris_max,ggcouleur:byte; {couleur toujours utilisee pour les dessins}

IMPLEMENTATION

{les informations constantes de l'ecran}
VAR xgauchecr,xdroitecr,ybasecr,yhautecr:gpixel;
    xgauchetab,xdroitetab,ybastab,yhauttab:gpixel;
    carre_xsury:real; {nb pts en X sur nb pts en Y pour former un carre}
                      {pc 640x200 => (640/sqrt(2)) / 200 }
    carre_xsurytab:real;
    def_c_fond,def_c_draw,def_c_fill:integer; {couleurs}

{les variables globales}
    ggtypetrait:byte;

{pour utiliser l'imprimante en graphique }
type gitlig=array[0..924] of char; {chaque ligne est stockee par pointeur}
var  gitab:array[0..97] of ^gitlig;
     gilig:gitlig;
     numiligactu:integer;
     gific:file of gitlig;
     gtfic:text;
     dernxtable,dernytable:gpixel;

{messages d'erreur -------------------------------------------------------}
procedure gerr(num:integer;fatale:boolean;proc:string);
begin
  if fatale then writeln('ERREUR FATALE G2D n. ',num,' dans ',proc)
            else writeln('Attention probleme G2D n. ',num,' dans ',proc);
  case num of
    1:writeln('echelle completement ratatinee (droit=gauche ou haut=bas)');
    2:writeln('GINIT Deja Actif (il faut d''abord GFIN)');
    3:writeln('fermeture fenetre courante, activation fenetre 0');
    4:writeln('choix d''une fenetre inexistante');
    5:writeln('impossible de fermer la fenetre 0 autrement que par GFIN');
    6:writeln('Fenetre 0 = plein ecran, impossible a modifier');
    7:writeln('les arguments DOIVENT etre entre 0 et 1 (portion d''ecran)');
    8:writeln('type d''ecran/imprimante/plotter impossible (ou du moins non prevu)');
    9:writeln('Il faut imperativement remedier a ce probleme pour utiliser G2D');
    else{case} begin writeln('erreur non repertoriee')
               end
  end;
  if fatale then begin
    writeln('il vaut mieux tout arreter la');
    halt(1)
  end else begin
    writeln('veuillez appuyer RETURN pour continuer');
    readln
  end
end;

{couche 0-------------------------------------------------------------------}
{totalement dependant du materiel}

procedure ginit_typecr(x:gtypecr);
{passer dans le mode choisi, effacer l'ecran, fixer les constantes de l'ecran}
{0 signifie quittter le mode graphique}
var reg:registers;
    pilote,mode:integer;
  procedure initsousturbo(pilote,mode:integer);
  {cette procedure sert a mettre en graphique SOUS TP6 UNIQUEMENT}
  var varpilote,varmode,err:integer;
  begin
    varpilote:=pilote;varmode:=mode;
    {TP6}INITGRAPH(varpilote,varmode,'');
    {TP6}err:=GRAPHRESULT;
    if err=-3 then begin
      varpilote:=pilote;varmode:=mode; {cet imbecile a mis -3 dans varpilote}
      {TP6}INITGRAPH(varpilote,varmode,GETENV('BGI'));
      {TP6}err:=GRAPHRESULT;
      if err=-3 then begin
        writeln('erreur : fichier .BGI non trouve dans le repertoire courant ni');
        writeln('dans un repertoire definit par un SET BGI (ex : mettre dans');
        writeln('AUTOEXEC.BAT la commande SET BGI=C:\TP6\BGI');
        gerr(9,true,'ginit_typecr');
      end
    end;
    if err<>0 then begin
      writeln('erreur graphique : ',GRAPHERRORMSG(err));
      gerr(9,true,'ginit_typecr')
    end
  end;
begin
  {TP6}DIRECTVIDEO:=false;
  case x of                                       
    0:begin  {texte 80/25}
        {TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(7);
        {TP6}TEXTMODE(LASTMODE);  {reg.ax:=03;intr(16,reg); }
        gcoul_max:=15{7};def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchecr:=1;xdroitecr:=80;yhautecr:=1;ybasecr:=25;
        carre_xsury:=(80/sqrt(2)) / 25
      end;
    1:begin  {320/200 4 couleurs}
        {TP6}InitSousTurbo(cga,cgac1);
        {reg.ax:=04;intr(16,reg); }
        gcoul_max:=3;def_c_fond:=0;def_c_draw:=1;def_c_fill:=3;
        xgauchecr:=0;xdroitecr:=319;yhautecr:=0;ybasecr:=199;
        carre_xsury:=(320/sqrt(2)) / 200
      end;
    2:begin  {640/200 mono}
        {TP6}InitSousTurbo(CGA,CGAhi);
        reg.ax:=06;intr(16,reg);
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=639;yhautecr:=0;ybasecr:=199;
        carre_xsury:=(640/sqrt(2)) / 200
      end;
    3:begin {640/400 Olivetti}
        {TP6}InitSousTurbo(ATT400,ATT400hi);
        {reg.ax:=$40;intr(16,reg);}
        {TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(7); {car il embrouille les couleurs}
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=639;yhautecr:=0;ybasecr:=399;
        carre_xsury:=(640/sqrt(2)) / 400
      end;
    4:begin {640/350 EGA 16 coul}
        {TP6}InitSousTurbo(EGA,EGAhi);
        {reg.ax:=$10;intr(16,reg);}
	{TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(15);
        gcoul_max:=15;def_c_fond:=0;def_c_draw:=14;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=639;yhautecr:=0;ybasecr:=349;
        carre_xsury:=(640/sqrt(2)) / 350
      end;
    5:begin {320/200 vga 256 coul}
        {TP6}InitSousTurbo(vga,vgalo); {attention ceci met en 640 200 : je modifie derriere}
        reg.ax:=$13;
        intr(16,reg);
	{TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(15); {car il embrouille les couleurs}
        gcoul_max:=255;def_c_fond:=0;def_c_draw:=14;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=319;yhautecr:=0;ybasecr:=199;
        carre_xsury:=(320/sqrt(2)) /200
      end ;
    6:begin {640/480 vga 16 coul}
        {TP6}InitSousTurbo(VGA,VGAhi);
        {reg.ax:=$12;intr(16,reg);}
	{TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(15); {car il embrouille les couleurs}
        xgauchecr:=0;xdroitecr:=639;yhautecr:=0;ybasecr:=479;
        gcoul_max:=15;def_c_fond:=0;def_c_draw:=14;def_c_fill:=1;
        carre_xsury:=(640/sqrt(2)) / 480
      end ;
    7:begin {640/400 PVGA 256 coul}
        {TP6}InitSousTurbo(IBM8514,IBM8514lo);
        reg.ax:=$5E;
        intr(16,reg);
        {TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(7);  {car il embrouille les couleurs}
        gcoul_max:=255;def_c_fond:=0;def_c_draw:=14;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=639;yhautecr:=0;ybasecr:=399;
        carre_xsury:=(640/sqrt(2))/400;
     end;
    8:begin  {800/600 PVGA 16 coul}
        {TP6}InitSousTurbo(IBM8514,IBM8514lo);
        reg.ax:=$58;
        intr(16,reg);
        {TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(7);
        gcoul_max:=15;def_c_fond:=0;def_c_draw:=14;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=799;yhautecr:=0;ybasecr:=599;
        carre_xsury:=(800/sqrt(2))/600;
      end;
    9:begin   {hercules mono 720x348}
        {TP6}InitSousTurbo(HERCMONO,HERCMONOhi);
        {je ne sais pas faire autrement que sous TP6}
        {TP6}TEXTBACKGROUND(0);
        {TP6}TEXTCOLOR(7);
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchecr:=0;xdroitecr:=719;yhautecr:=0;ybasecr:=347;
        carre_xsury:=(720/sqrt(2))/348;
      end;

    else gerr(8,true,'GINIT_TYPECR')
  end {case}
end;

procedure gdebut_typtab(x:gtypecr;nomfic:string);
{SUR PC, nomfic peut valoir 'PRN' ou 'COM1'}
var i:integer;
begin
  gsauve_coul_max:=gcoul_max;
  case x of
    1:begin  {DMP40 A4}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        writeln(gtfic,';: EH P1 H ECM U A');
        gcoul_max:=3;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=2235;yhauttab:=1775;ybastab:=0;
        carre_xsurytab:=1
      end;
    2:begin  {DMP40 A3}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        writeln(gtfic,';: EH P1 H ECM U A');
        gcoul_max:=3;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=3550;yhauttab:=2235;ybastab:=0;
        carre_xsurytab:=1
      end;
    3:begin  {LX80 paysage (X sens deroulement papier, Y gauche a droite}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        for i:=0 to 923 do gilig[i]:=#0;
        for i:=0 to 97 do begin new(gitab[i]);gitab[i]^:=gilig end;
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=783;yhauttab:=923;ybastab:=0;
        carre_xsurytab:=0.6 {a mesurer}
      end;
    4:begin  {epson LX 80 portrait}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        for i:=0 to 923 do gilig[i]:=#0;
        for i:=0 to 97 do begin new(gitab[i]);gitab[i]^:=gilig end;
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=923;yhauttab:=0;ybastab:=783;
        carre_xsurytab:=10/6 {a mesurer}
      end;
    5:begin  {epson par fichier}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        assign(gific,'g2d_tabl.$$$');
        rewrite(gific);
        for i:=0 to 923 do gilig[i]:=#0;
        for i:=0 to 97 do write(gific,gilig);
        numiligactu:=0;
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=783;yhauttab:=923;ybastab:=0;
        carre_xsurytab:=0.6 {a mesurer}
      end;
    6:begin  {epson par fichier}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        assign(gific,'g2d_tabl.$$$');
        rewrite(gific);
        for i:=0 to 923 do gilig[i]:=#0;
        for i:=0 to 97 do write(gific,gilig);
        numiligactu:=0;
        gcoul_max:=1;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=923;yhauttab:=0;ybastab:=783;
        carre_xsurytab:=10/6 {a mesurer}
      end;
    7:begin  {HPGL A4 paysage (pour 740A par exemple)}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        writeln(gtfic,'IN;DF;PA;PU');
        gcoul_max:=15;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=10900;yhauttab:=7650;ybastab:=0;
        carre_xsurytab:=1
      end;
    8:begin  {HPGL A4 portrait (pour 740A par exemple)}
        assign(gtfic,nomfic);
        rewrite(gtfic);
        writeln(gtfic,'IN;DF;PA;PU');
        gcoul_max:=15;def_c_fond:=0;def_c_draw:=1;def_c_fill:=1;
        xgauchetab:=0;xdroitetab:=7650;yhauttab:=0;ybastab:=10900;
        carre_xsurytab:=1
      end;
    else gerr(8,true,'GINIT_TYPTAB')
  end; {case}
end;

procedure gfin_typtab;
var i,j:integer;
begin
    case gtable of
      1,2,7,8:close(gtfic);
      3,4:begin
            write(gtfic,#27,'3',chr(24));
            for i:=0 to 97 do begin
              write(gtfic,#27,'L',#156,#3);
              for j:=0 to 923 do write(gtfic,gitab[i]^[j]);
              writeln(gtfic);
              dispose(gitab[i])
            end;
            close(gtfic)
          end;
      5,6:begin
            write(gtfic,#27,'3',chr(24));
            reset(gific);
            for i:=0 to 97 do begin
              read(gific,gilig);
              write(gtfic,#27,'L',#156,#3);
              for j:=0 to 923 do write(gtfic,gilig[j]);
              writeln(gtfic);
            end;
            close(gtfic);
            close(gific);
            erase(gific) {plus besoin du fichier temporaire}
          end;
    end; {case}
    gcoul_max:=gsauve_coul_max
end;

{allumage d'un point}
{var ecran_pair:array[0..99,0..79]of byte absolute $b800:0;
|    ecran_impair:array[0..99,0..79]of byte absolute $bA00:0;
|    ecranb_pair:array[0..99,0..79]of byte absolute $BC00:0;
|    ecranb_impair:array[0..99,0..79]of byte absolute $BE00:0;
}
{en 1er position, en 2e couleur. En commentaire car utilisation
| d'une INT plutot que d'ecrire directement en memoire
|const masque640200:array[0..7,0..1]of byte=((0,128),(0,64),(0,32),(0,16),(0,8),(0,4),(0,2),(0,1));
|      masque320200:array[0..3,0..3]of byte=((0,1,2,3),(0,4,8,12),(0,16,32,48),(0,64,128,192));
}

procedure gpointce(x,y:gpixel) {sans test de clipping !};
var reg:registers;
begin
  {TP6}PUTPIXEL(x,y,ggcouleur)
end;
{solution par interruption (teste pour les modes 1 a 8 uniquement)
|begin
|  reg.ah:=$0c;reg.al:=ggcouleur;reg.bx:=0;reg.cx:=x;reg.dx:=y;
|  intr(16,reg)
|end;
}

{solution par acces direct en memoire video (uniquement modes 1 a 3)
|var nx,ny:gpixel;
|begin
|  if gecran=2 then begin   (* test du plus courant EN PREMIER *)
|    nx:=x shr 3; (* div 8 *)
|    ny:=y shr 1;
|    if (y and 1)=0 then ecran_pair[ny,nx]:=(ecran_pair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur]
|                   else ecran_impair[ny,nx]:=(ecran_impair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur]
|  end else if gecran=1 then begin
|    nx:=x shr 2; (* div 4 *)
|    ny:=y shr 1;
|    if (y and 1)=0 then ecran_pair[ny,nx]:=(ecran_pair[ny,nx]and not masque320200[x and 3,3])
|          or masque320200[x and 3,ggcouleur]
|                   else ecran_impair[ny,nx]:=(ecran_impair[ny,nx]and not masque320200[x and 3,3])
|          or masque320200[x and 3,ggcouleur]
|  end else if gecran=3 then begin
|    nx:=x shr 3; (* div 8 *)
|    ny:=y shr 2;
|    case (y and 3) of
|      0:ecran_pair[ny,nx]:=(ecran_pair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur];
|      1:ecran_impair[ny,nx]:=(ecran_impair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur];
|      2:ecranb_pair[ny,nx]:=(ecranb_pair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur];
|      3:ecranb_impair[ny,nx]:=(ecranb_impair[ny,nx]and not masque640200[x and 7,1])
|          or masque640200[x and 7,ggcouleur];
|    end
|  end
|end;
}
procedure echange(var a,b:gpixel);
var c:gpixel; begin c:=a;a:=b;b:=c end;

procedure gpointct_imprimante(x,y:gpixel); {sur imprimante matricielle}
var lig,col,decal:integer;
    car:char;
    masque:byte;
begin
  if gtable in[4,6] then echange(x,y);
  lig:=x div 8;
  col:=y;
  decal:=7-(x mod 8);
  masque:=1 shl decal;
  if gtable in [5,6] then begin
    if numiligactu<>lig then begin
      seek(gific,numiligactu);
      write(gific,gilig);
      seek(gific,lig);
      read(gific,gilig);
      numiligactu:=lig
    end;
    if ggcouleur<>ginfos_fen^.c_fond then gilig[col]:=chr(ord(gilig[col])or masque)
        else gilig[col]:=chr(ord(gilig[col]) and (not masque))
  end else begin
    if ggcouleur<>ginfos_fen^.c_fond then gitab[lig]^[col]:=chr(ord(gitab[lig]^[col])or masque)
        else gitab[lig]^[col]:=chr(ord(gitab[lig]^[col]) and (not masque))
  end
end;

procedure gpointct(x,y:gpixel);
{sur table, lever la plume, y aller, descendre la plume}
begin
  if gtable in [1,2] then begin
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'U ',x,',',y,' D')
                                     else writeln(gtfic,'U ',x,',',y);
    dernxtable:=x;dernytable:=y
  end else if gtable in [7,8] then begin
    if gtable=8 then echange(x,y);
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'PU',x,',',y,';PD;')
                                     else writeln(gtfic,'PU',x,',',y,';');
    dernxtable:=x;dernytable:=y
  end else {inprimante 3,4,5,6}
    gpointct_imprimante(x,y)
end;

function gtyp_ecr_par_def:gtypecr;
{ 6 sur PS2 et tandon 3 sur logabax, 2 sinon }
{ on peut forcer dans la ligne de commande par /VGA /EGA /CGA /HER ou /OLI}
var ROMoli:array[1..8]of char absolute $F000:$C050;
    ROMps2:array[1..7]of char absolute $f000:$E00E;
    ROMzenith:array[1..6] of char absolute $F000:$E6D2;
  {sur PS2 : 'IBM 1981, 1987' sur Tandon 'IBM 1984 BIOS '
   mais sur tandon c'est precede par 'NOT COPR. '}
  {sur olivetti : OLIVETTI, sur Zenith : Zenith Data Systems}
    texte:string;
    i,j:integer;
    force:boolean;
  Function Detect_carte_graphique:gtypecr;
  var   reg:registers;
        pilote,mode:integer;
  begin
    {TP6}DETECTGRAPH(pilote,mode);
    case pilote of
    CGA  :detect_carte_graphique:=2;
    EGA  :detect_carte_graphique:=4;
    VGA  :detect_carte_graphique:=6;
    HERCMONO:detect_carte_graphique:=9;
    else detect_carte_graphique:=2
    end{case}
{ solution sans utilisier TP6 mais les interruptions du DOS :
|    with reg do begin
|      ah:=$12;
|      bl:=$10;
|      intr(16,reg);
|      if bl=$10 then detect_carte_graphique:=2
|      else begin
|        if bl=$08 then detect_carte_graphique:=2
|        else begin
|          ah:=$1A;
|          al:=0;
|          intr(16,reg);
|          if al=$1A then
|            if bl>=$0A then detect_carte_graphique:=5
|            else if bl>=$07 then detect_carte_graphique:=6
|            else detect_carte_graphique:=4
|          else detect_carte_graphique:=2
|        end
|      end
|    end
}
  end;
begin {GTYP_ECR_PAR_DEF}
  force:=false;
  FOR i:=1 TO ParamCount DO begin
      texte:=paramstr(i);
      for j:=1 to length(texte) do texte[j]:=upcase(texte[j]);
      if texte='/PVGA' then begin
        gtyp_ecr_par_def:=8;
        force:=true;
      end else if texte='/VGA' then begin
        gtyp_ecr_par_def:=6;
        force:=true
      end else if texte='/EGA' then begin
        gtyp_ecr_par_def:=4;
        force:=true
      end else if texte='/CGA' then begin
        gtyp_ecr_par_def:=2;
        force:=true
      end else if texte='/OLI' then begin
        gtyp_ecr_par_def:=3;
        force:=true
      end else if texte='/HER' then begin
        gtyp_ecr_par_def:=9;
        force:=true
      end
  END;
  if not force then begin
  {---------
    if ROMps2='IBM 198' then gtyp_ecr_par_def:=4  4 sinon 30 lignes de texte
    if ROMzenith='Zenith' then gtyp_ecr_par_def:=2
    else
  ----------}
    if ROMoli='OLIVETTI' then gtyp_ecr_par_def:=3
    else gtyp_ecr_par_def:=detect_carte_graphique
  end
end;

function gtestpointce(x,y:gpixel):gpixel;
var reg:registers;
begin
  {TP6}gtestpointce:=GETPIXEL(x,y)
{solution par le BIOS
|  with reg do begin
|    ah:=13;al:=0;
|    bx:=0;dx:=y;cx:=x;
|    intr($10,reg);
|    gtestpointce:=al
|  end
}
end;

procedure gpalette_1(num_coul,rouge,vert,bleu:integer);
const convert:array[0..15]of byte=(0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
{definition d'une couleur, dans la palette, pour une carte type VGA}

Var reg:registers;

Begin
  With reg Do
  Begin
    al:=$10;
    ah:=$10; {num fonction/sous_fonction}
    if gecran in [4,6] then bl:=convert[num_coul] else bl:=num_coul;
    dl:=0;
    dh:=lo(rouge);
    ch:=lo(vert);
    cl:=lo(bleu);
    bh:=0
  End;
  intr($10,reg)
end;

procedure gpalette(num_coul:integer;rouge,vert,bleu:real);
{on donne le pourcentage de rouge, vert, bleu}
begin
  gpalette_1(num_coul,round(rouge*63),round(vert*63),round(bleu*63));
end;

procedure gpalette_initiale;
var i:integer;
{Black 0 Blue 1 Green 2 Cyan 3 Red 4 Magenta 5 Brown 20 White 7 Gray 56}
{Lt Blue 57 Lt Green 58 Lt Cyan 59 Lt Red 60 Lt Magenta 61 Yellow 62 White 63}
const val_par_def:array[0..15]of record R,G,B:byte end=(
       (r:00;  G:00;  B:00 ),              {r:00;  G:00;  B:00 }
       (r:00;  G:00;  B:41 ),              {r:00;  G:00;  B:63 }
       (r:00;  G:41;  B:00 ),              {r:36;  G:63;  B:36 }
       (r:00;  G:41;  B:41 ),              {r:00;  G:63;  B:63 }
       (r:41;  G:00;  B:00 ),              {r:63;  G:20;  B:20 }
       (r:41;  G:00;  B:41 ),              {r:$b0; G:00;  B:63 }
       (r:41;  G:20;  B:00 ),              {r:$70; G:$48; B:00 }
       (r:41;  G:41;  B:41 ),              {r:$c4; G:$c4; B:$c4}
       (r:20;  G:20;  B:20 ),              {r:$34; G:$34; B:$34}
       (r:20;  G:20;  B:63 ),              {r:00;  G:00;  B:$70}
       (r:20;  G:63;  B:20 ),              {r:00;  G:$70; B:00 }
       (r:20;  G:63;  B:63 ),              {r:00;  G:$70; B:$70}
       (r:63;  G:20;  B:20 ),              {r:$70; G:00;  B:00 }
       (r:63;  G:20;  B:63 ),              {r:$70; G:00;  B:$70}
       (r:63;  G:63;  B:20 ),              {r:63;  G:63;  B:20 }
       (r:63; G:63; B:63 ) );              {r:63;  G:63;  B:63 }
begin
  if gecran in [4,5,6,7,8] then
    for i:=0 to 15 do gpalette_1(i,val_par_def[i].r,val_par_def[i].G,val_par_def[i].B);
end;

procedure gpalette_progressive;
{cree une palette pour la representation des contraintes}
{on va du bleu au vert puis jaune puis rouge. seul 0 reste noir et 15 blanc}
var i:integer;
const val_par_def:array[0..15]of record R,G,B:byte end=(
       (r:00;  G:05;  B:00 ),              {r:00;  G:00;  B:00 }
       (r:00;  G:00;  B:31 ),              {r:00;  G:00;  B:63 }
       (r:00;  G:10;  B:43 ),              {r:36;  G:63;  B:36 }
       (r:00;  G:21;  B:47 ),              {r:00;  G:63;  B:63 }
       (r:00;  G:42;  B:48 ),              {r:63;  G:20;  B:20 }
       (r:00;  G:63;  B:48 ),              {r:$b0; G:00;  B:63 }
       (r:14;  G:63;  B:35 ),              {r:$70; G:$48; B:00 }
       (r:38;  G:63;  B:19 ),              {r:$c4; G:$c4; B:$c4}
       (r:53;  G:63;  B:19 ),              {r:$34; G:$34; B:$34}
       (r:63;  G:56;  B:19 ),              {r:00;  G:00;  B:$70}
       (r:63;  G:44;  B:17 ),              {r:00;  G:$70; B:00 }
       (r:63;  G:30;  B:14 ),              {r:00;  G:$70; B:$70}
       (r:63;  G:20;  B:10 ),              {r:$70; G:00;  B:00 }
       (r:58;  G:10;  B:09 ),              {r:$70; G:00;  B:$70}
       (r:53;  G:00;  B:05 ),              {r:63;  G:63;  B:20 }
       (r:63;  G:63;  B:43 ) );              {r:63;  G:63;  B:63 }
begin
  if gecran in [4,5,6,7,8] then
    for i:=0 to 15 do gpalette(i,val_par_def[i].r/63,val_par_def[i].G/63,val_par_def[i].B/63);
end;

(******************* pas tres bon, remplace par celui du haut ******
procedure gpalette_progressive;
{palette a variation calculee et lineaire (donc mauvais) }
{on garde 0 en (presque)noir et 15 en (presque) blanc}
var i:integer;
begin
  if gecran in [4,5,6] then begin
    gpalette_1(0,0,5,0); {fond}
    gpalette_1(15,63,63,20); {jaune}
    {du rouge au bleu via blanc }
    For i:=1 To 7 Do gpalette_1(i,63,round(63*((i-1)/6)) ,round(63*((i-1)/6)));
    For i:=8 To 14 Do gpalette_1(i,63-round(63*((i-7/7))),63-round(63*((i-7)/7)),63);
    {du rouge au bleu via violet }
    for i:=1 to 14 do begin
      gpalette_1(i,round((i-1)*(63/13)), {rouge de 0 a 63}
                   0, {vert}
		   round((14-i)*(63/13)) ); {bleu de 63 a 0}
    end
  end
end;

***********************************)

procedure gchangeplume(couleur:integer);
begin
  if gtable in [1,2] then
    case couleur of
      0:writeln(gtfic,'U');
      1:writeln(gtfic,'U P1');
      2:writeln(gtfic,'U P2');
      3:writeln(gtfic,'U P3')
    end
  else if gtable in [7,8] then begin
    if couleur=ginfos_fen^.c_fond then writeln(gtfic,'UP;')
                                  else writeln(gtfic,'UP;SP',couleur,';');
  end
end;

procedure gtypetrait_table(typ:integer);
begin
  if (gtable=1)or(gtable=2) then writeln(gtfic,'L',typ)
  else if (gtable=7)or(gtable=8) then writeln(gtfic,'LT',typ,';')
end;

{couche 1---------------------------------------------------------------------}
{ sous-programmes de traces de base, ne dependent que de la couche 0, mais
  peuvent etre optimises suivant la machine }

procedure glignece(x1,y1,x2,y2:gpixel);
{utiliser l'algorithme si l'on ne sait pas tracer la droite autrement}
begin
  {TP6}LINE(x1,y1,x2,y2) {la couleur est celle de SETCOLOR, je le fais dans GCOULEUR}
end;
(* solution en pascal standard, utilisant GPOINTCE, ne traitant pas l'epaisseur
 *
 *var u,v,i,c:gpixel;
 *    xinc,yinc:integer;{-1..+1;} {plus petite taille memoire possible mais signe}
 *{on utilise l'algorithme de LUCAS, ne demandant que de savoir allumer un point}
 *begin
 *  u:=abs(x2-x1);v:=abs(y2-y1);
 *  if x1<x2 then xinc:=1 else xinc:=-1;
 *  if y1<y2 then yinc:=1 else yinc:=-1;
 *  gpointce(x1,y1);
 *  if u>v then begin
 *    c:=u shr 1; { divise par 2 = milieu }
 *    for i:=1 to u do begin
 *      x1:=x1+xinc;
 *      c:=c+v;
 *      if c>=u then begin
 *        c:=c-u;
 *        y1:=y1+yinc
 *      end;
 *      case ggtypetrait of
 *          0:gpointce(x1,y1);
 *          1:if (x1 div 4) mod 2 = 0 then gpointce(x1,y1);
 *          2:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointce(x1,y1);
 *{avant :  1:if x1 mod 2 = 0 then gpointce(x1,y1);
 *          2..6:if (x1 div ggtypetrait)mod 2=0 then gpointce(x1,y1);
 *          7:if not(((x1 shr 2)mod 7)in[4,6]) then gpointce(x1,y1);
 *          8:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointce(x1,y1);
 *          9:if not(((x1 shr 2)mod 12)in [6,7,10,11]) then gpointce(x1,y1) }
 *      end
 *    end
 *  end else begin
 *    c:=v shr 1; { divise par 2 = milieu }
 *    for i:=1 to v do begin
 *      y1:=y1+yinc;
 *      c:=c+u;
 *      if c>=v then begin
 *        c:=c-v;
 *        x1:=x1+xinc
 *      end;
 *      case ggtypetrait of
 *          0:gpointce(x1,y1);
 *          1:if (x1 div 4) mod 2 = 0 then gpointce(x1,y1);
 *          2:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointce(x1,y1);
 *      end
 *   end
 *  end
 *end;
 *)
procedure gnouvlignect(x1,y1,x2,y2:gpixel);
begin
  if (gtable=1)or(gtable=2) then
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'U ',x1,',',y1,' D ',x2,',',y2)
                 else writeln(gtfic,'U ',x2,',',y2)
  else if (gtable=7)or(gtable=8) then begin
    if gtable=8 then
     begin
      echange(x1,y1);
      echange(x2,y2)
     end;
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'PU',x1,',',y1,';PD',x2,',',y2,';')
                 else writeln(gtfic,'PU',x2,',',y2,';')
  end
end;

procedure gcontlignect(x,y:gpixel);{ligne continue depuis derniere position,
            pour eviter de lever et rabaisser la plume (et marquer un point)}
begin
  if (gtable=1)or(gtable=2) then
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'D ',x,',',y)
          else writeln(gtfic,'U ',x,',',y)
  else if (gtable=7)or(gtable=8) then begin
    if gtable=8 then echange(x,y);
    if ggcouleur<>ginfos_fen^.c_fond then writeln(gtfic,'PD ',x,',',y,';')
          else writeln(gtfic,'PU',x,',',y,';')
  end
end;

procedure glignect_imprimante(x1,y1,x2,y2:gpixel);
var u,v,i,c:gpixel;
    xinc,yinc:integer;{-1..+1;} {plus petite taille memoire possible mais signe}
{on utilise l'algorithme de LUCAS, ne demandant que de savoir allumer un point}
begin
  u:=abs(x2-x1);v:=abs(y2-y1);
  if x1<x2 then xinc:=1 else xinc:=-1;
  if y1<y2 then yinc:=1 else yinc:=-1;
  gpointct_imprimante(x1,y1);
  if u>v then begin
    c:=u shr 1; { divise par 2 = milieu }
    for i:=1 to u do begin
      x1:=x1+xinc;
      c:=c+v;
      if c>=u then begin
        c:=c-u;
        y1:=y1+yinc
      end;
      case ggtypetrait of
          0:gpointct_imprimante(x1,y1);
          1:if (x1 div 4) mod 2 = 0 then gpointct_imprimante(x1,y1);
          2:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointct_imprimante(x1,y1);
{======== 0:gpointct_imprimante(x1,y1);
          1:if x1 mod 2 = 0 then gpointct_imprimante(x1,y1);
          2..6:if (x1 div ggtypetrait)mod 2=0 then gpointct_imprimante(x1,y1);
          7:if not(((x1 shr 2)mod 7)in[4,6]) then gpointct_imprimante(x1,y1);
          8:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointct_imprimante(x1,y1);
          9:if not(((x1 shr 2)mod 12)in [6,7,10,11]) then gpointct_imprimante(x1,y1)=======}
      end
    end
  end else begin
    c:=v shr 1; { divise par 2 = milieu }
    for i:=1 to v do begin
      y1:=y1+yinc;
      c:=c+u;
      if c>=v then begin
        c:=c-v;
        x1:=x1+xinc
      end;
      case ggtypetrait of
          0:gpointct_imprimante(x1,y1);
          1:if (x1 div 4) mod 2 = 0 then gpointct_imprimante(x1,y1);
          2:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointct_imprimante(x1,y1);
{======   0:gpointct_imprimante(x1,y1);
          1:if x1 mod 2 = 0 then gpointct_imprimante(x1,y1);
          2..6:if (x1 div ggtypetrait)mod 2=0 then gpointct_imprimante(x1,y1);
          7:if not(((x1 shr 2)mod 7)in[4,6]) then gpointct_imprimante(x1,y1);
          8:if not(((x1 shr 2)mod 11)in [6,7,9,10]) then gpointct_imprimante(x1,y1);
          9:if not(((x1 shr 2)mod 12)in [6,7,10,11]) then gpointct_imprimante(x1,y1)========}
      end
    end
  end
end;

procedure glignect(x1,y1,x2,y2:gpixel);
begin
  if gtable in[1,2,7,8] then begin
    if (x1=dernxtable)and(y1=dernytable)then gcontlignect(x2,y2)
                                       else gnouvlignect(x1,y1,x2,y2);
    dernxtable:=x2;dernytable:=y2
  end else glignect_imprimante(x1,y1,x2,y2)
end;

(* utilise pour effacer plus rapidement une fenetre, inutile en TP6
 *procedure glig_horiz(x1,y,x2:gpixel);
 *{on suppose x1<x2 et ggcouleur=coul_fond}
 *{n'utilise pas le type de ligne, ne marche que sur ecran}
 *var x,nx1,nx2,ny:gpixel;
 *begin
 *  if gecran=2 then begin   {le test du plus courant EN PREMIER}
 *    for x:=1 to 8-(x1 mod 8)do gpointce(x1+x-1,y);
 *    for x:=0 to (x2 mod 8)do gpointce(x2-x,y);
 *    nx1:=(x1 div 8)+1;
 *    nx2:=(x2 div 8)-1;
 *    ny:=y shr 1;
 *    if (y and 1)=0 then for x:=nx1 to nx2 do ecran_pair[ny,x]:=0
 *                   else for x:=nx1 to nx2 do ecran_impair[ny,x]:=0
 *  end else if gecran=1 then begin
 *    for x:=1 to 8-(x1 mod 4)do gpointce(x1+x-1,y);
 *    for x:=0 to (x2 mod 4)do gpointce(x2-x,y);
 *    nx1:=(x1 div 4)+1;
 *    nx2:=(x2 div 4)-1;
 *    ny:=y shr 1;
 *    if (y and 1)=0 then for x:=nx1 to nx2 do ecran_pair[ny,x]:=0
 *                   else for x:=nx1 to nx2 do ecran_impair[ny,x]:=0
 *  end
 *  else for x:=x1 to x2 do gpointce(x,y);
 *end;
 *)

procedure gefface;   {ne marche que sur ecran}
var x,y:gpixel;
    couleur:integer;
begin
  with ginfos_fen^do begin
    {TP6}SETFILLSTYLE(SolidFill,c_fond);
    {TP6}BAR(xminp,yminp,xmaxp,ymaxp);
    {TP6}SETFILLSTYLE(SolidFill,c_fill);
(* par trace de droites horizontales (beaucoup plus lent)
 *    if num=0 then {si l'effacement total de l'ecran est plus rapide}
 *      ginit_typecr(gecran)
 *    else begin
 *    {pour effacer une ligne il vaut mieux y aller par paquets de 16 bits}
 *    {eteidre tous les points,si l'on ne possede rien de plus rapide}
 *      couleur:=ggcouleur;
 *      ggcouleur:=c_fond;
 *      for y:=yminp to ymaxp do glig_horiz(xminp,y,xmaxp);
 *        {for x:=xminp to xmaxp do gpointce(x,y)}
 *      ggcouleur:=couleur
 *    end
 *)
  end
end;

{couche 2 --------------------------------------------------------------------}
{test de clipping}

procedure calc_zone(x,y:gcoord;var z:gszone);
{calcule la zone d'un point}
begin
  with ginfos_fen^ do begin
    if x<xminu then z:=[zg] else z:=[];
    if x>xmaxu then z:=z+[zd];
    if y<yminu then z:=z+[zh];
    if y>ymaxu then z:=z+[zb]
  end
end;

{la fonction ET des deux zones, c'est l'intersection}

procedure gclip(var x1,y1,x2,y2:gcoord;var visible:boolean);
var z1,z2,z:gszone;
  {procedures locales pour ne pas passer en arguments (perte de temps) x1,y1,x2,y2}
  function vert(x:gcoord):gcoord; {intersection de la droite 1-2 avec la verticale X}
  begin
    vert:=y2+(x-x2)*((y2-y1)/(x2-x1))
  end;
  function horiz(y:gcoord):gcoord; {intersection de la droite 1-2 avec Y}
  begin
    horiz:=x2+(y-y2)*((x2-x1)/(y2-y1))
  end;
  procedure rammene_bord(var x,y:gcoord;var z:gszone);
  {ramene l'extremite de la droite sur le bord, z est recalcule (vide si on est arrive a le mettre dans le fenetre)}
  begin
    with ginfos_fen^ do begin
      if zg in z then
       begin y:=vert(xminu);x:=xminu;calc_zone(x,y,z) end
      else if zd in z then begin y:=vert(xmaxu);x:=xmaxu;calc_zone(x,y,z) end;

      {meme si on avait une intersection avec une verticale, il peut y avoir une avec une horizontale}

      if zb in z then begin x:=horiz(ymaxu);y:=ymaxu;calc_zone(x,y,z) end
      else if zh in z then begin x:=horiz(yminu);y:=yminu;calc_zone(x,y,z) end
    end
  end;

begin      {procedure gclip}
  calc_zone(x1,y1,z1);
  calc_zone(x2,y2,z2);
  if z1+z2=[] then visible:=true
  else begin
    if z1*z2<>[] then visible:=false
    else begin
      {on accepte un calcul plus long uniquement sur les cas a problemes}
      if z1<>[] then rammene_bord(x1,y1,z1);
      if z2<>[] then rammene_bord(x2,y2,z2);
      visible:=z1+z2=[] {si on n'a pas reussi a ramener au bord un point}
    end
  end
end;

{couleurs ------------------------------------------------------------------}
procedure gcouleur_tot(trait,rempli,fond:integer);
{ne change pas ce qui est actuellement : le fond ne changera qu'au GEFFACE}
begin
  if trait<=0 then trait:=0 else if trait>=gcoul_max then trait:=gcoul_max;
  if rempli<=0 then rempli:=0 else if rempli>=gcoul_max then rempli:=gcoul_max;
  if fond<=0 then fond:=0 else if fond>gcoul_max then fond:=0;
  ggcouleur:=trait;
  with ginfos_fen^ do begin
    c_fond:=fond;c_draw:=trait;c_fill:=rempli
  end;
  {TP6}SETCOLOR(trait);SETFILLSTYLE(SolidFill,rempli);
  if gtable>0 then gchangeplume(ggcouleur)
end;

procedure gcouleur(trait:integer);
begin
  if trait<=0 then trait:=0 else if trait>=gcoul_max then trait:=gcoul_max;
  ggcouleur:=trait;
  with ginfos_fen^ do begin
    c_draw:=trait
  end;
  {TP6}SETCOLOR(trait);
  if gtable>0 then gchangeplume(ggcouleur)
end;

procedure gcouleur_remplissage(rempli:integer);
begin
  if rempli<=0 then rempli:=0 else if rempli>=gniveaux_gris_max then rempli:=gniveaux_gris_max;
  {TP6}SETFILLSTYLE(SolidFill,rempli);
  with ginfos_fen^ do begin
    c_fill:=rempli
  end
end;

procedure gcouleur_fond(fond:integer);
{ne change pas ce qui est actuellement : le fond ne changera qu'au GEFFACE}
begin
  if fond<=0 then fond:=0 else if fond>gcoul_max then fond:=0;
  with ginfos_fen^ do begin
    c_fond:=fond
  end;
  if gtable>0 then if fond=ggcouleur then gchangeplume(ggcouleur);
end;

procedure gtaillecar(x,y:gcoord);
begin ginfos_fen^.xtaillecar:=x/12;ginfos_fen^.ytaillecar:=y/12 end;

procedure gtaillecarpc(x,y:real);
var xgauche,xdroite,ybas,yhaut:gcoord;
begin
  glimites(xgauche,xdroite,ybas,yhaut);
  gtaillecar(abs(xdroite-xgauche)*x,abs(yhaut-ybas)*y)
end;

procedure gtypetrait(typ:integer);
begin
  if (typ<0)or(typ>=3) then ggtypetrait:=0 else ggtypetrait:=typ;
  ginfos_fen^.typetrait:=ggtypetrait;
  {TP6}SETLINESTYLE(ggtypetrait,0,ginfos_fen^.eptrait);
  if gtable>0 then gtypetrait_table(typ)
end;

procedure geptrait(typ:integer);
var gg:integer;
begin
  if (typ<0)or(typ>=3) then gg:=0 else gg:=typ;
  ginfos_fen^.eptrait:=gg;
  {TP6}SETLINESTYLE(ginfos_fen^.typetrait,0,gg);
{  if gtable>0 then geptrait_table(typ) }
end;

{couche 3 definitions generales---------------------------------------------}

{a l'echelle PAPIER, gestion des fenetres}

procedure gchoix_fenetre(num_fen:integer);
var pointeur:gp_infos_fen;
begin
  if num_fen<>ginfos_fen^.num then begin
    pointeur:=ginfos_fen^.suiv;
    while (pointeur<>ginfos_fen)and(pointeur^.num<>num_fen)
      do pointeur:=pointeur^.suiv;
    if pointeur^.num<>num_fen then gerr(4,false,'GCHOIX_FENETRE')
                              else ginfos_fen:=pointeur;
    {est ce que ca suffit pour changer la plume et typetrait sur la table ? }
    with ginfos_fen^do begin
      gcouleur_tot(c_draw,c_fill,c_fond);
      ggtypetrait:=typetrait;
      {ne pas utiliser car change l'origine:SETVIEWPORT(xminp,yminp,xmaxp,ymaxp,ClipOn)}
    end
  end
end;

function gexiste_fenetre(num_fen:integer):boolean;
var pointeur:gp_infos_fen;
begin
  if num_fen<>ginfos_fen^.num then begin
    pointeur:=ginfos_fen^.suiv;
    while (pointeur<>ginfos_fen)and(pointeur^.num<>num_fen)
      do pointeur:=pointeur^.suiv;
    gexiste_fenetre:=pointeur^.num=num_fen
  end else gexiste_fenetre:=true
end;

procedure gferme_fenetre(num_fen:integer);
{attention on ne doit plus etre dans cette fenetre, num_fen >0}
var prec,actu:gp_infos_fen;
begin
  if num_fen=0 then gerr(5,true,'GFERME_FENETRE')
  else if not gexiste_fenetre(num_fen) then gerr(4,true,'GFERME_FENETRE')
  else begin
    prec:=ginfos_fen;
    actu:=prec^.suiv;
    while actu^.num<>num_fen do begin
      prec:=prec^.suiv;
      actu:=actu^.suiv
    end;
    if ginfos_fen=actu then begin {on ferme actu}
      gerr(3,false,'GFERME_FENETRE');
      gchoix_fenetre(0)
    end;
    prec^.suiv:=actu^.suiv;
    dispose(actu)
  end
end;

procedure calcul_limit_fenetre;
{on doit etre dans la fenetre, on en calcule les limites (cood p,t)
 en fonction de ginfos_fen^.xgauchef,...}
begin
  with ginfos_fen^ do begin
      xgauchep:=xgauchecr+round(xgauchef*(xdroitecr-xgauchecr));
      xdroitep:=xgauchecr+round(xdroitef*(xdroitecr-xgauchecr));
      yhautp  :=ybasecr+round(yhautf*(yhautecr-ybasecr));
      ybasp   :=ybasecr+round(ybasf *(yhautecr-ybasecr));
      if xgauchep<xdroitep then begin xminp:=xgauchep;xmaxp:=xdroitep end
                           else begin xmaxp:=xgauchep;xminp:=xdroitep end;
      if yhautp<ybasp then begin yminp:=yhautp;ymaxp:=ybasp end
                      else begin ymaxp:=yhautp;yminp:=ybasp end;
      if gtable>0 then begin
        xgauchet:=xgauchetab+round(xgauchef*(xdroitetab-xgauchetab));
        xdroitet:=xgauchetab+round(xdroitef*(xdroitetab-xgauchetab));
        yhautt  :=ybastab+round(yhautf*(yhauttab-ybastab));
        ybast   :=ybastab+round(ybasf *(yhauttab-ybastab));
        if xgauchet<xdroitet then begin xmint:=xgauchet;xmaxt:=xdroitet end
                             else begin xmaxt:=xgauchet;xmint:=xdroitet end;
        if yhautt<ybast then begin ymint:=yhautt;ymaxt:=ybast end
                        else begin ymaxt:=yhautt;ymint:=ybast end
      end
  end
end;

procedure gcree_fenetre(xgauche,xdroit,ybas,yhaut:real;num_fen:integer);
{cree la fenetre (on donne un numero >0) et s'y place}
var pointeur:gp_infos_fen;
    memo:real;
begin
  if num_fen=0 then gerr(6,true,'GCREE_FENETRE')
  else if (xgauche<0)or(xgauche>1)or(xdroit<0)or(xdroit>1)or(yhaut<0)or(yhaut>1)
          or(ybas<0)or(ybas>1)then gerr(7,true,'GCREE_FENETRE')
  else begin
{if ybasecr>yhautecr then begin memo:=ybas;ybas:=yhaut;yhaut:=memo end;}
    if not gexiste_fenetre(num_fen) then begin
      new(pointeur);
      pointeur^.suiv:=ginfos_fen^.suiv; {on insere derriere la fen actu}
      ginfos_fen^.suiv:=pointeur;
      ginfos_fen:=pointeur; {c'est la fenetre active}
    end else gchoix_fenetre(num_fen);
    with ginfos_fen^ do begin
      xgauchef:=xgauche;
      xdroitef:=xdroit;
      yhautf:=yhaut;
      ybasf:=ybas;
      cos_car:=1;sin_car:=0;
      xtaillecar:=0;ytaillecar:=0; {mis a jour au prochain gechelle, pas les suivants}
      c_draw:=def_c_draw;c_fill:=def_c_fill;c_fond:=def_c_fond;
      ggcouleur:=c_draw;
      typetrait:=0;
      eptrait:=0;
      g3type:=0;

      g3xoeil:=32000;g3yoeil:=0;g3zoeil:=0;
      g3xvise:=0;g3yvise:=0;g3zvise:=0;
      g3dx:=1;g3dy:=0;g3dz:=0;g3n:=0;
      g3vertx:=0;g3verty:=0;g3vertz:=0;g3horx:=0;g3hory:=0;g3horz:=0;

      num:=num_fen
    end;
    calcul_limit_fenetre;
    gtypetrait(0)
  end
end;

procedure gcadre;
var i:gpixel;
begin
  with ginfos_fen^ do begin
    {TP6}RECTANGLE(xminp,yminp,xmaxp,ymaxp);
    if g3type=3 {g34vues} then begin
      for i:=yminp to ymaxp do gpointce((xminp+xmaxp)div 2,i);
      for i:=xminp to xmaxp do gpointce(i,(yminp+ymaxp)div 2)
    end;
{en standard,en n'utilisant pas les droites quelconques pour etre plus rapide :
|    for i:=yminp to ymaxp do
|      begin gpointce(xminp,i);gpointce(xmaxp,i) end;
|    for i:=xminp to xmaxp do
|      begin gpointce(i,yminp);gpointce(i,ymaxp) end;
}
   if gtable>0 then begin
      for i:=ymint to ymaxt do
        begin gpointct(xmint,i);gpointct(xmaxt,i) end;
      for i:=xmint to xmaxt do
        begin gpointct(i,ymint);gpointct(i,ymaxt) end;
      if g3type=3 {g34vues} then begin
        for i:=ymint to ymaxt do gpointct((xmint+xmaxt)div 2,i);
        for i:=xmint to xmaxt do gpointct(i,(ymint+ymaxt)div 2)
      end
    end
  end
end;

{a l'echelle utilisateur}

procedure gproj_u_p(xu,yu:gcoord;var xp,yp:gpixel);
begin
  with ginfos_fen^ do begin xp:=round(ax*xu +bx); yp:=round(ay*yu +by) end
end;

procedure gproj_p_u(xp,yp:gpixel;var xu,yu:gcoord);
begin
  with ginfos_fen^ do begin xu:=(xp-bx)/ax;yu:=(yp-by)/ay end
end;

procedure gproj_u_t(xu,yu:gcoord;var xp,yp:gpixel);
begin
  with ginfos_fen^ do begin xp:=round(tax*xu +tbx); yp:=round(tay*yu +tby) end
end;

procedure gproj_t_u(xp,yp:gpixel;var xu,yu:gcoord);
begin
  with ginfos_fen^ do begin xu:=(xp-tbx)/tax;yu:=(yp-tby)/tay end
end;

procedure gechelle(xgauche,xdroite,ybas,yhaut:gcoord);
{dans la fenetre papier actuelle}
begin
  if (xgauche=xdroite)or(yhaut=ybas)then gerr(1,true,'GECHELLE')
  else with ginfos_fen^ do begin
    xgaucheu:=xgauche;xdroiteu:=xdroite;
    yhautu:=yhaut;ybasu:=ybas;
    if xgaucheu<xdroiteu then begin xminu:=xgaucheu;xmaxu:=xdroiteu end
                         else begin xmaxu:=xgaucheu;xminu:=xdroiteu end;
    if yhautu<ybasu then begin yminu:=yhautu;ymaxu:=ybasu end
                    else begin ymaxu:=yhautu;yminu:=ybasu end;
    ax:=(xdroitep-xgauchep)/(xdroite-xgauche);
    bx:=xgauchep-(ax*xgauche);
    ay:=(yhautp-ybasp)/(yhaut-ybas);
    by:=ybasp-(ybas*ay);
    if gtable>0 then begin
      tax:=(xdroitet-xgauchet)/(xdroite-xgauche);
      tbx:=xgauchet-(tax*xgauche);
      tay:=(yhautt-ybast)/(yhaut-ybas);
      tby:=ybast-(ybas*tay)
    end;
    if xtaillecar=0 then begin
      xtaillecar:=abs(xdroite-xgauche)/480; {40(/12) caract par ligne}
      ytaillecar:=abs(yhaut-ybas)/300       {25(/12)lignes par fenetre}
    end
  end
end;

procedure gechelleort(xgauche,xdroite,ybas,yhaut:gcoord);
var rapport:real;
begin
  gechelle(xgauche,xdroite,ybas,yhaut);
  if gtable>0 then with ginfos_fen^ do begin
  {si on a la table, ca sera ortho sur la table(pas necessairement sur ecran}
    rapport:=abs((tax/carre_xsurytab)/tay);
    if rapport>1 then begin
      tax:=tax/rapport;
      tbx:=(xgauchet+xdroitet-tax*(xgauche+xdroite))/2
    end else begin
      tay:=tay*rapport;
      tby:=(yhautt+ybast-tay*(yhaut+ybas))/2
    end;
    gproj_t_u(xgauchet,ybast,xgauche,ybas);
    gproj_t_u(xdroitet,yhautt,xdroite,yhaut)
  end else with ginfos_fen^ do begin
    rapport:=abs((ax/carre_xsury)/ay);
    if rapport>1 then begin
      ax:=ax/rapport;
      bx:=(xgauchep+xdroitep-ax*(xgauche+xdroite))/2
    end else begin
      ay:=ay*rapport;
      by:=(yhautp+ybasp-ay*(yhaut+ybas))/2
    end;
    gproj_p_u(xgauchep,ybasp,xgauche,ybas);
    gproj_p_u(xdroitep,yhautp,xdroite,yhaut)
  end;
  {je recalcule tout, pour avoir les bonnes valeurs meme sur la table}
  gechelle(xgauche,xdroite,ybas,yhaut);
end;

procedure glimites(var xgauche,xdroite,ybas,yhaut:gcoord);
begin
  with ginfos_fen^ do begin
    xgauche:=xgaucheu;xdroite:=xdroiteu;
    yhaut:=yhautu;ybas:=ybasu
  end
end;

procedure ginit(x:gtypecr);
{ne PAS appeler GINIT deux fois de suite,il faut d'abord passer par gfin}
begin
  if ginfos_fen<>nil then gerr(2,true,'GINIT') ;
  {TP6 si le langage empeche d'initialiser les variables, virer ce test}
  ginit_typecr(x);
  if gcoul_max<=3 then gniveaux_gris_max:=13 else gniveaux_gris_max:=gcoul_max;
  gecran:=x;
  gtable:=0;
  new(ginfos_fen);
  with ginfos_fen^ do begin
    xgauchef:=0;
    xdroitef:=1;
    yhautf:=1;
    ybasf :=0;
    cos_car:=1;sin_car:=0;
    num:=0;
    typetrait:=0;
    g3type:=0;
    suiv:=ginfos_fen
  end;
  calcul_limit_fenetre;
  gechelle(0,1000,0,1000);
  gtypetrait(0);
  gcouleur_tot(def_c_draw,def_c_fill,def_c_fond)
end;

procedure gdebut_table(n:gtypecr;nomfic:string;xgauche,xdroite,ybas,yhaut:real);
var numfen:integer;
    memo:gpixel;
begin
  if (xgauche<0)or(xgauche>1)or(xdroite<0)or(xdroite>1)or(yhaut<0)or(yhaut>1)
          or(ybas<0)or(ybas>1)then gerr(7,true,'GDEBUT_TABLE')
  else begin
    gdebut_typtab(n,nomfic);
    memo      :=xgauchetab+round(xgauche*(xdroitetab-xgauchetab));
    xdroitetab:=xgauchetab+round(xdroite*(xdroitetab-xgauchetab));
    xgauchetab:=memo;
    memo      :=ybastab+round(yhaut*(yhauttab-ybastab));
    ybastab   :=ybastab+round(ybas *(yhauttab-ybastab));
    yhauttab  :=memo;
    gtable:=n;
    numfen:=ginfos_fen^.num;
    {toutes les echelles des fenetres sont remises a jour}
    repeat
      with ginfos_fen^ do begin
        calcul_limit_fenetre;
        gechelle(xgaucheu,xdroiteu,ybasu,yhautu)
      end;
      ginfos_fen:=ginfos_fen^.suiv
    until ginfos_fen^.num=numfen;
  end
end;

procedure gfin_table;
begin
  if gtable>0 then begin
    gfin_typtab;
    gtable:=0
  end
end;

procedure gfin;
{revient en mode texte; ferme les fenetres}
var actu,a_jeter:gp_infos_fen;
begin
  gfin_table;
  actu:=ginfos_fen^.suiv;
  ginfos_fen^.suiv:=nil;
  while actu<>nil do begin
    a_jeter:=actu;
    actu:=actu^.suiv;
    dispose(a_jeter)
  end;
  ginfos_fen:=nil;
  gecran:=0;
  gtable:=0;
  {TP6}CLOSEGRAPH;  { sinon : ginit_typecr(0); }
end;

{a l'echelle utilisateur-------------------------------------------------}
{avec tests de clipping, c'est a dire empecher de depasser de la fenetre}
{tout se fait en coord utilisateur pour  :
    (a) ne pas depasser 32000 en coord papier
    (b) ne pas refaire le test sur table et ecran
}
procedure gpoint(x,y:gcoord);
var i,j:gpixel;
begin
  with ginfos_fen^ do if (x>=xminu)and(x<=xmaxu)and(y>=yminu)and(y<=ymaxu) then begin
    gproj_u_p(x,y,i,j);
    gpointce(i,j);
    if gtable>0 then begin
      gproj_u_t(x,y,i,j);
      gpointct(i,j);
    end
  end
end;

function gtestpoint(x,y:gcoord):gpixel;
{rend la couleur du pixel de l'ecran le plus proche (ne marche pas sur table)}
var i,j:gpixel;
begin
  with ginfos_fen^ do if (x>=xminu)and(x<=xmaxu)and(y>=yminu)and(y<=ymaxu) then begin
    gproj_u_p(x,y,i,j);
    gtestpoint:=gtestpointce(i,j)
  end
end;

procedure gligne(x1,y1,x2,y2:gcoord);
var i1,j1,i2,j2:gpixel;
    visible:boolean;
begin
  gclip(x1,y1,x2,y2,visible);
  if visible then begin
    gproj_u_p(x1,y1,i1,j1);
    gproj_u_p(x2,y2,i2,j2);
    glignece(i1,j1,i2,j2);
    if gtable>0 then begin
      gproj_u_t(x1,y1,i1,j1);
      gproj_u_t(x2,y2,i2,j2);
      glignect(i1,j1,i2,j2);
    end
  end
end;

procedure gcarpoint(x,y:gcoord;typ:integer);
{typ: 0=point,1=x,2=rectangle,3=*,4=losange,5=+}
{la taille depend de GTAILLECAR (la moitie environ) }
var taillex,tailley:real;
begin
  taillex:=ginfos_fen^.xtaillecar*3;
  tailley:=ginfos_fen^.ytaillecar*3;
  case (typ mod 6) of
    0:gpoint(x,y);
    1:begin gligne(x-taillex,y-tailley,x+taillex,y+tailley);
            gligne(x-taillex,y+tailley,x+taillex,y-tailley) end;
    2:begin gligne(x-taillex,y-tailley,x+taillex,y-tailley);
            gligne(x+taillex,y-tailley,x+taillex,y+tailley);
            gligne(x+taillex,y+tailley,x-taillex,y+tailley);
            gligne(x-taillex,y+tailley,x-taillex,y-tailley) end;
    3:begin gligne(x-taillex,y-tailley,x+taillex,y+tailley);
            gligne(x-taillex,y+tailley,x+taillex,y-tailley);
            gligne(x-taillex,y,x+taillex,y) end;
    4:begin gligne(x-taillex,y,x,y-tailley);gligne(x,y-tailley,x+taillex,y);
            gligne(x+taillex,y,x,y+tailley);gligne(x,y+tailley,x-taillex,y) end;
    5:begin gligne(x-taillex,y,x+taillex,y);gligne(x,y+tailley,x,y-tailley) end
  end
end;

procedure grectangle(xg,yb,xd,yh:gcoord);
begin
  gligne(xg,yb,xd,yb);
  gligne(xd,yb,xd,yh);
  gligne(xd,yh,xg,yh);
  gligne(xg,yh,xg,yb)
end;

procedure gfleche(x0,y0,x1,y1:gcoord);
{la taille du signe > depend de la taille donnee dans GTAILLECAR}
var deltax,deltay:real;
    axex,axey,normx,normy,l:real;
begin
  gligne(x0,y0,x1,y1);
  deltax:=ginfos_fen^.xtaillecar*6;deltay:=ginfos_fen^.ytaillecar*6;
  l:=sqrt(sqr(x0-x1)+sqr(y0-y1));
  if l>0 then begin
    axex:=(x0-x1)/l;axey:=(y0-y1)/l;{de 1 vers 0}
    normx:=axey;normy:=-axex;  (* vecteur unitaire axial et normal a la fleche *)
    gligne(x1,y1,x1+(axex+normx)*deltax,y1+(axey+normy)*deltay);
    gligne(x1,y1,x1+(axex-normx)*deltax,y1+(axey-normy)*deltay)
  end
end;

procedure garcellipse(xcentre,ycentre,rayonx,rayony,angledeb,anglefin:gcoord);
(* je le trace par segments de droites *)
(* les angles sont en degres *)
(* a utiliser si on n'a pas les arcs d'ellipse disponibles en standard *)
(* avec une table de cos on met 20 s pour 10 cercles, en les calculant 50 s *)
(* attention : il trace aussi sur la table (car les lignes y sont traitees) *)

const pas=2;
var teta,x1,x2,y1,y2:gcoord;
    angle,fact:real;

  procedure xy(angle:real; var x,y:gcoord); (* calcule le point pour un angle donne *)
  begin
    x:=xcentre+(rayonx*cos(angle));
    y:=ycentre+(rayony*sin(angle))
  end;

begin
  fact:=pi/180;
  teta:=angledeb;
  while angledeb>anglefin do anglefin:=anglefin+360;
  angle:=teta*fact;
  xy(angle,x1,y1);
  while teta<anglefin do begin
    teta:=teta+pas;
    if teta<=anglefin then angle:=teta*fact else angle:=anglefin*fact;
    xy(angle,x2,y2);
    gligne(x1,y1,x2,y2);
    x1:=x2;
    y1:=y2
  end
end;

procedure garc(xcentre,ycentre,rayonx,angledeb,anglefin:real);
begin
  garcellipse(xcentre,ycentre,rayonx,rayonx,angledeb,anglefin)
end;

procedure gcercle(xcentre,ycentre,rayon:real);
begin
  garc(xcentre,ycentre,rayon,0,360)
end;

procedure gellipse(xcentre,ycentre,rayonx,rayony:real);
begin
  garcellipse(xcentre,ycentre,rayonx,rayony,0,360);
end;

{initialisation ---------------------------------------------------------}
BEGIN
  ginfos_fen:=nil;
  gtable:=0;
  gecran:=0
END.{unit g2d}