PCX, GIF, TGA, BMP in SVGA.

Well, this is a program to visualize 256 colors PCX, TGA, BMP, 16M colors
BMP and TGA, and 2-256 colors GIF. The dimension of images should be less
than 1024*768 for 256 colors files (can be upgraded), and less than 640*480
for 16M colors files (can be upgraded too).

To see SVGA files, your video card must be VESA compatible.
Images less than 320*200 can be visualized on standard VGA display.

This code is absoluty free, I have no right on it. But, it would be nice to
send me a copy of your work if you modify it or include it in other program.
If you can enhace the program, it should me nice to send me a mail,
explaning what you want to enhace and how you want to enhace it ...
Of course, you can do what you want, but it would be nice ...

The code is a litte dirty, with no comments, and a lot of keywords are
derived from French, so I hope you will understand the program ...
If you think it is to dirty and you understand nothing, send me a mail, i
will try to make it clearer ...

The program uses 2 units, see at the end of the program.
The usgvesa unit use a little asm routine, that can be removed, as it only
enhace the move procedure.

I an waiting for all suggestions, ideas, procedures can could speed up the
program or add new fonctions ... The program is fairly fast for PCX, BMP,
and TGA files, but very slow for GIF, it would be nice if someone can give
me ideas about speed it up ...

I hope this will help, and that I will receive a lot of mail that will
improve it ...

                                        F.
Fabrice.Pre...@linux.univ-compiegne.fr
WWW : http://linux.univ-compiegne.fr/~premel/index.html

Program BMP2;
uses usgvesa, crt, dos, umcga;     (*Uses New Graphics Unit*)

type                               (*Types for File Headers*)
   fileheaders= record
                     bftype                                  : word;
                     bfsize                                  : longint;
                     bfreserved1, bfreserved2                : word;
                     bfoffbits                               : longint;
               end;
   infoheaders= record
                     bisize, biwidth, biheight               : longint;
                     biplanes, bibitcount                    : word;
                     bicompression, bisizeimage, bixpel{*word*237}eter, bitpel{*word*237}eter, biclrused, biclrimportant : longint;
               end;
   entete_bmp= record
                     fileheader: fileheaders;
                     infoheader: infoheaders;
               end;
   color_32= record
                   b, v, r, o:byte;
             end;
   tcouleurs_bmp= record
                    b, v, r : byte;
              end;
   tpalette_bmp = array[0..255] of color_32;
   tpalette_tga= array[0..255] of tcouleurs_bmp;
   Tga_type_lut = record
                             origine, longueur : word;
                             bits_lut : byte;
                       end;
   Tga_description_image = record
                                 plusieurs_choses : byte;
                           end;
   Tga_image_specification = record
                                   Xorg, Yorg, largeur, hauteur : word;
                                   bits_par_pixels : byte;
                                   description_image : Tga_description_image;
                             end;
   entete_Tga = record
                      taille_du_commentaire : byte;
                      presence_lut : byte;
                      type_image : byte;
                      lut : Tga_type_lut;
                      image : Tga_image_specification;
                end;
     entete_pcx = record
                         manufacturer, version, compression, bits_par_pixels : byte;
                         xmin, ymin, xmax, ymax, xdpi, ydpi : word;
                         palette : array[1..16] of t_palette;
                         reserved, plane : byte;
                         bytesperline, paletteinfo, xscreen, yscreen : word;
                         vent : array[1..54] of byte;
                  end;
  Tnom_rep    = record                            (*To store files*)
                      nom        : string[12];
                      repertoire : boolean;
                      type_fichier : byte;
                end;
  Trepertoire = array[1..2000] of Tnom_rep;
     screen_descriptor = record
                               signature : array[1..6] of char;
                               largeur, hauteur : word;
                               mask : byte;
                               background : byte;
                               rien : byte;
                         end;

     img_descriptor = record
                            separateur : char;
                            departh, departg, hauteur, largeur : word;
                            mask : byte;
                      end;
  tbuffer = array[0..60000] of byte;            (*For Faster Image Loading*)

const
     nb_par_page = 138;
     bmp = 1;
     tga = 2;
     gif = 3;
     pcx = 4;
     maxbuffer = 60001;

var
   repertoire : trepertoire;
   compteur   : word;
   curseurx, curseury : byte;
   touche : char;
   numero_entree : byte;
   lecteur : string;
   nb_rep : byte;
   nb_pages, page_active : byte;
   temp : word;
   temp2 : word;
   presence_souris : boolean;
   etat : byte;
    time : longint;

function start_timer : longint;
var h, m, s, s100 : word;
begin
     gettime(h, m, s, s100);
     start_timer:=round(6000.0*m+100.0*s+s100);
end;

function elap_time(tps : longint) : longint;
var h, m, s, s100 : word;
begin
     gettime(h, m, s, s100);
     elap_time:=round((6000.0*m+100.0*s+s100)-tps);
end;

procedure classe;
var   i:integer;
      temporaire:tnom_rep;
      c : boolean;
begin
     repeat
           c:=false;
           i:=1;
           while(i<nb_rep-1) do begin
               if(repertoire[i].nom>repertoire[i+1].nom) then  begin
            (* ?change a[i] et a[i+1] *)
                       temporaire:=repertoire[i];
                       repertoire[i]:=repertoire[i+1];
                       repertoire[i+1]:=temporaire;
                       c:=true;
            (* c=1 indique qu'un ?change a eu lieu *)
               end;
               i:=i+1
           end;
     until not c;
     repeat
           i:=nb_rep;
           c:=FALSE;
           while(i<compteur-1) do begin
              if(repertoire[i].nom>repertoire[i+1].nom) then begin
            (* ?change a[i] et a[i+1] *)
                 temporaire:=repertoire[i];
                 repertoire[i]:=repertoire[i+1];
                 repertoire[i+1]:=temporaire;
                 c:=TRUE;
            (* c=1 indique qu'un ?change a eu lieu *)
               end;
               i:=i+1
           end;
     until not c;
end;

{**********************************************************************
 *             procedure cache_curseur                                *
 **********************************************************************
 *entr?e : rien                                                       *
 *sortie : rien                                                       *
 **********************************************************************
 *description :                                                       *
 *   Cache le curseur                                                 *
 **********************************************************************}
procedure cache_curseur;assembler;
asm
   mov  ax, 0100h
   mov  cx, 2000h
   int  10h
end;

{**********************************************************************
 *             procedure initialise_ecran                             *
 **********************************************************************
 *entr?e : rien                                                       *
 *sortie : rien                                                       *
 **********************************************************************
 *description :                                                       *
 *   Initialise le mode texte et pr?sente le bureau.                  *
 **********************************************************************}
procedure initialise_ecran;
begin
     directvideo := true;
     textmode       ( co80  );
     cache_curseur;
     textbackground ( blue  );
     clrscr;
     gotoxy         ( 1, 1  );
     textbackground ( brown );
     clreol;
     gotoxy         ( 1, 25 );
     textbackground ( brown );
     clreol;
     textbackground ( blue  );
     textcolor      ( white );
     gotoxy         ( 25, 1 );
     write          ( ' Visualisateur d''images BMP, TGA ' );
     gotoxy         ( 21, 25 );
     write          ( ' Changement de lecteur : taper label ' );
     window         ( 1, 2, 80, 24 );
end;

{**********************************************************************
 *             procedure videstructure                                *
 **********************************************************************
 *entr?e : la structure                                               *
 *sortie : rien                                                       *
 **********************************************************************
 *description :                                                       *
 *   Vide le tableau repertoire.                                      *
 **********************************************************************}
procedure videstructure( var struc : trepertoire );
var compteur : word;
begin
     for compteur:=1 to 2000 do begin
         repertoire[compteur].nom:='';
         repertoire[compteur].repertoire:=true;
         repertoire[compteur].type_fichier:=0;
     end;
end;

{**********************************************************************
 *             procedure est_repertoire                               *
 **********************************************************************
 *entr?e : rep : searchrec                                            *
 *sortie : TRUE si rep=r?pertoire  FALSE sinon                        *
 **********************************************************************
 *description :                                                       *
 *   d?termine si rep est un vrai r?pertoire                          *
 **********************************************************************}
function est_repertoire ( rep : searchrec ) : boolean;
var dummy : boolean;
begin
     dummy:= ( rep.attr and directory ) = directory;
     dummy:= dummy and ( rep.name<> '.' );
     est_repertoire:=dummy;
end;

procedure trouve_repertoires;
var
   rep : searchrec;
begin
     videstructure(repertoire);
     nb_rep:=1;
     compteur:=1;
     findfirst ( '*.*', directory, rep );
     findnext ( rep );
     repeat
           if est_repertoire ( rep ) then begin
              repertoire[ compteur ].nom:= rep.name;
              repertoire[ compteur ].repertoire:= true;
              repertoire[ compteur ].type_fichier:=0;
              inc ( compteur );
              inc ( nb_rep );
           end;
           findnext ( rep );
     until doserror <> 0;
     findfirst ('*.bmp', anyfile, rep );
     if doserror = 0 then begin;
        repeat
              repertoire[ compteur ].nom:= rep.name;
              repertoire[ compteur ].repertoire:= false;
              repertoire[ compteur ].type_fichier:=bmp;
              inc ( compteur );
              findnext ( rep );
        until doserror <> 0;
     end;
     findfirst ('*.tga', anyfile, rep );
     if doserror = 0 then begin
     repeat
           repertoire[ compteur ].nom:= rep.name;
           repertoire[ compteur ].repertoire:= false;
           repertoire[ compteur ].type_fichier:=tga;
           inc ( compteur );
           findnext ( rep );
     until doserror <> 0;
     end;
     findfirst ('*.gif', anyfile, rep );
     if doserror = 0 then begin
     repeat
           repertoire[ compteur ].nom:= rep.name;
           repertoire[ compteur ].repertoire:= false;
           repertoire[ compteur ].type_fichier:=gif;
           inc ( compteur );
           findnext ( rep );
     until doserror <> 0;
     end;
     findfirst ('*.pcx', anyfile, rep );
     if doserror=0 then begin
     repeat
           repertoire[ compteur ].nom:=rep.name;
           repertoire[ compteur ].repertoire:=false;
           repertoire[ compteur ].type_fichier:=pcx;
           inc(compteur);
           findnext(rep);
     until doserror <> 0;
     end;
     nb_pages:=compteur div nb_par_page;
end;

procedure affiche_repertoires;
var
   compteur1, compteur2 : word;
begin
     temp:=nb_par_page * page_active;
     if compteur<temp+(nb_par_page-1) then temp2:=compteur else temp2:=temp+nb_par_page;
     for compteur1:=temp+1 to temp2-1 do begin
         compteur2:=(compteur1 mod nb_par_page) div 23 ;
         gotoxy ( compteur2 * 13 + 2, (compteur1 mod nb_par_page) - compteur2 * 23 + 1 );
         if not repertoire[ compteur1 ].repertoire then textcolor ( white )
                                                   else textcolor ( lightblue );
         write( repertoire[ compteur1 ].nom );
     end;
     textcolor ( white );
end;

procedure change_page_active(nvelle_page : shortint);
begin
     if nvelle_page>nb_pages then exit;
     if nvelle_page<0 then exit;
     page_active:=nvelle_page;
     clrscr;
     affiche_repertoires;
end;

procedure affiche_curseur ( x, y : byte );
begin
     gotoxy ( x, y );
     write ( '>' );
end;

procedure efface_curseur ( x, y : byte );
begin
     gotoxy ( x, y );
     write ( ' ' );
end;

procedure decompresse_ligne_bmp(var ligne : tligne_8_v;longueur_ligne : word;var f : file);
var
   fin : boolean;
   premier, deuxieme : byte;
   nombre : word;
   compteur : word;
begin
     nombre:=0;
     fin:=false;
     repeat
           blockread(f, premier, sizeof(byte));
           blockread(f, deuxieme, sizeof(byte));
           if premier<>0 then begin
              for compteur:=0 to premier-1 do ligne[nombre+compteur]:=deuxieme;
              inc(nombre, premier-1);
           end
           else begin
                     if deuxieme=0 then fin:=true;
                     if deuxieme=1 then fin:=true;
                     if deuxieme>3 then begin
                        for compteur:=0 to deuxieme-1 do begin
                            blockread(f, premier, sizeof(byte));
                            ligne[nombre+compteur]:=premier;
                        end;
                        inc(nombre, deuxieme-1);
                     end;
           end;
     until (fin) or (nombre=longueur_ligne-1);
end;

procedure affiche_bmp_8_bits_vesa(var f : file; entete : entete_bmp);
var
   x, y : word;
   ligne : tligne_8_v;
   palette_bmp : tpalette_bmp;
   palette : tpalette;
   nombre_de_couleurs_dans_lut : word;
begin
     if (entete.infoheader.biwidth<=640) and (entete.infoheader.biheight<=480) then setmode($101)
        else if (entete.infoheader.biwidth<=800) and (entete.infoheader.biheight<=600) then setmode($103)
             else if (entete.infoheader.biwidth<=1024) and (entete.infoheader.biheight<=768) then setmode($105)
                  else setmode($107);
     if entete.infoheader.biclrused<>0 then nombre_de_couleurs_dans_lut:=entete.infoheader.biclrused
                                       else nombre_de_couleurs_dans_lut:=256;
     blockread(f, palette_bmp, nombre_de_couleurs_dans_lut*sizeof(color_32));
     seek(f, entete.fileheader.bfoffbits);
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette_bmp[x].r;
         palette[x].v:=palette_bmp[x].v;
         palette[x].b:=palette_bmp[x].b;
     end;
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette[x].r shr 2;
         palette[x].v:=palette[x].v shr 2;
         palette[x].b:=palette[x].b shr 2;
     end;
     ecriture_palette(palette, 0, 256);
     for y:=entete.infoheader.biheight-1 downto 0 do begin
         if entete.infoheader.bicompression=0 then blockread(f, ligne, entete.infoheader.biwidth)
                                              else decompresse_ligne_bmp(ligne, entete.infoheader.biwidth, f);
         ecrit_ligne_vesa(ligne, y, entete.infoheader.biwidth);
     end;
end;

procedure affiche_tga_8_bits_vesa(var f : file; entete : entete_tga);
var
   x, y : word;
   ligne : tligne_8_v;
   palette_tga : tpalette_tga;
   palette : tpalette;
   nombre_de_couleurs_dans_lut : word;
begin
     if (entete.image.largeur<=640) and (entete.image.hauteur<=480) then setmode($101)
        else if (entete.image.largeur<=800) and (entete.image.hauteur<=600) then setmode($103)
             else if (entete.image.largeur<=1024) and (entete.image.hauteur<=768) then setmode($105)
                  else setmode($107);
     nombre_de_couleurs_dans_lut:=entete.lut.longueur;
     blockread(f, palette_tga, nombre_de_couleurs_dans_lut*sizeof(tcouleurs_bmp));
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette_tga[x].r;
         palette[x].v:=palette_tga[x].v;
         palette[x].b:=palette_tga[x].b;
     end;
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette[x].r shr 2;
         palette[x].v:=palette[x].v shr 2;
         palette[x].b:=palette[x].b shr 2;
     end;
     ecriture_palette(palette, 0, 256);
     for y:=0 to entete.image.hauteur-1 do begin
         if (entete.type_image=1) or (entete.type_image=2) then blockread(f, ligne, entete.image.largeur);
         ecrit_ligne_vesa(ligne, y, entete.image.largeur);
     end;
end;

procedure affiche_bmp_8_bits(var f : file; entete : entete_bmp);
var
   x, y : word;
   ligne : tligne_8_v;
   palette_bmp : tpalette_bmp;
   palette : tpalette;
   nombre_de_couleurs_dans_lut : word;
begin
     init_mcga;
     if entete.infoheader.biclrused<>0 then nombre_de_couleurs_dans_lut:=entete.infoheader.biclrused
                                       else nombre_de_couleurs_dans_lut:=256;
     blockread(f, palette_bmp, nombre_de_couleurs_dans_lut*sizeof(color_32));
     seek(f, entete.fileheader.bfoffbits);
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette_bmp[x].r;
         palette[x].v:=palette_bmp[x].v;
         palette[x].b:=palette_bmp[x].b;
     end;
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette[x].r shr 2;
         palette[x].v:=palette[x].v shr 2;
         palette[x].b:=palette[x].b shr 2;
     end;
     ecriture_palette(palette, 0, 256);
     for y:=entete.infoheader.biheight-1 downto 0 do begin
         if entete.infoheader.bicompression=0 then blockread(f, ligne, entete.infoheader.biwidth)
                                              else decompresse_ligne_bmp(ligne, entete.infoheader.biwidth, f);
         ecrit_ligne(ligne, entete.infoheader.biwidth, y);
     end;
end;

procedure affiche_tga_8_bits(var f : file; entete : entete_tga);
var
   x, y : word;
   ligne : tligne_8_v;
   palette_tga : tpalette_tga;
   palette : tpalette;
   nombre_de_couleurs_dans_lut : word;

begin
     init_mcga;
     nombre_de_couleurs_dans_lut:=entete.lut.longueur;
     blockread(f, palette_tga, nombre_de_couleurs_dans_lut*sizeof(tcouleurs_bmp));
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette_tga[x].r;
         palette[x].v:=palette_tga[x].v;
         palette[x].b:=palette_tga[x].b;
     end;
     for x:=0 to nombre_de_couleurs_dans_lut-1 do begin
         palette[x].r:=palette[x].r shr 2;
         palette[x].v:=palette[x].v shr 2;
         palette[x].b:=palette[x].b shr 2;
     end;
     ecriture_palette(palette, 0, 256);
     for y:=0 to entete.image.hauteur-1  do begin
         if (entete.type_image=2) or (entete.type_image=1) then blockread(f, ligne, entete.image.largeur)
(*                                              else decompresse_ligne_tga(ligne, entete.infoheader.biwidth, f)*);
         ecrit_ligne(ligne, entete.image.largeur, y);
     end;
end;

procedure affiche_bmp_24_bits(var f : file; entete : entete_bmp);
var
   x, y : word;
   ligne : tligne_24_v;
   nombre : word;
   temp : byte;
begin
     seek(f, entete.fileheader.bfoffbits);
     x:=entete.infoheader.biwidth*3;
     setmode($112);
     for y:=entete.infoheader.biheight-1 downto 0 do begin
         if entete.infoheader.bicompression=0 then blockread(f, ligne, x);
(*                                              else decompresse_ligne_bmp(ligne, x, f);*)
         for nombre:=0 to entete.infoheader.biwidth-1 do begin
             temp:=ligne[nombre].b;
             ligne[nombre].b:=ligne[nombre].r;
             ligne[nombre].r:=temp;
         end;
         ecrit_ligne_vesa_24(ligne, y, x);
          if keypressed then begin
             readkey;
             exit;
          end;
     end;
end;

procedure affiche_bmp(nom_fichier : string);
var
    f    : file;
    entete : entete_bmp;
    c : char;
begin
     assign(f, nom_fichier);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     if entete.fileheader.bftype<>19778 then begin
        close(f);
        exit;
     end;
     if entete.infoheader.biplanes<>1 then begin
        close(f);
        exit;
     end;
     if (entete.infoheader.biwidth>1280) or (entete.infoheader.biheight>1024) then begin
        close(f);
        exit;
     end;
     if (entete.infoheader.bibitcount<>8) and (entete.infoheader.bibitcount<>24) then begin
        close(f);
        exit;
     end;
     if entete.infoheader.bicompression=1 then begin
        close(f);
        exit;
     end;
     if (entete.infoheader.bibitcount=8) and ((entete.infoheader.biwidth>320) or (entete.infoheader.biheight>200)) then begin
        affiche_bmp_8_bits_vesa(f, entete);
     end;
     if (entete.infoheader.bibitcount=8) and ((entete.infoheader.biwidth<=320) or (entete.infoheader.biheight<=200)) then begin
        affiche_bmp_8_bits(f, entete);
     end;
     if entete.infoheader.bibitcount=24 then if (entete.infoheader.biwidth>640) or (entete.infoheader.biheight>480) then exit
        else begin
             affiche_bmp_24_bits(f, entete);
        end;
     close(f);
     readkey;  
end;

procedure affiche_tga_24_bits(var f : file; entete : entete_tga);
var
   ligne : tligne_24_v;
   nombre : word;
   temp : byte;
   x, y : word;
begin
     x:=entete.image.largeur*3;
     if (entete.image.largeur<321) and (entete.image.hauteur<201) then setmode($10f) else setmode($112);
     if (entete.image.description_image.plusieurs_choses and 4)=4 then begin
        for y:=entete.image.hauteur-1 downto 0 do begin
            blockread(f, ligne, x);
            ecrit_ligne_vesa_24(ligne, y, x);
            if keypressed then begin
               readkey;
               exit;
            end;
            end;
        end
        else begin
        for y:=0 to entete.image.hauteur-1 do begin
            blockread(f, ligne, x);
            ecrit_ligne_vesa_24(ligne, y, x);
            if keypressed then begin
               readkey;
               exit;
            end;
        end;
     end;
end;

procedure affiche_tga(nom_fichier : string);
var
    f    : file;
    entete : entete_tga;
    c : char;
begin
     assign(f, nom_fichier);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     if (entete.type_image<>1) and (entete.type_image<>2) and (entete.type_image<>10) then begin
        close(f);
        exit;
     end;
     if (entete.image.description_image.plusieurs_choses and 3)<>0 then begin
        close(f);
        exit;
     end;
     if (entete.image.largeur>1280) or (entete.image.hauteur>1024) then begin
        close(f);
        exit;
     end;
     if (entete.image.bits_par_pixels<>8) and (entete.image.bits_par_pixels<>24) then begin
        close(f);
        exit;
     end;
     if (entete.image.bits_par_pixels=24) and ((entete.image.largeur<641) or (entete.image.hauteur<=480)) then
        affiche_tga_24_bits(f, entete);
     if (entete.image.bits_par_pixels=8) and ((entete.image.largeur<=320) or (entete.image.hauteur<=200)) then begin
        affiche_tga_8_bits(f, entete);
     end else
     if (entete.image.bits_par_pixels=8) and ((entete.image.largeur<=1280) or (entete.image.hauteur<=1024)) then begin
        affiche_tga_8_bits_vesa(f, entete);
     end;
     close(f);
     readkey;
end;

function decompresse_ligne_pcx(var ligne : tligne_8_v; largeur : word;
         var f : file; var buffer : tbuffer; position : longint) : word;
var octet : byte;
    compteur : word;
    octet2 : byte;
    compteur2 : word;
    pos : word;
begin
     compteur:=0;
     compteur2:=0;
     pos:=0;
     while(compteur<largeur) do begin
                             octet:=buffer[pos+position];
                             inc(pos);
                             inc(compteur2);
                             if octet and $c0 = $c0 then begin
                                octet2:=octet and $3f;
                                octet:=buffer[pos+position];
                                inc(pos);
                                system.fillchar(ligne[compteur], octet2, octet);
                                inc(compteur, octet2);
                                inc(compteur2);
                             end
                             else begin
                                  ligne[compteur]:=octet;
                                  inc(compteur);
                             end;
     end;
     decompresse_ligne_pcx:=compteur2;
end;

procedure affiche_pcx_mcga(var f : file;entete : entete_pcx);
var
   ligne : tligne_8_v;
   palette : tpalette;
   octet : byte;
   largeur : word;
   position : longint;
   position2 : longint;
   taille : longint;
   pal : word;
   buffer : ^tbuffer;
   x, y : word;
begin
     if not init_mcga then exit;
     largeur:=entete.xmax-entete.xmin+1;
     new(buffer);
     position:=128;
     position2:=0;
     pal:=0;
     taille:=filesize(f);
     seek(f, filesize(f)-769);
     blockread(f, octet, 1);
     if octet=12 then begin
        blockread(f, palette, 768);
        seek(f, 128);
        for octet:=0 to 255 do begin
            palette[octet].r:=palette[octet].r shr 2;
            palette[octet].v:=palette[octet].v shr 2;
            palette[octet].b:=palette[octet].b shr 2;
        end;
        ecriture_palette(palette, 0, 256);
        pal:=768
     end;
     if position+sizeof(buffer^)<taille then blockread(f, buffer^, sizeof(buffer^))
        else blockread(f, buffer^, taille-position-pal);
(*     inc(position, sizeof(buffer));*)
     for y:=0 to entete.ymax  do begin
         if entete.compression=0 then blockread(f, ligne, largeur)
                                              else begin
(*            if position+sizeof(buffer^)<taille then blockread(f, buffer^, sizeof(buffer^))
               else blockread(f, buffer^, taille-position-pal);
            inc(position, decompresse_ligne_pcx(ligne, largeur, f, buffer^));
            seek(f, position);*)
            if position2+largeur>=maxbuffer-largeur then begin
               position2:=0;
               seek(f, position);
               if position+sizeof(buffer^)<taille then blockread(f, buffer^, sizeof(buffer^))
                else blockread(f, buffer^, taille-position-pal);
            end;
            temp:=decompresse_ligne_pcx(ligne, largeur, f, buffer^, position2);
            inc(position, temp);
            inc(position2, temp);
         end;
         ecrit_ligne(ligne, largeur, y);
     end;
     dispose(buffer);
end;

procedure affiche_pcx_vesa(var f : file;entete : entete_pcx);
var
   ligne : tligne_8_v;
   palette : tpalette;
   octet : byte;
   largeur : word;
   position : longint;
   position2 : longint;
   taille : longint;
   pal : word;
   buffer : ^tbuffer;
   x, y : word
begin
     if (entete.xmax-entete.xmin+1<=640) and (entete.ymax-entete.ymin+1<=400) then setmode($101)
        else if (entete.xmax-entete.xmin+1<=640) and (entete.ymax-entete.ymin+1<=480) then setmode($101)
             else if (entete.xmax-entete.xmin+1<=800) and (entete.ymax-entete.ymin+1<=600) then setmode($103)
                  else if (entete.xmax-entete.xmin+1<=1024) and (entete.ymax-entete.ymin+1<=768) then setmode($105)
                       else setmode($107);
     largeur:=entete.xmax-entete.xmin+1;
     new(buffer);
     position:=128;
     position2:=0;
     pal:=0;
     taille:=filesize(f);
     seek(f, filesize(f)-769);
     blockread(f, octet, 1);
     if octet=12 then begin
        blockread(f, palette, 768);
        seek(f, 128);
        for octet:=0 to 255 do begin
            palette[octet].r:=palette[octet].r shr 2;
            palette[octet].v:=palette[octet].v shr 2;
            palette[octet].b:=palette[octet].b shr 2;
        end;
        ecriture_palette(palette, 0, 256);
        pal:=768
     end;
     if position+sizeof(buffer^)<taille then blockread(f, buffer^, sizeof(buffer^))
        else blockread(f, buffer^, taille-position-pal);
     for y:=0 to entete.ymax  do begin
         if entete.compression=0 then blockread(f, ligne, largeur)
                                              else begin
(*            if position+sizeof(buffer)<taille then blockread(f, buffer, sizeof(buffer))
               else blockread(f, buffer, taille-position-pal);
            inc(position, decompresse_ligne_pcx(ligne, largeur, f, buffer, 0));
            seek(f, position);*)
            if position2+largeur>=maxbuffer-largeur then begin
               position2:=0;
               seek(f, position);
               if position+sizeof(buffer^)<taille then blockread(f, buffer^, sizeof(buffer^))
                else blockread(f, buffer^, taille-position-pal);
            end;
            temp:=decompresse_ligne_pcx(ligne, largeur, f, buffer^, position2);
            inc(position, temp);
            inc(position2, temp);
         end;
         ecrit_ligne_vesa(ligne, y, largeur);
     end;
     dispose(buffer);
end;

procedure affiche_pcx(nom_fichier : string);
var f : file;
    entete : entete_pcx;
begin
     assign(f, nom_fichier);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     if entete.version<>5 then begin
        close(f);
        exit;
     end;
     if (entete.xmax>1280) or (entete.ymax>1024) then begin
        close(f);
        exit;
     end;
     if entete.bits_par_pixels<>8 then begin
        close(f);
        exit;
     end;
     if (entete.xmax>320) or (entete.ymax>200) then affiche_pcx_vesa(f, entete)
        else affiche_pcx_mcga(f, entete);
     close(f);
     readkey;
end;

procedure affiche_gif_mcga(var f : file;entete_princ : screen_descriptor);
var palette : tpalette;
    bytebuffer : byte;
    bitsin, blocklength, num, x, y, tchar : integer;
    xstart, xend : longint;
    prefix, suffix : array[0..4096] of integer;
    pwr : array[0..8] of integer;
    outcode : array[0..1024] of integer;
    maxcodes : array[0..12] of longint;
    pwr2 : array[0..16] of longint;
    a : integer;
    totalx, totaly, bitspixel, background, jer1, jer2, red, blue, green, xlength, ystart, ylength, yend : integer;
    codesize, clearcode, eofcode, firstfree, freecode, initcodesize, maxcode, bitmask, outcount,
    code, curcode, oldcode, finchar, incode, i : integer;
    entete_sec : img_descriptor;
    codemask : array[1..8] of integer;
    ligne : tligne_8_v;
    buffer : ^tbuffer;
    compteur : word;
    taille_pal : word;

procedure ajuste_buffer;
begin
     compteur:=0;
     if filesize(f)-filepos(f)<maxbuffer then blockread(f, buffer^[0], filesize(f)-filepos(f))
     else blockread(f, buffer, maxbuffer);
end;

function gbit : integer;
begin
     inc(bitsin);
     if bitsin=9 then begin
(*        blockread(f, bytebuffer, 1);*)
        bytebuffer:=buffer^[compteur];
        inc(compteur);
        if compteur>maxbuffer then ajuste_buffer;
        tchar:=bytebuffer;
        bitsin:=1;
        inc(num);
        if (num=blocklength) then begin
           blocklength:=tchar+1;
(*           blockread(f, bytebuffer, 1);*)
           bytebuffer:=buffer^[compteur];
           inc(compteur);
           if compteur>maxbuffer then ajuste_buffer;
           tchar:=bytebuffer;
           num:=1;
        end;
     end;
     if (tchar and pwr[bitsin])=0 then gbit:=0 else gbit:=1;
end;

function readcode (codesize : integer) : integer;
var aa : integer;
    code : integer;
begin
     code:=0;
     for aa:=0 to (codesize-1) do code:=code+gbit*pwr2[aa];
     readcode:=code;
end;

procedure plot(a : integer);
var q, w, e : integer;
begin
     ligne[x]:=a;
     inc(x);
     if (x>xend) then begin
        x:=xstart;
        ecrit_ligne(ligne, entete_princ.largeur, y);
        inc(y);
     end;
end;

begin
     num:=0;
     bitspixel:=(entete_princ.mask and 7)+1;
     taille_pal:=1;
     for i:=1 to bitspixel do taille_pal:=2*taille_pal;
     taille_pal:=taille_pal*3;
     if (entete_princ.mask and 128)=128 then blockread(f, palette, taille_pal);
     blockread(f, entete_sec, sizeof(entete_sec));
     bitspixel:=(entete_princ.mask and 7)+1;
     taille_pal:=1;
     taille_pal:=taille_pal*3;
     for i:=1 to bitspixel do taille_pal:=2*taille_pal;
     if (entete_sec.mask and 128)=128 then blockread(f, palette, taille_pal);
     for i:=0 to 255 do begin
         palette[i].r:=palette[i].r shr 2;
         palette[i].v:=palette[i].v shr 2;
         palette[i].b:=palette[i].b shr 2;
     end;
(*     if (entete_princ.mask and 7)<>7 then exit;*)
(*     if (entete_princ.mask and 64)=64 then exit;*)
     pwr[1]:=1;pwr[2]:=2;pwr[3]:=4;pwr[4]:=8;pwr[5]:=16;pwr[6]:=32;pwr[7]:=64;pwr[8]:=128;

     maxcodes[0]:=4;maxcodes[1]:=8;maxcodes[2]:=16;maxcodes[3]:=$20;maxcodes[4]:=$40;maxcodes[5]:=$80;maxcodes[6]:=$100;
     maxcodes[7]:=$200;maxcodes[8]:=$400;maxcodes[9]:=$800;maxcodes[10]:=$1000;maxcodes[11]:=8192;

     codemask[1]:=1;codemask[2]:=3;codemask[3]:=7;codemask[4]:=15;codemask[5]:=32;codemask[6]:=63;codemask[7]:=127;
     codemask[8]:=255;

     pwr2[0]:=1;pwr2[1]:=2;pwr2[2]:=4;pwr2[3]:=8;pwr2[4]:=16;pwr2[5]:=32;pwr2[6]:=64;pwr2[7]:=128;pwr2[8]:=256;pwr2[9]:=512;
     pwr2[10]:=1024;pwr2[11]:=2048;pwr2[12]:=4096;pwr2[13]:=8192;pwr2[14]:=16384;

     totalx:=entete_princ.largeur;
     totaly:=entete_princ.hauteur;

(*     bitspixel:=(entete_sec.mask and 7)+1;*)
(*     bitspixel:=8;*)
     background:=entete_princ.background;

     if (entete_sec.separateur<>',') then exit;

     xstart:=entete_sec.departh;
     ystart:=entete_sec.departg;
     xlength:=entete_sec.hauteur;
     ylength:=entete_sec.largeur;

     xend:= xlength+xstart-1;
     yend:= ylength+ystart-1;

     a:=entete_sec.mask;

     if (a and 64)=64 then begin
         writeln('Image is enterlaced');
         exit;
     end;

     blockread(f, bytebuffer, 1);
     codesize:=bytebuffer;
(*     writeln(bytebuffer);
     readkey;*)
     clearcode:=pwr2[codesize];
     eofcode:=clearcode+1;
     firstfree:=clearcode+2;
     freecode:=firstfree;
     codesize:=codesize+1;
     initcodesize:=codesize;
     maxcode:=maxcodes[codesize-2];
     bitmask:=codemask[bitspixel];

     blockread(f, bytebuffer, 1);
     blocklength:=bytebuffer+1;
     bitsin:=8;
     outcount:=0;
     x:=xstart;
     y:=ystart;

     init_mcga;
     ecriture_palette(palette, 0, 256);

(*     fillchar(vram, sizeof(vram), background);*)
     asm
        mov  ax, 1001h
        mov  bx, background
        int  10h
     end;
     getmem(buffer, sizeof(buffer));
     ajuste_buffer;

     repeat
           code:=readcode(codesize);
           if code<>eofcode then begin
           if code=clearcode then begin
              codesize:=initcodesize;
              maxcode:=maxcodes[codesize-2];
              freecode:=firstfree;
              code:=readcode(codesize);
              curcode:=code;
              oldcode:=code;
              finchar:=(code and bitmask);
              plot(finchar);
           end else begin
               curcode:=code;
               incode:=code;
               if (code>=freecode) then begin
                  curcode:=oldcode;
                  outcode[outcount]:=finchar;
                  inc(outcount);
               end;
               if (curcode>bitmask) then
                  repeat
                        outcode[outcount]:=suffix[curcode];
                        inc(outcount);
                        curcode:=prefix[curcode];
                  until (curcode<=bitmask);
               finchar:=(curcode and bitmask);
               outcode[outcount]:=finchar;
               inc(outcount);
               for i:=(outcount - 1) downto 0 do plot(outcode[i]);

               outcount:=0;
               prefix[freecode]:=oldcode;
               suffix[freecode]:=finchar;
               oldcode:=incode;
               inc(freecode);
               if (freecode>=maxcode) then if (codesize<12) then begin
                  inc(codesize);
                  maxcode:=maxcode*2;
               end;
           end;
     end;
     until (code=EOFCODE) or keypressed;
     readkey;
end;

procedure affiche_gif_vesa(var f : file;entete_princ : screen_descriptor);
var palette : tpalette;
    bytebuffer : byte;
    bitsin, blocklength, num, x, y, tchar : integer;
    xstart, xend : longint;
    prefix, suffix : array[0..4096] of integer;
    pwr : array[0..8] of integer;
    outcode : array[0..1024] of integer;
    maxcodes : array[0..12] of longint;
    pwr2 : array[0..16] of longint;
    a : integer;
    totalx, totaly, bitspixel, background, jer1, jer2, red, blue, green, xlength, ystart, ylength, yend : integer;
    codesize, clearcode, eofcode, firstfree, freecode, initcodesize, maxcode, bitmask, outcount,
    code, curcode, oldcode, finchar, incode, i : integer;
    entete_sec : img_descriptor;
    codemask : array[1..8] of integer;
    ligne : tligne_8_v;
    buffer : ^tbuffer;
    compteur : word;
    taille_pal : word;

procedure ajuste_buffer;
begin
     compteur:=0;
     if filesize(f)-filepos(f)<60000 then blockread(f, buffer^[0], filesize(f)-filepos(f))
     else blockread(f, buffer^, 60000);
end;

function gbit : integer;
begin
     inc(bitsin);
     if bitsin=9 then begin
(*        blockread(f, bytebuffer, 1);*)
        bytebuffer:=buffer^[compteur];
        inc(compteur);
        if compteur>59999 then ajuste_buffer;
        tchar:=bytebuffer;
        bitsin:=1;
        inc(num);
        if (num=blocklength) then begin
           blocklength:=tchar+1;
(*           blockread(f, bytebuffer, 1);*)
           bytebuffer:=buffer^[compteur];
           inc(compteur);
           if compteur>59999 then ajuste_buffer;
           tchar:=bytebuffer;
           num:=1;
        end;
     end;
     if (tchar and pwr[bitsin])=0 then gbit:=0 else gbit:=1;
end;

function readcode (codesize : integer) : integer;
var aa : integer;
    code : integer;
begin
     code:=0;
     for aa:=0 to (codesize-1) do code:=code+gbit*pwr2[aa];
     readcode:=code;
end;

procedure plot(a : integer);
var q, w, e : integer;
begin
     ligne[x]:=a;
     inc(x);
     if (x>xend) then begin
        x:=xstart;
        ecrit_ligne_vesa(ligne, y, entete_princ.largeur);
        inc(y);
        if keypressed then code:=EOFCODE;
     end;
end;

begin
     num:=0;
     bitspixel:=(entete_princ.mask and 7)+1;
     taille_pal:=1;
     for i:=1 to bitspixel do taille_pal:=2*taille_pal;
     taille_pal:=taille_pal*3;
     if (entete_princ.mask and 128)=128 then blockread(f, palette, taille_pal);
     blockread(f, entete_sec, sizeof(entete_sec));
     bitspixel:=(entete_princ.mask and 7)+1;
     taille_pal:=1;
     taille_pal:=taille_pal*3;
     for i:=1 to bitspixel do taille_pal:=2*taille_pal;
     if (entete_sec.mask and 128)=128 then blockread(f, palette, taille_pal);
     for i:=0 to 255 do begin
         palette[i].r:=palette[i].r shr 2;
         palette[i].v:=palette[i].v shr 2;
         palette[i].b:=palette[i].b shr 2;
     end;
(*     if (entete_princ.mask and 7)<>7 then exit;*)
(*     if (entete_princ.mask and 64)=64 then exit;*)
     pwr[1]:=1;pwr[2]:=2;pwr[3]:=4;pwr[4]:=8;pwr[5]:=16;pwr[6]:=32;pwr[7]:=64;pwr[8]:=128;

     maxcodes[0]:=4;maxcodes[1]:=8;maxcodes[2]:=16;maxcodes[3]:=$20;maxcodes[4]:=$40;maxcodes[5]:=$80;maxcodes[6]:=$100;
     maxcodes[7]:=$200;maxcodes[8]:=$400;maxcodes[9]:=$800;maxcodes[10]:=$1000;maxcodes[11]:=8192;

     codemask[1]:=1;codemask[2]:=3;codemask[3]:=7;codemask[4]:=15;codemask[5]:=32;codemask[6]:=63;codemask[7]:=127;
     codemask[8]:=255;

     pwr2[0]:=1;pwr2[1]:=2;pwr2[2]:=4;pwr2[3]:=8;pwr2[4]:=16;pwr2[5]:=32;pwr2[6]:=64;pwr2[7]:=128;pwr2[8]:=256;pwr2[9]:=512;
     pwr2[10]:=1024;pwr2[11]:=2048;pwr2[12]:=4096;pwr2[13]:=8192;pwr2[14]:=16384;

     totalx:=entete_princ.largeur;
     totaly:=entete_princ.hauteur;

(*     bitspixel:=(entete_sec.mask and 7)+1;*)
(*     bitspixel:=8;*)
     background:=entete_princ.background;

     if (entete_sec.separateur<>',') then exit;

     xstart:=entete_sec.departh;
     ystart:=entete_sec.departg;
     xlength:=entete_sec.hauteur;
     ylength:=entete_sec.largeur;

     xend:= xlength+xstart-1;
     yend:= ylength+ystart-1;

     a:=entete_sec.mask;

     if (a and 64)=64 then begin
         writeln('Image is enterlaced');
         readkey;
         exit;
     end;

     blockread(f, bytebuffer, 1);
     codesize:=bytebuffer;
(*     writeln(bytebuffer);
     readkey;*)
     clearcode:=pwr2[codesize];
     eofcode:=clearcode+1;
     firstfree:=clearcode+2;
     freecode:=firstfree;
     codesize:=codesize+1;
     initcodesize:=codesize;
     maxcode:=maxcodes[codesize-2];
     bitmask:=codemask[bitspixel];

     blockread(f, bytebuffer, 1);
     blocklength:=bytebuffer+1;
     bitsin:=8;
     outcount:=0;
     x:=xstart;
     y:=ystart;

     if (entete_princ.largeur<=640) and (entete_princ.hauteur<=480) then setmode($101)
        else if (entete_princ.largeur<=800) and (entete_princ.hauteur<=600) then setmode($103)
             else if (entete_princ.largeur<=1024) and (entete_princ.hauteur<=768) then setmode($105)
                  else setmode($107);

     ecriture_palette(palette, 0, 256);

(*     fillchar(vram, sizeof(vram), background);*)
     asm
        mov  ax, 1001h
        mov  bx, background
        int  10h
     end;
     getmem(buffer, sizeof(buffer));
     ajuste_buffer;

     repeat
           code:=readcode(codesize);
           if code<>eofcode then begin
           if code=clearcode then begin
              codesize:=initcodesize;
              maxcode:=maxcodes[codesize-2];
              freecode:=firstfree;
              code:=readcode(codesize);
              curcode:=code;
              oldcode:=code;
              finchar:=(code and bitmask);
              plot(finchar);
           end else begin
               curcode:=code;
               incode:=code;
               if (code>=freecode) then begin
                  curcode:=oldcode;
                  outcode[outcount]:=finchar;
                  inc(outcount);
               end;
               if (curcode>bitmask) then
                  repeat
                        outcode[outcount]:=suffix[curcode];
                        inc(outcount);
                        curcode:=prefix[curcode];
                  until (curcode<=bitmask);
               finchar:=(curcode and bitmask);
               outcode[outcount]:=finchar;
               inc(outcount);
               for i:=(outcount - 1) downto 0 do plot(outcode[i]);

               outcount:=0;
               prefix[freecode]:=oldcode;
               suffix[freecode]:=finchar;
               oldcode:=incode;
               inc(freecode);
               if (freecode>=maxcode) then if (codesize<12) then begin
                  inc(codesize);
                  maxcode:=maxcode*2;
               end;
           end;
     end;
     until (code=EOFCODE);
     readkey;
end;

procedure affiche_gif(nom_fic : string);
var entete : screen_descriptor;
    f : file;
begin
     assign(f, nom_fic);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     if entete.signature<>'GIF87a' then begin
        writeln('Erreur de fichier');
        exit;
     end;
     if (entete.largeur>1024) or (entete.hauteur>768) then begin
        writeln('Fichier trop grand');
        writeln(entete.largeur, '    ', entete.hauteur);
        readkey;
        exit;
     end;
(*     if (entete.mask and 7)+1<>8 then begin
        writeln('Mauvais nombre de couleurs');
        exit;
     end;*)
     if (entete.hauteur<=200) and (entete.largeur<=320) then affiche_gif_mcga(f, entete)
        else affiche_gif_vesa(f, entete);
     close(f);
end;

procedure info_tga(nom_fichier : string);
const tab : array[0.. 1]of string[3] = ('OUI', 'NON');
var f : file;
    entete : entete_tga;
begin
     assign(f, nom_fichier);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     clrscr;
     gotoxy(1, 1);
     writeln('type image : ', entete.type_image);
     writeln('largeur : ', entete.image.largeur);
     writeln('hauteur : ', entete.image.hauteur);
     writeln('bits par pixels : ',entete.image.bits_par_pixels);
     writeln('lut : ', tab[entete.presence_lut]);
     writeln('taille normal : ', trunc(1.0*entete.image.largeur*entete.image.hauteur*entete.image.bits_par_pixels / 8));
     writeln('taille du fichier : ', filesize(f));
     readkey;
     close(f);
     initialise_ecran;
     affiche_repertoires;
     affiche_curseur(curseurx, curseury);
     gotoxy(curseurx, curseury);
end;

procedure info_bmp(nom_fic : string);
const tab : array[0.. 1]of string[3] = ('OUI', 'NON');
var f : file;
    entete : entete_bmp;
begin
     assign(f, nom_fic);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     clrscr;
     gotoxy(1, 1);
     writeln('largeur : ', entete.infoheader.biwidth);
     writeln('hauteur : ', entete.infoheader.biheight);
     writeln('bits par pixels : ',entete.infoheader.bibitcount);
     writeln('lut : ', tab[byte(entete.infoheader.bibitcount=24)]);
     writeln('taille normal : ', entete.infoheader.biwidth*entete.infoheader.biheight*entete.infoheader.bibitcount div 8);
     writeln('taille du fichier : ', entete.fileheader.bfsize);
     readkey;
     close(f);
     initialise_ecran;
     affiche_repertoires;
     affiche_curseur(curseurx, curseury);
     gotoxy(curseurx, curseury);
end;

procedure info_gif(nom_fic : string);
const tab : array[0..1] of string[3]=('OUI', 'NON');
var f : file;
    octet : byte;
    temp : word;
    entete1 : screen_descriptor;
    entete2 : img_descriptor;
begin
     assign(f, nom_fic);
     reset(f, 1);
     blockread(f, entete1, sizeof(entete1));
     if (entete1.mask and 128)=128 then seek(f, 768+filepos(f));
     blockread(f, octet, sizeof(octet));
     while octet<>$2c do
                             blockread(f, octet, sizeof(octet));
     blockread(f, entete2, sizeof(entete2));
     clrscr;
     gotoxy(1, 1);
(*     if entete2.largeur<entete1.largeur then temp:=entete1.largeur else temp:=entete2.largeur;*)
     writeln('version : ', entete1.signature);
     temp:=entete1.largeur;
     writeln('largeur : ', temp);
(*     if entete2.hauteur<entete1.largeur then temp:=entete1.hauteur else temp:=entete2.hauteur;*)
     temp:=entete1.hauteur;
     writeln('hauteur : ', temp);
     writeln('bits par pixels : ',(entete1.mask and 7 ) +1);
     writeln('lut : ', tab[(byte((entete1.mask and 128) or (entete2.mask and 128)) shr 7) xor 1]);
     writeln('taille normal : ', trunc(1.0*entete1.largeur*entete1.hauteur*((entete1.mask and 7)+1)/8));
     writeln('taille du fichier : ', filesize(f));
     readkey;
     close(f);
     initialise_ecran;
     affiche_repertoires;
     affiche_curseur(curseurx, curseury);
     gotoxy(curseurx, curseury);
end;

procedure info_pcx(nom_fic : string);
const tab : array[0..1] of string[3]=('OUI', 'NON');
var f : file;
    temp : word;
    entete : entete_pcx;
begin
     assign(f, nom_fic);
     reset(f, 1);
     blockread(f, entete, sizeof(entete));
     clrscr;
     gotoxy(1, 1);
     writeln('largeur : ', entete.xmax-entete.xmin+1);
     writeln('hauteur : ', entete.ymax-entete.ymin+1);
     writeln('bits par pixels : ', entete.bits_par_pixels);
(*     writeln('lut : ', tab[(byte((entete1.plusieurs_choses and 128) or (entete2.plusieurs_choses and 128)) shr 7) xor 1]);*)
     writeln('compression : ',  tab[entete.compression xor 1]);
     writeln('nombre de plans : ', entete.plane);
     writeln('taille normal : ', trunc(1.0*(entete.xmax-entete.xmin+1)*(entete.ymax-entete.ymin+1)*entete.bits_par_pixels/8));
     writeln('taille du fichier : ', filesize(f));
     readkey;
     close(f);
     initialise_ecran;
     affiche_repertoires;
     affiche_curseur(curseurx, curseury);
     gotoxy(curseurx, curseury);
end;

function est_appuye : byte;
begin
asm
   mov  ax, 0003h
   int  33h
   push bx
   mov  ax, 0005h
   xor  bx, bx
   int  33h
   mov  ax, 0005h
   mov  bx, 0001h
   int  33h
   pop  bx
   mov  @result, bl
end;
end;

procedure lit_position;assembler;
asm
   mov  ax, 0003h
   int  33h
   mov  ax, cx
   mov  cl, 3
   shr  ax, cl
   shr  dx, cl
   mov  curseurx, al
   mov  curseury, dl
end;

procedure cache_souris;assembler;
asm
   mov  ax, 0002h
   int  33h
end;

procedure montre_souris;assembler;
asm
   mov  ax, 0001h
   int  33h
end;

function init_souris : boolean;
begin
asm
   mov  ax, 0000h
   int  33h
   and  ax, ax
   jz   @prb
   mov  ax, 0001h
   int  33h
   mov  ax, 0008h
   mov  cx, 0008h
   mov  dx, 00b8h
   int  33h
   mov  ax, 0ah
   mov  bx, 00
   mov  cx, 0ffffh
   mov  dx, 01100h
   int  33h
   mov  al, 01h
   jmp  @fin
 @prb:
   xor  al, al
 @fin:
   mov  @result, al
end;
end;

begin
     page_active:=0;
     initialise_ecran;
     presence_souris:=init_souris;
     videstructure(repertoire);
     trouve_repertoires;
     time:=start_timer;
     classe;
     time:=elap_time(time);
     if presence_souris then cache_souris;
     affiche_repertoires;
     curseurx:=1;
     curseury:=2;
     affiche_curseur ( curseurx, curseury );
     if presence_souris then montre_souris;
     touche:=#0;
     etat:=0;
     repeat
           if presence_souris then etat:=est_appuye;
           if keypressed then begin
           touche:=readkey;
           efface_curseur( curseurx, curseury );
           case ( ord ( upcase ( touche ) ) ) of
                13 : begin
                          numero_entree:= (curseurx div 13 )*23 + curseury-1 + nb_par_page*page_active;
                          if repertoire[ numero_entree ].repertoire then begin
                             chdir(repertoire[ numero_entree ].nom);
                             if presence_souris then cache_souris;
                             clrscr;
                             initialise_ecran;
                             videstructure(repertoire);
                             trouve_repertoires;
                             classe;
                             affiche_repertoires;
                             if presence_souris then montre_souris;
                             curseurx:=1;
                             curseury:=2;
                          end
                          else begin
                             if presence_souris then cache_souris;
                          if repertoire[ numero_entree ].type_fichier = 1 then affiche_bmp ( repertoire[ numero_entree ].nom )
                     else if repertoire[ numero_entree ].type_fichier = 2 then affiche_tga ( repertoire[ numero_entree ].nom )
                    else if repertoire[ numero_entree ].type_fichier = gif then affiche_gif ( repertoire[ numero_entree ].nom )
                                 else affiche_pcx(repertoire[ numero_entree ].nom);
                             initialise_ecran;
                             affiche_repertoires;
                             if presence_souris then montre_souris;
                          end;
                     end;
                10 : begin
                          numero_entree:=(curseurx div 13)*23 + curseury-1+nb_par_page*page_active;
                          if presence_souris then cache_souris;
                          if not repertoire[numero_entree].repertoire then begin
                             if repertoire[numero_entree].type_fichier=bmp then info_bmp(repertoire[numero_entree].nom)
                                else if repertoire[numero_entree].type_fichier=tga then info_tga(repertoire[numero_entree].nom)
                                else if repertoire[numero_entree].type_fichier=gif then info_gif(repertoire[numero_entree].nom)
                                          else info_pcx(repertoire[numero_entree].nom);
                          end;
                          if presence_souris then montre_souris;
                     end;
                65..90 : begin
                              {$I-}
                              getdir ( 0 , lecteur );
                              chdir ( touche + ':' + '\');
                              if ioresult<>0 then chdir ( lecteur )
                                             else begin
                                                       if presence_souris then cache_souris;
                                                       initialise_ecran;
                                                       videstructure(repertoire);
                                                       trouve_repertoires;
                                                       classe;
                                                       affiche_repertoires;
                                                       curseurx:=1;
                                                       curseury:=2;
                                                       if presence_souris then montre_souris;
                                                   end;
                              {$I+}
                         end;
                0  : begin
                          touche:=readkey;
                          if presence_souris then cache_souris;
                          case ord ( touche ) of
                               72 : if curseury>1 then dec ( curseury ) else if curseurx>13 then begin
                                                  curseury:=23;
                                                  dec( curseurx, 13 );
                                    end;
                               75 : if curseurx>13 then dec ( curseurx, 13 );
                               77 : if curseurx<65 then inc ( curseurx, 13 );
                               80 : if curseury<23 then inc ( curseury ) else if curseurx<65 then begin
                                                   curseury:=1;
                                                   inc( curseurx, 13 );
                                    end;
                               73 : change_page_active ( page_active-1 );
                               81 : change_page_active ( page_active+1 );
                               71 : begin
                                         curseurx:=1;
                                         curseury:=2;
                                    end;
                               79 : begin
                                         if compteur>=nb_par_page * page_active+(nb_par_page-1) then begin
                                            curseurx:=66;
                                            curseury:=23;
                                         end else begin
                                             curseurx:=((compteur-(nb_par_page * page_active)) div 23) * 13+1;
                                             curseury:=(compteur-(nb_par_page * page_active)) mod 23;
                                         end;
                                    end;
                          end;
                          if presence_souris then montre_souris;
                     end;
           end;
           if presence_souris then cache_souris;
           affiche_curseur( curseurx, curseury );
           if presence_souris then montre_souris;
           end else if etat<>0 then begin
               lit_position;
               case etat of
                    1 : begin
                             lit_position;
                             curseurx:=curseurx div 13 *13+1;
                             if presence_souris then cache_souris;
                             affiche_curseur( curseurx, curseury );
                             if presence_souris then montre_souris;
                        end;
                    2 : begin
                             numero_entree:= (curseurx div 13 )*23 + curseury-1 + nb_par_page*page_active;
                             curseurx:=curseurx div 13 *13+1;
                             if repertoire[ numero_entree ].repertoire then begin
                                chdir(repertoire[ numero_entree ].nom);
                                clrscr;
                                cache_souris;
                                initialise_ecran;
                                videstructure(repertoire);
                                trouve_repertoires;
                                classe;
                                affiche_repertoires;
                                curseurx:=1;
                                curseury:=2;
                                affiche_curseur( curseurx, curseury );
                                montre_souris;
                             end
                             else begin
                                  if repertoire[ numero_entree ].type_fichier = 1 then
                                                                       affiche_bmp ( repertoire[ numero_entree ].nom )
                                     else if repertoire[ numero_entree ].type_fichier = 2 then
                                                                       affiche_tga ( repertoire[ numero_entree ].nom )
                                          else affiche_pcx(repertoire[ numero_entree ].nom);
                                  cache_souris;
                                  initialise_ecran;
                                  affiche_repertoires;
                                  affiche_curseur( curseurx, curseury );
                                  montre_souris;
                             end;
                        end;

               end;
           end;
     until touche=#27;
     textmode ( co80 );
     writeln('Nota : GIF (Graphics Interchange Format) est une marque deposee de Compuserve, Inc.');
     writeln('Tous droits r?serv?s');
end.

(* Now the unit usgvesa which allows you to use SVGA*)

unit usgvesa;
interface
uses dos;
type
              vesainfo1= record
                               signature                                 : array[1..4] of byte;
                               versionhi, versionlo                      : byte;
                               fabricant                                 : pointer;
                               unused                                    : longint;
                               codes                                     : pointer;
                               bidon                                     : array [1..238] of byte;
                         end;
              vesainfo2= record
                               f_mode                                    : word;
                               f_page                                    : array[0..1] of byte;
                               granularite, wsize                        : word;
                               wseg                                      : array[0..1] of word;
                               setpage                                   : pointer;
                               linesize, resx, resy                      : word;
                               matricex, matricey, bitplans, bitperpixel : byte;
                               memblocks, memmodel, blocksize            : byte;
                         end;
    t_palette = record
                      r, v, b : byte;
                end;
    tligne_8_v   = array[0..1023] of byte;
    tligne_24_v  = array[0..639] of t_palette;
    tpalette = array[0..255] of t_palette;

var longueur_ligne    : word;
    taille_fenetre    : word;
    position_dans_RAM : longint;
    mode_actuel       : word;
    vesa1             : vesainfo1;
    vesa2             : vesainfo2;
    taby              : array[0..1025] of longint;
    tabx              : array[0..639] of word;
    temp : longint;
    temp2 : word;

function setmode(m : word) : boolean;
procedure ecriture_palette(var palette;debut, quantite:word);
procedure ecrit_ligne_vesa(ligne : tligne_8_v;ordonnee : word;nombre : longint);
procedure lit_ligne_vesa(var ligne : tligne_8_v;ordonnee : word;nombre : longint);
procedure ecrit_ligne_vesa_24(ligne : tligne_24_v;ordonnee : word;nombre : longint);
procedure getpalette(var p : tpalette);

implementation

var granularite  : word;

procedure getpalette(var p : tpalette);
var regs : registers;
begin
     with regs do begin
          ax:=$1017;
          es:=seg(p);
          dx:=ofs(p);
          cx:=256;
          bx:=0;
          intr($10, regs);
     end;
end;

function nombrey : word;
begin
     nombrey:=vesa2.resy;
end;

function linelen : word;
begin
     linelen:=vesa2.resx;
end;

function windowsize : longint;
begin
     windowsize:=vesa2.wsize;
end;

function setmode(m : word) : boolean;
var i : longint;
    regs : registers;
begin
     position_dans_ram:=0;
     with regs do begin
          ax:=$4f02;
          bx:=m;
     end;
     intr($10, regs);
     if regs.ax<>$004f then begin
        setmode:=false;
        mode_actuel:=0;
        exit;
     end;
     mode_actuel:=m;
     with regs do begin
          ax:=$4f00;
          cx:=m;
          es:=seg(vesa1);
          di:=ofs(vesa1);
     end;
     intr($10, regs);
     with regs do begin
          ax:=$4f01;
          cx:=m;
          es:=seg(vesa2);
          di:=ofs(vesa2);
     end;
     intr($10, regs);
     longueur_ligne:=linelen;
     if vesa2.bitperpixel=24 then longueur_ligne:=longueur_ligne*3;
     for i:=0 to nombrey do taby[i]:=i*longueur_ligne;
     for i:=0 to 639 do tabx[i]:=i*3;
     taille_fenetre:=word((windowsize * 1024)-1);
     temp:=longint(vesa2.granularite)*1024;
     temp2:=16;
     while (temp shr temp2)=0 do dec(temp2);
     granularite:=temp2;
     position_dans_ram:=0;
end;

function dans_fenetre(x, y : word) : boolean;
begin
     temp:=longint(longint(taby[y])) + x;
     if(temp>=position_dans_ram) and (temp<(position_dans_ram+65536)) then dans_fenetre:=true
                                                      else dans_fenetre:=false;
end;

procedure setpage(granul : word);assembler;
asm
   mov  ax, 4f05h
   xor  bx, bx
   mov  dx, granul
   int  10h
end;

procedure centrewindow(f : byte;x, y : integer);
begin
        temp:=longint(longint(taby[y])+x) shr granularite;
        position_dans_ram:=temp shl granularite;
        setpage(temp);
end;

(*$f+*)
(*$l usgvesa.obj*)
procedure movea(var source, dest;taille : word);external;
procedure ecrit_ligne_vesa(ligne : tligne_8_v;ordonnee : word; nombre : longint);
var reste, temporaire : longint;
begin
     if ((dans_fenetre(0, ordonnee))) and (not(dans_fenetre(nombre-1, ordonnee))) then begin
        temporaire:=65536-(longint(longint(taby[ordonnee]))-position_dans_ram);
        movea(ligne, mem[$a000:(longint(taby[ordonnee]))-position_dans_ram], temporaire);
        reste:=nombre-temporaire;
        temp:=longint(longint(taby[ordonnee+1])) shr granularite;
        position_dans_ram:=temp shl granularite;
        setpage(temp);
        movea(ligne[temporaire], mem[$a000:0], reste);
     end else begin
         if (not dans_fenetre(0, ordonnee)) or (not dans_fenetre(nombre-1, ordonnee)) then begin
            temp:=longint(longint(taby[ordonnee])) shr granularite;
            position_dans_ram:=temp shl granularite;
            setpage(temp);
         end;
         temp:=taby[ordonnee]-position_dans_ram;
         movea(ligne, mem[$a000:(*taby[ordonnee]-position_dans_ram*)temp], nombre);
     end;
end;

procedure ecrit_ligne_vesa_24(ligne : tligne_24_v;ordonnee : word; nombre : longint);
var reste, temporaire : longint;
begin
     if ((dans_fenetre(0, ordonnee))) and (not(dans_fenetre(nombre-1, ordonnee))) then begin
        temporaire:=65536-(longint(longint(taby[ordonnee]))-position_dans_ram);
        movea(ligne, mem[$a000:(longint(taby[ordonnee]))-position_dans_ram], temporaire);
        reste:=nombre-temporaire;
        temp:=longint(longint(taby[ordonnee+1])) shr granularite;
        position_dans_ram:=temp shl granularite;
        setpage(temp);
        movea(ligne[temporaire div 3], mem[$a000:0], reste);
     end else begin
         if (not dans_fenetre(0, ordonnee)) or (not dans_fenetre(nombre-1, ordonnee)) then begin
            temp:=longint(longint(taby[ordonnee])) shr granularite;
            position_dans_ram:=temp shl granularite;
            setpage(temp);
         end;
         temp:=taby[ordonnee]-position_dans_ram;
         movea(ligne, mem[$a000:(*taby[ordonnee]-position_dans_ram*)temp], nombre);
     end;
end;
(*$f-*)

procedure lit_ligne_vesa(var ligne : tligne_8_v;ordonnee : word;nombre : longint);
var reste, temporaire : longint;
begin
     if ((dans_fenetre(0, ordonnee))) and (not(dans_fenetre(nombre-1, ordonnee))) then begin
        temporaire:=65536-(longint(longint(taby[ordonnee]))-position_dans_ram);
        movea(mem[$a000:(longint(taby[ordonnee]))-position_dans_ram], ligne, temporaire);
        reste:=nombre-temporaire;
        temp:=longint(longint(taby[ordonnee+1])) shr granularite;
        position_dans_ram:=temp shl granularite;
        setpage(temp);
        movea(mem[$a000:0], ligne[temporaire], reste);
     end else begin
         if (not dans_fenetre(0, ordonnee)) or (not dans_fenetre(nombre-1, ordonnee)) then begin
            temp:=longint(longint(taby[ordonnee])) shr granularite;
            position_dans_ram:=temp shl granularite;
            setpage(temp);
         end;
         temp:=taby[ordonnee]-position_dans_ram;
         movea(mem[$a000:temp], ligne, nombre);
     end;
end;

procedure ecriture_palette(var palette;debut, quantite:word);assembLer;
asm
    push ds
    lds  si, palette
    mov  dx, 3c8h
    cld
    mov  cx, quantite
    mov  bx, debut
   @deb1:
    mov  al, bl
    out  dx, al
    inc  dx
    lodsb
    out  dx, al
    lodsb
    out  dx, al
    lodsb
    out  dx, al
    dec  dx
    inc  bl
    loop @deb1
    pop  ds
end;

begin
end.

(* Now, the usgvesa.asm file that provide a 386 enhanced version of move,
called movea. Can be remove by replacing all movea reference in usgvesa by
system move*)

        .model tpascal
        .386
        .data
big_tab struc
  tab dd 1024 dup (?)
ends
extrn position_dans_ram : dword
extrn taille_fenetre : word
extrn taby  : big_tab
extrn centrewindow : proc
data ends
        .code
public movea

movea   proc far
arg     source : dword, dest : dword, taille : word
        mov  bx, ds
        mov  cx, taille
        or   cx, cx
        jz   short fin
        lds  si, source
        les  di, dest
        mov  dx, cx
        shr  cx, 1
        shr  cx, 1
        rep  movsd
        test dl, 10b
        jnz  short deux
  suite:
        and  dl, 1b
        jnz  short un
  fin:
        mov  ds, bx
        ret
  deux:
        movsw
        jmp  short suite
  un:
        movsb
        mov  ds, bx
        ret
movea   endp

code ends
        end

(*Now the umcga unit, which allows you to use mcga mode*)

unit umcga;

interface
uses usgvesa;
type
    t_ligne = array[0..319] of byte;

  function init_mcga : boolean;
  procedure ecrit_ligne(ligne : tligne_8_v; longueur : word; ordonnee : byte);
  procedure lit_ligne_mcga(var ligne : tligne_8_v;ordonee : word;nombre : longint);

implementation
var
   erreur : word;
   taby : array[0..199] of word;

function init_mcga : boolean;
var i : word;

function active:boolean;
begin
  asm
    xor  ah, ah
    mov  al, 13h
    int  10h
    mov  ah, 0fh
    int  10h
    cmp  al, 13h
    je   @ok
    xor  al, al
    jmp  @fin
   @ok:
    mov  al, 1
   @fin:
    mov  @result, al
  end;
end;
begin
     if not active then begin
                             init_mcga:=false;
                             writeln('pas de modes mcga!!!');
                        end
                    else begin
                              for i:=0 to 199 do taby[i]:=i*320;
                              init_mcga:=true;
                         end;
end;

procedure ecrit_ligne(ligne : tligne_8_v; longueur : word; ordonnee : byte);
begin
     move ( ligne, mem[$a000:taby[ordonnee]], longueur);
end;

procedure lit_ligne_mcga(var ligne : tligne_8_v;ordonee : word;nombre : longint);
begin
     move(mem[$a000:ordonee*320], ligne, nombre);
end;

begin
end.