HPAVC/HPAVC CD-ROM.iso/pc/CONTRSRC.ZIP/SRC/SETUP/WIN.PAS

Pascal/Delphi Source File | 1994-09-29 | 50.4 KB | 1,082 lines

{**************************************************************************
*  W I N : une unité de routines permettant l'accès direct à la mémoire   *
*          vidéo et la gestion de fenêtres                                *
**-----------------------------------------------------------------------**
*  Auteur           : MICHAEL TISCHER                                     *
*  Développé le     : 17.03.1989                                          *
*  Dernière MAJ     : 21.09.1989                                          *
**************************************************************************}

unit Win;

interface
uses Dos, Crt;      { Inclusion des unités nécessaires }

{-- Déclaration des fonctions et procédures susceptibles d'être  ---------}
{-- appelées par un autre programme                                 ------}

function  VG            ( Offset : integer ) : byte;
function  VD            ( Offset : integer ) : byte;
function  VH            ( Offset : integer ) : byte;
function  VB            ( Offset : integer ) : byte;
function  WinOpen       ( x1, y1, x2, y2 : byte ) : integer;
function  WinOpenShadow ( x1, y1, x2, y2 : byte ) : integer;
function  WinInFront    ( Key : integer ) : boolean;
function  WhereX        : integer;
function  WhereY        : integer;
function  WinGetChar    ( Colonne, Ligne : byte ) : char;
function  WinGetCol     ( Colonne, Ligne : byte ) : byte;
procedure WinWrite2View ( Doit : boolean );
procedure WinPutChar    ( Colonne, Ligne : byte; Caractere : char;
                          Couleur : byte );
procedure WinSetCursor  ( Colonne, Ligne : byte );
procedure WinDefCursor  ( Debut, Fin : byte );
procedure WinHideCursor;
procedure WinBlockCursor;
procedure WinLineCursor;
procedure WinSetView    ( x1, y1, x2, y2 : byte);
procedure WinGetView    ( var x1, y1, x2, y2 : byte );
procedure GotoXY        ( X, Y : integer );
procedure TextColor     ( Color : byte );
procedure TextBackground( Color : byte );
procedure ClrScr;
procedure WinClose      ( ReDraw : boolean );
procedure WinPrint      ( Colonne, Ligne, Couleur : byte; Sortie : string );
procedure WinFill       ( x1, y1, x2, y2 : byte; Caractere : char;
                          Couleur : byte );
function  WinStRep      ( Caractere : char; Nombre : byte ) : string;
procedure WinFrame      ( x1, y1, x2, y2, Cadre, Couleur : byte );
procedure WinScrollDown ( x1, y1, x2, y2, Nombre, Couleur : byte );
procedure WinScrollUp   ( x1, y1, x2, y2, Nombre, Couleur : byte );
procedure WinScrollLeft ( x1, y1, x2, y2, Nombre, Couleur : byte );
procedure WinScrollRight( x1, y1, x2, y2, Nombre, Couleur : byte );
procedure WinMoveUp     ( Nombre : byte );
procedure WinMoveDown   ( Nombre : byte );
procedure WinMoveRight  ( Nombre : byte );
procedure WinMoveLeft   ( Nombre : byte );
procedure WinMove       ( x, y : byte );
procedure WinColor      ( x1, y1, x2, y2, Couleur : byte );

{-- Constantes publiques  ------------------------------------------------}

const {-- les constantes suivantes représentent le contenu de VioCarte -}

      MDA       = 0;           {  MDA und HGC   }
      CGA       = 1;
      EGA       = 2;
      EGA_MONO  = 3;           { EGA avec moniteur MDA }
      VGA       = 4;
      VGA_MONO  = 5;           { VGA avec moniteur analogique monochr. }
      MCGA      = 6;
      MCGA_MONO = 7;           { MCGA avec moniteur analogique monochr.}

      {-- Constantes pour la procédure WinFrame ---------}

      CAD_SIM    = 1;    { Cadre simple  }
      CAD_DOU    = 2;    { Cadre double  }
      CAD_POI    = 3;    { Cadre pointillé }
      CAD_PLE    = 4;    { Cadre plein }

      NO_CLEAR     = 255;  { pour les procédures WinScroll }
      WinOpenError = -1;   { Fenêtre impossible à ouvrir }
      MAX_COLS     = 132;  { Certaines cartes VGA supportent 132 colonnes }

      {-- Couleurs ----------------------------------------------------}

      NOIR        =  0;
      BLEU        =  1;
      VERT        =  2;
      CYAN        =  3;
      ROUGE       =  4;
      MAGENTA     =  5;
      BRUN        =  6;
      GRISCLAIR   =  7;
      GRISFONCE   =  8;
      BLEUCLAIR   =  9;
      VERTCLAIR   = 10;
      CYANCLAIR   = 11;
      ROUGECLAIR  = 12;
      MAGENTACLAIR= 13;
      JAUNE       = 14;
      BLANC       = 15;

{-- Variables globales également accessibles à d'autres programmes -----}

var Color : boolean;  { TRUE pour les cartes couleur }
    VioCarte,         { Code décrivant la carte vidéo }
    NbLig,           { Nombre de lignes d'écran }
    NbCol    : byte;  { Nombre de colonnes d'écran }

{-- Constantes typées, publiques -------------------------------------}

const Write2View : boolean = TRUE;  { Pour que Writeln tienne compte des }
                                    { limites de la zone de visualisation }
      ShadowX    : byte = 2;        { Largeur d'une ombre en colonnes }
      ShadowY    : byte = 1;        { Profondeur d'une ombre en lignes}

implementation

{-- Constantes internes au module ----------------------------------------}

const {-- Attribut de la fenêtre------------------------------------------}

      WIN_OMBRE = 1;       { Bit 0: La fenêtre n'a pas d'ombre }

{-- Déclarations de types internes au module -----------------------------}

type BPTR     = ^byte;   { Pointe sur un octet }

     VEL      = record   { Décrit un couple caractère-attribut }
                  case boolean of
                    true  : ( Caractere, Attribut : byte );
                    false : ( Contenu : word );
                end;

     VPTR     = ^VEL;   { Pointe sur un couple caractère-attribut }

     VELARRAY = array [0..9999] of VEL;  { Buffer de fenêtre }

     VELARPTR = ^VELARRAY;    { Pointe sur un buffer de fenêtre}

     WIPTR    = ^WINDES;      { Pointe sur un descripteur de fenêtre }

     WINDES   = record       { Descripteur de fenêtre }
                  Attribut,  { Attribut de la fenêtre }
                  Handle,    { Numéro servant de clé d'accès à la fenêtre }
                  x1, y1,    { Coordonnées des coins de la fenêtre }
                  x2, y2,
                  ViewX1, ViewY1, { Coordonnées de la zone }
                  ViewX2, ViewY2, { de visualisation }
                  curc, curl    : byte; { Coordonnées du curseur avant
                                          ouverture }
                  lastwin,     { Lien avec la fenêtre précédente ...}
                  nextwin       : WIPTR; { ...et avec la suivante  }
                  buffer        : byte;   { Début du buffer de la
                                            fenêtre }
                end;

     PTRREC   = record     { Permet d'accéder aux }
                  Ofs : word;   { composants d'un pointeur }
                  Seg : word;   { quel qu'il soit }
                end;

     HANDLES  = array [0..63] of byte; { Tableau de bits pour mémoriser }
                                       { les numéros des fenêtres }

     HANDPTR  = ^HANDLES;    { Pointe sur le tableau des numéros }

{-- Variables globales internes au module ----------------------------}

var VioSeg      : word;   { Segment de la mémoire vidéo }
    LigneOfs   : integer; { Nombre d'octets dans une ligne }
    WritelnX,      { Colonne d'affichage pour Writeln }
    WritelnY,      { Ligne d'affichage pour Writeln }
    vLigne,        { Position courante du curseur }
    vColonne,
    ViewX1,        { Coin supérieur gauche de la zone de visualisation  }
    ViewY1,        { par rapport à la totalité de l'écran }
    ViewX2,        { Coin inférieur droit de la zone de visualisation }
    ViewY2      : byte;  { par rapport à la totalité de l'écran }

    WritelnPtr  : VPTR; { Pointe sur la position d'affichage de WinWriteln}
    FirstWinPtr : WIPTR; { Pointe sur le premier descripteur de fenêtre }
    ActBufPtr   : VELARPTR; { Pointe sur le buffer courant }
    HaPtr       : HANDPTR;  { Pointe sur le tableau des numéros }

{-- Variables globales initialisées (constantes typées )    --------------}

const NbWin    : integer = 0;  { Nombre de fenêtres ouvertes }
      ActWinPtr : WIPTR = nil;  { Pointe sur le descripteur courant }
      WritelnCol: byte = $07;   { Couleur d'affichage pour Writeln }

{**************************************************************************
*  VG : renvoie une abscisse relative au bord gauche de la fenêtre        *
*       active                                                            *
**-----------------------------------------------------------------------**
*  Entrée : Offset = Distance à partir du bord gauche de la fenêtre       *
*  Sortie : Nombre de colonnes en coordonnées absolues                    *
*  Information    : Si aucune fenêtre n'est ouverte, c'est la totalité de *
*                   l'écran qui sert de cadre de référence                *
*  Variables globales : ViewX1/R                                          *
**************************************************************************}
function VG( Offset : integer ) : byte;

begin
  VG:= ViewX1 + Offset;
end;


{**************************************************************************
*  VD : renvoie une abscisse relative au bord droit de la fenêtre         *
*       active                                                            *
**-----------------------------------------------------------------------**
*  Entrée : Offset = Distance à partir du bord droit de la fenêtre        *
*  Sortie : Nombre de colonnes en coordonnées absolues                    *
*  Information    : Si aucune fenêtre n'est ouverte, c'est la totalité de *
*                   l'écran qui sert de cadre de référence                *
*  Variables globales : ViewX2/R                                          *
**************************************************************************}
function VD( Offset : integer ) : byte;

begin
  VD := ViewX2 + Offset;
end;

{**************************************************************************
*  VH : renvoie une ordonnée relative au bord supérieur de la fenêtre     *
*       active                                                            *
**-----------------------------------------------------------------------**
*  Entrée : Offset = Distance à partir du bord supérieur de la fenêtre    *
*  Sortie : Nombre de lignes en coordonnées absolues                      *
*  Information    : Si aucune fenêtre n'est ouverte, c'est la totalité de *
*                   l'écran qui sert de cadre de référence                *
*  Variables globales : ViewY1/R                                          *
***************************************************************************}

function VH( Offset : integer ) : byte;

begin
  VH := ViewY1 + Offset;
end;

{***************************************************************************
*  VB : renvoie une ordonnée relative au bord inférieur de la fenêtre      *
*       active                                                             *
**------------------------------------------------------------------------**
*  Entrée : Offset = Distance à partir du bord inférieur de la fenêtre     *
*  Sortie : Nombre de lignes en coordonnées absolues                       *
*  Information    : Si aucune fenêtre n'est ouverte, c'est la totalité de  *
*                   l'écran qui sert de cadre de référence                 *
*  Variables globales : ViewY2/R                                           *
***************************************************************************}

function VB( Offset : integer ) : byte;

begin
  VB := ViewY2 + Offset;
end;

{***************************************************************************
*  GetVioPtr : retourne un pointeur sur un caractère donné de la mémoire   *
*              vidéo                                                       *
**------------------------------------------------------------------------**
*  Entrée : Ligne, Colonne = Coordonnées du caractère                      *
*  Sortie : Pointeur sur caractère en mémoire vidéo, de type  VPTR         *
*  Information    : L'origine des coordonnées (0/0) est le coin supérieur  *
*                   gauche de l'écran                                      *
*  Variables globales : VioSeg/R, NbCol/R                                  *
***************************************************************************}

function GetVioPtr( Colonne, Ligne : byte ) : VPTR;

begin
  GetVioPtr := Ptr( VioSeg, ( NbCol * Ligne + Colonne ) shl 1);
end;

{***************************************************************************
*  WinGetChar : indique le code ASCII d'un caractère se trouvant à un      *
*               emplacement donné                                          *
**------------------------------------------------------------------------**
*  Entrées : Ligne, Colonne = Coordonnées du caractères                    *
*  Sortie : le code ASCII du caractère                                     *
*                                                                          *
*  Variables globales : VioSeg/R, NbCol/R                                  *
***************************************************************************}

function  WinGetChar( Colonne, Ligne : byte ) : char;

begin
  WinGetChar := chr(Mem[VioSeg : (NbCol * Ligne + Colonne ) shl 1]);
end;

{***************************************************************************
*  WinGetCol : indique la couleur d'un caractère se trouvant à un          *
*              emplacement donné                                           *
**------------------------------------------------------------------------**
*  Entrées : Ligne, Colonne = Coordonnées du caractère                     *
*  Sortie : le code couleur du caractère                                   *
*  Variables globales : VioSeg/R, NbCol/R                                  *
***************************************************************************}

function  WinGetCol( Colonne, Ligne : byte ) : byte;

begin
  WinGetCol := Mem[VioSeg : (NbCol * Ligne + Colonne ) shl 1 + 1];
end;

{***************************************************************************
*  WinPutChar : écrit un caractère et son attribut directement dans la     *
*               mémoire vidéo                                              *
**------------------------------------------------------------------------**
*  Entrée : Ligne, Colonne = Coordonnées du caractère                      *
*            Caractere     = Caractère à afficher                          *
*            Couleur       = Couleur ou attribut  du caractère             *
*  Information    : l'origine des coordonnées est le point (0,0) situé     *
*                   au coin supérieur gauche de l'écran                    *
                                                                           *
*  Variables globales : VioSeg/R, NbCol/R                                  *
***************************************************************************}

procedure WinPutChar( Colonne, Ligne : byte; Caractere : char; Couleur : byte );

var OfsPos : integer; { Offset de la position du caractère en mém. vidéo }

begin
  OfsPos := (NbCol * Ligne + Colonne ) shl 1;   { Calcule l'offset }
  Mem[ VioSeg : OfsPos ] := ord( Caractere );  { Ecrit le caractère et   }
  Mem[ VioSeg : OfsPos + 1 ] := Couleur;  { l'attribut en mémoire vidéo }
end;

{***************************************************************************
*  WinSetCursor : positionne le curseur clignotant                         *
**------------------------------------------------------------------------**
*  Entrée : Ligne, Colonne = nouvelle position du curseur                  *
*  Variables globales : vLigne/W, vColonne/W                               *
***************************************************************************}

procedure WinSetCursor( Colonne, Ligne : byte );

var Regs : Registers;  { Registres utilisés par l'interruption }

begin
  Regs.ah := 2;  { Numéro de la fonction Set Cursor }
  Regs.bh := 0;  { Page d'écran concernée }
  Regs.dh := Ligne;  { Transmet la ligne souhaitée }
  vLigne  := Ligne;
  Regs.dl := Colonne;  { Transmet la colonne souhaitée }
  vColonne := Colonne;
  intr($10, Regs);   { Appelle l'interruption du BIOS vidéo }
end;
{***************************************************************************
*  WinDefCursor : définit l'aspect du curseur                              *
**------------------------------------------------------------------------**
*  Entrée : Debut  = Ligne de début du curseur                             *
*           Fin    = Ligne de fin du curseur                               *
*  Variable globale : néant                                                *
***************************************************************************}

procedure WinDefCursor( Debut, Fin : byte );

var Regs : Registers;   { Registres utilisés par l'interruption }

begin
  Regs.ah := 1;   { Numéro de la fonction }
  Regs.ch := Debut;  { Charge les lignes de début et de fin }
  Regs.cl := Fin;
  intr($10, Regs);  { Déclenche l'interruption du BIOS vidéo }
end;

{***************************************************************************
*  WinHideCursor : retire le curseur de l'écran                            *
**------------------------------------------------------------------------**
*  Entrée : néant                                                          *
*  Variable globale : NbLig/R                                              *
***************************************************************************}

procedure WinHideCursor;

begin
  WinSetCursor( 0, NbLig + 1 );  {Place le curseur en dehors de l'écran }
end;

{***************************************************************************
*  WinBlockCursor : définit le curseur comme un rectangle recouvrant       *
*                   le caractère situé en-dessous                          *
**------------------------------------------------------------------------**
*  Entrée : néant                                                          *
*  Variable globale : Color/R                                              *
***************************************************************************}

procedure WinBlockCursor;

begin
  if ( Color ) then    { Carte couleur ? }
    WinDefCursor( 0, 7 )  { Oui }
  else     { Carte monochrome }
    WinDefCursor( 0, 13 );
end;

{***************************************************************************
*  WinLineCursor : définit le curseur comme un tiret s'étendant            *
*                  sur les deux dernières lignes de trame                  *
**------------------------------------------------------------------------**
*  Entrée : néant                                                          *
*  Variable globale : Color/R                                              *
***************************************************************************}

procedure WinLineCursor;

begin
  if ( Color ) then  { Carte couleur ? }
    WinDefCursor( 6, 7 )      { Oui }
 else   { Carte monochrome }
    WinDefCursor( 12, 13 );
end;

{***************************************************************************
*  WinSetView : définit une zone de l'écran comme zone de visualisation    *
*               à laquelle se réfèrent les fonctions VG, VD, VH, VB        *
**------------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone      *
  x2, y2 = Coordonnées du coin inférieur droit de la zone                  *
*  Variables globales : ViewX1/W, ViewX2/W, ViewY1/W, ViewY2/W             *
***************************************************************************}

procedure WinSetView( x1, y1, x2, y2 : byte);

begin
  ViewX1 := x1;    { Mémorise les coordonnées dans }
  ViewY1 := y1;    { les variables globales }
  ViewX2 := x2;
  ViewY2 := y2;
end;

{***************************************************************************
*  WinGetView : indique la zone de visualisation actuelle                  *
*                                                                          *
**------------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone      *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone       *
*  Information    : la zone de visualisation sert de cadre de référence    *
*                   aux fonctions VG, VD, VH, VB                           *
*  Variables globales : ViewX1/R, ViewX2/R, ViewY1/R, ViewY2/R             *
***************************************************************************}

procedure WinGetView( var x1, y1, x2, y2 : byte );

begin
  x1 := ViewX1;   { Prend les coordonnées dans   }
  y1 := ViewY1;   { les variables globales       }
  x2 := ViewX2;
  y2 := ViewY2;
end;

{***************************************************************************
*  WinWrite2View: active ou désactive la prise en compte par Writeln       *
*                 de la zone de visualisation actuelle                     *
**------------------------------------------------------------------------**
*  Entrées : Doit = TRUE : fait respecter la zone de visualisation         *
*                   FALSE: désigne l'écran dans sa totalité comme          *
*                          référence d'affichage.                          *
*                          Pas de défilement en fin d'écran                *
*  Globals : Write2View/W                                                  *
***************************************************************************}

procedure WinWrite2View( Doit : boolean );

begin
  Write2View := Doit; { Mémorise un indicateur }
end;


{**************************************************************************
*  WhereX : retourne la colonne d'affichage de la prochaine instruction   *
*           Writeln appliquée à la variable fichier OUTPUT                *
**-----------------------------------------------------------------------**
*  Entrée : néant                                                         *
*  Sortie : cf supra                                                      *
*  Variables globales : WritelnX/R                                        *
**************************************************************************}

function WhereX : integer;

begin
  WhereX := WritelnX;  { Retourne la colonne d'affichage }
end;

{***************************************************************************
*  WhereY : retourne la ligne d'affichage de la prochaine instruction      *
*           Writeln appliquée à la variable fichier OUTPUT                 *
**------------------------------------------------------------------------**
*  Entrée : néant                                                          *
*  Sortie : cf supra                                                       *
*  Variables globales : WritelnY/R                                         *
***************************************************************************}

function WhereY : integer;

begin
  WhereY := WritelnY;   { Retourne la ligne d'affichage }
end;

{**************************************************************************
*  TextColor : fixe la couleur des caractères pour l'affichage            *
*              par Writeln                                                *
**-----------------------------------------------------------------------**
*  Entrée : Col = la couleur de caractère choisie (0-15)                  *
*  Variables globales : WritelnCol/RW                                     *
**************************************************************************}

procedure TextColor( Color : byte );

begin
  WritelnCol := ( WritelnCol and $F0 ) or Color;  { Met la couleur }
end;

{***************************************************************************
*  TextBackground : fixe la couleur de fond pour l'affichage               *
*                   par Writeln .                                          *
**------------------------------------------------------------------------**
*  Entrée : Col = la couleur de fond choisie (0-15)                        *
*  Variables globales : WritelnCol/RW                                      *
***************************************************************************}

procedure TextBackground( Color : byte );

begin
  WritelnCol := ( WritelnCol and $0F ) or ( Color shl 4 );  { Met la couleur }
end;

{***************************************************************************
*  ClrScr : efface l'écran                                                 *
**------------------------------------------------------------------------**
*  Entrée : néant                                                          *
*  Information    : Remplace la procédure homonyme de l'unité Crt          *
*  Variables globales : NbCol/R, NbLig/R, WritelnCol/R                     *
***************************************************************************}

procedure ClrScr;

begin
  WinFill( 0, 0, NbCol-1, NbLig-1, ' ', WritelnCol );
end;

{**************************************************************************
*  GotoXY : remplace la procédure GotoXY de l'unité CRT                   *
*           fixe la position d'affichage pour le prochain appel           *
*           de la procédure Writeln détournée                             *
**-----------------------------------------------------------------------**
*  Entrées : X = Colonne d'affichage                                      *
*            Y = Ligne d'affichage                                        *
*  Information    : le curseur visible n'est pas affecté                  *
*  Variables globales : WritelnX/W, WritelnY/W, WritelnPtr/W              *
**************************************************************************}

procedure GotoXY( X, Y : integer );

begin
  WritelnX := X;   { Mémorise la position dans la variable globale }
  WritelnY := Y;
  WritelnPtr := GetVioPtr( x, y ); { Pointe sur la nouvelle position }
end;

{***************************************************************************
*  GetScr : mémorise dans un buffer une zone de l'écran                    *
**------------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone      *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone       *
*            BufPtr = Pointe sur le buffer destiné à stocker la zone       *
*  Information    : Le buffer contient les lignes sous forme linéaire      *
*                   juxtaposée                                             *
*  Variables globales : néant                                              *
***************************************************************************}

procedure GetScr( x1, y1, x2, y2 : byte; BufPtr : pointer );

var nbytes : integer;  { Nombre d'octets à copier par ligne }

begin
  nbytes := ( x2 - x1 + 1 ) shl 1;   { Octets par ligne }
  while y1 <= y2 do   { Parcourt les lignes }
    begin
      Move( GetVioPtr(x1, y1)^, BufPtr^, nbytes);
      inc( PTRREC( BufPtr ).Ofs, nbytes );
      inc( y1 );     { Y1 = ligne suivante }
    end;
end;

{****************************************************************************
*  PutScr : copie directement le contenu d'un buffer dans la mémoire vidéo  *
**-------------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone       *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone        *
*            BufPtr = Pointe sur le buffer à recopier dans la mémoire vidéo *
*  Information    : Le buffer doit être au format défini par PutScr         *
*  Variables globales : néant                                               *
****************************************************************************}

procedure PutScr( x1, y1, x2, y2 : byte; BufPtr : pointer );

var nbytes : integer;  { Nombre d'octets à copier par ligne }

begin
  nbytes := ( x2 - x1 + 1 ) shl 1;  { Octets par ligne }
  while y1 <= y2 do   { Parcourt les lignes }
    begin
      Move( BufPtr^, GetVioPtr(x1, y1)^, nbytes);
      inc( PTRREC( BufPtr ).Ofs, nbytes );
      inc( y1 );        { Y1 = ligne suivante }
    end;
end;

{***************************************************************************
*  WinOpen : ouvre une fenêtre                                             *
**------------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche                 *
*            x2, y2 = Coordonnées du coin inférieur droit                  *
*  Sortie : Numéro (handle) permettant d'accéder par la suite              *
*            la fenêtre                                                    *
*  Information    : Si la fenêtre n'a pas pu être ouverte en raison du     *
*                   manque de mémoire sur le tas, le numéro retourné a     *
*                   la valeur WinOpenError (-1)                            *
*  Variables globales : vLigne/R, vColonne/R, ViewX1/R, ViewX2/R,          *
*                       ViewY1/R, ViewY2/R, NbWin/W, FirstWinPtr/RW,       *
*                       ActWInPtr/RW, HaPtr^/RW                            *
***************************************************************************}

function WinOpen( x1, y1, x2, y2 : byte ) : integer;

var i, j,    { Compteurs d'itérations }
    Key,     { Mémorise le numéro d'accès }
    BufLen : integer;  { Taille du buffer }
    WinPtr : WIPTR;    { Decsripteur de fenêtre }
begin
  BufLen := ( x2 - x1 + 1 ) * ( y2 - y1 + 1 ) shl 1;
  if MaxAvail >= BufLen + SizeOf( WINDES ) - 1 then
    begin   { Il reste assez de mémoire }
      GetMem( WinPtr, BufLen + SizeOf( WINDES ) - 1 );
      WinPtr^.x1      := x1;    { Transfère les coordonnées }
      WinPtr^.x2      := x2;    { de la fenêtre }
      WinPtr^.y1      := y1;    { dans le descripteur }
      WinPtr^.y2      := y2;
      WinPtr^.curc    := vColonne;  { Mémorise également la position }
                                     { actuelle du curseur }
      WinPtr^.curl    := vLigne;
      WinPtr^.ViewX1  := ViewX1; { Transfère les coordonnées }
      WinPtr^.ViewY1  := ViewY1; { de la zone de visualisation }
      WinPtr^.ViewX2  := ViewX2; { dans le descripteur }
      WinPtr^.ViewY2  := ViewY2;
      WinPtr^.Attribut:= 0;      { Pas encore d'attribut }
      WinPtr^.LastWin := ActWinPtr;  { Lien avec la fenêtre précédente }
      WinPtr^.NextWin := NIL;    { Pas encore de successeur }

      GetScr( x1, y1, x2, y2, @WinPtr^.Buffer );
      ActBufPtr := VELARPTR(@WinPtr^.Buffer);  { Pointe sur le buffer }

      WinSetView( x1, y1, x2, y2 ); { Zone de visualisation = la fenêtre }

      if ActWinPtr <> NIL then  { Existait-il déjà une autre fenêtre ? }
        ActWinPtr^.NextWin := WinPtr {Oui, la relie à la nouvelle }
      else  { Non la présente est la première et la seule fenêtre  }
        FirstWinPtr := WinPtr; { Pointe sur la première fenêtre }
      ActWinPtr := WinPtr; { Pointe sur la fenêtre active }

      inc( NbWin );  { Incrémente le nombre de fenêtres ouvertes }

      {-- Recherche un numéro libre pointé par HaPtr ---------}

      Key := 0;   { numéro = rang du bit }
      while (HaPtr^[ Key shr 3 ] and ( 1 shl (Key and 7) )) <> 0 do
        inc( Key );  { Numéro déjà attribué, passe au suivant }
      HaPtr^[ Key shr 3 ] := HaPtr^[ Key shr 3 ] or ( 1 shl ( Key and 7 ));
      WinPtr^.Handle := Key;   { Mémorise le numéro dans le descripteur }
      WinOpen := Key;   { Passe le numéro au programme appelant }
    end
  else  { Pas assez de mémoire pour le descripteur et le buffer associé }
    WinOpen := -1;
end;

{***************************************************************************
*  WinClose : referme la dernière fenêtre ouverte                          *
**------------------------------------------------------------------------**
*  Entrée : Redraw = TRUE : le contenu de l'écran recouvert par la         *
*                            fenêtre est restauré                          *
*  Information    : Le programme appelant doit s'assurer qu'au moment de   *
*                   l'appel de la procédure il reste au moins une fenêtre  *
*                   ouverte                                                *
*  Variables globales : ActWinPtr/RW, FirstWinPtr/RW, HaPTr^/RW, NbWin/W   *
***************************************************************************}

procedure WinClose( ReDraw : boolean );

var WinPtr : WIPTR;  { Pointe sur le descripteur actuel }

begin
  with ActWinPtr^ do
    begin
      {-- Restitue le numéro de la fenêtre --------------------}

      HaPtr^[ Handle shr 3 ] := HaPtr^[ Handle shr 3 ] and
                                               not( 1 shl ( Handle and 7 ));

      if ReDraw then   { Faut-il reconstituer l'écran ? }
        PutScr( x1, y1, x2, y2, @Buffer ); { Oui  }
      WinSetView( ViewX1, ViewY1, ViewX2, ViewY2 );  { ancienne zone de visualisation }
      WinSetCursor( curc, curl ); { Ramène le cusreur à son ancienne position }
      WinPtr := ActWinPtr;  { Mémorise le pointeur sur le descript. actuel }
      ActWinPtr := LastWin;  { Pointe sur le descripteur précédent }
      if LastWin <> NIL then   { Plus de fenêtre ouverte ? }
        ActWinPtr^.NextWin := NIL  { Oui, plus de successeur }
      else   { Non }
        FirstWinPtr := NIL;  { Ne pointe sur rien }

      {-- Libère la mémoire allouée pour le descripteur ---}
      FreeMem( WinPtr, (x2-x1+1) * (y2-y1+1) shl 1 + SizeOf(WINDES) - 1);

      ActBufPtr := VELARPTR(@ActWinPtr^.Buffer); { Pointe sur le buffer }

      dec( NbWin );  { Décrémente le nombre de fenêtres ouvertes }
    end;
end;

{***************************************************************************
*  WinStRep : construit une chaîne de caractères répétitifs                *
**------------------------------------------------------------------------**
*  Entrée : Caractere = le caractère à répéter                             *
*              Nombre = Nombre de répétitions ou longueur de la chaîne     *
*  Sortie : la chaîne construite                                           *
*  Variable globale : néant                                                *
***************************************************************************}

function WinStRep( Caractere : char; Nombre : byte ) : string;

var StrepString : String;   { Pour contenir la chaîne }

begin
  StrepString[0] := chr( Nombre );
  FillChar( StrepString[1], Nombre, Caractere );
  WinStRep := StrepString;
end;

{***************************************************************************
*  WinPrint : écrit une chaîne directement dans la mémoire vidéo           *
**------------------------------------------------------------------------**
*  Entrées : Colonne, Ligne = Position d'affichage                         *
*            Couleur         = Couleur ou attribut du caractère à afficher *
*            Sortie          = Chaîne à afficher                           *
*  Information : - Si la chaîne dépasse la fin de la ligne, l'affichage se *
*                  poursuit à la ligne suivante                            *
*                - Si la fin de l'écran ou de la fenêtre active est        *
*                  atteinte, il n'y a pas de défilement vers le haut       *
*  Variable globale : néant                                                *
***************************************************************************}

procedure WinPrint( Colonne, Ligne, Couleur : byte; Sortie : string );

var VioPtr : VPTR;     { Pointe sur la mémoire vidéo }
    i, j   : byte;     { Compteurs d'itérations }

begin
  VioPtr := GetVioPtr( Colonne, Ligne ); { Charge un pointeur }
  j := length( Sortie ); { Détermine la longueur de la chaîne }
  for i:=1 to j do   { Parcourt les caractères de la chaîne }
    begin
      VioPtr^.Caractere := ord( Sortie[i] ); { Met le caractère et }
      VioPtr^.Attribut := Couleur;  { son attribut dans la mémoire vidéo }
      inc( PTRREC( VioPtr ).Ofs, 2 ); { Passe au caractère suivant }
    end;
end;

{***************************************************************************
*  WinFill : remplit une zone de l'écran avec un caractère et une          *
*            couleur donnés                                                *
**------------------------------------------------------------------------**
*  Entrées: x1, y1  = Coordonnées du coin supérieur gauche de la zone      *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone       *
*            Caractere,                                                    *
*            Couleur   = le caractère et son attribut                      *
*  Variable globale : néant                                                *
***************************************************************************}
procedure WinFill( x1, y1, x2, y2 : byte; Caractere : char; Couleur : byte );

var Ligne : string;  { Mémorise une ligne de caractères }

begin
  Ligne := WinStRep( Caractere, x2-x1+1 );    { Fabrique une ligne }
  while y1 <= y2 do      { Parcourt la zone ligne par ligne }
    begin
      WinPrint( x1, y1, Couleur, Ligne );  { Affiche la ligne fabriquée }
      inc( y1 );   { Passe à la ligne suivante }
    end;
end;

{***************************************************************************
*  WinFrame : trace un cadre autour d'une zone de l'écran                  *
**------------------------------------------------------------------------**
*  Entrées : x1, y1  = Coordonnées du coin supérieur gauche de la zone     *
*            x2, y2  = Coordonnées du coin inférieur droit de la zone      *
*            Cadre   = l'une des constantes CAD_SIM, CAD_DOU, etc          *
*            Couleur = Couleur (attribut) du cadre                         *
*  Variable globale : néant                                                *
***************************************************************************}

procedure WinFrame( x1, y1, x2, y2, Cadre, Couleur : byte );

type CadStruc = record   { Liste des caractères formant le cadre }
                SupGauche,
                SupDroite,
                InfGauche,
                InfDroite,
                Vertical,
                Horizontal  : char;
              end;

const CadCaractere : array[1..4] of CadStruc =  { Types de cadres disponibles }
       (
        ( SupGauche   : '┌'; SupDroite  : '┐'; InfGauche  : '└';
          InfDroite : '┘'; Vertical    : '│'; Horizontal  : '─' ),
        ( SupGauche   : '╔'; SupDroite  : '╗'; InfGauche  : '╚';
          InfDroite : '╝'; Vertical    : '║'; Horizontal  : '═' ),
        ( SupGauche   : '▒'; SupDroite  : '▒'; InfGauche  : '▒';
          InfDroite : '▒'; Vertical    : '▒'; Horizontal  : '▒' ),
        ( SupGauche   : '█'; SupDroite  : '█'; InfGauche  : '█';
          InfDroite : '█'; Vertical    : '█'; Horizontal  : '█' )
       );

var StrepBuf : string;  { Stocke une ligne horizontale }
    Ligne    : byte;   { Compteur }

begin
 with CadCaractere[ Cadre ] do
   begin
     WinPutChar( x1, y1, SupGauche, Couleur );  { Dessine les quatre }
     WinPutChar( x2, y1, SupDroite, Couleur );  { coins du cadre }
     WinPutChar( x1, y2, InfGauche, Couleur );
     WinPutChar( x2, y2, InfDroite, Couleur );

     StrepBuf := WinStRep( Horizontal, x2-x1-1 );  { puis les deux lignes }
     WinPrint( x1+1, y1, Couleur, StrepBuf );      { horizontales }
     WinPrint( x1+1, y2, Couleur, StrepBuf );

     dec( y2 );   { Fixe la fin de la boucle qui suit }
     for Ligne:=y1+1 to y2 do  { Parcourt les lignes }
       begin                   { et trace les verticales  }
         WinPutChar( x1, Ligne, Vertical, Couleur );
         WinPutChar( x2, Ligne, Vertical, Couleur );
       end;
   end;
end;

{***************************************************************************
*  WinColor : remplit une zone de l'écran avec un attribut donné           *
*             sans modifier les caractères de la zone                      *
**------------------------------------------------------------------------**
*  Entrées : x1, y1  = Coordonnées du coin supérieur gauche de la zone     *
*            x2, y2  = Coordonnées du coin inférieur droit de la zone      *
*            Couleur = la nouvelle couleur des caractères                  *
*  Variable globale : LigneOfs/R                                           *
***************************************************************************}

procedure WinColor( x1, y1, x2, y2, Couleur : byte );

var VioPtr : VPTR;   { Pointe sur la mémoire vidéo }
    Ligne,    { Compteur de lignes }
    Colonne,  { Compteur de colonnes }
    DeltaX : integer; { Différence entre deux lignes  }

begin
  VioPtr := GetVioPtr( x1, y1 ); { Pointe sur le premier caractère }
  DeltaX := LigneOfs - ( (x2-x1) shl 1 ) - 2;  { Offset de x2 à x1 }

  for Ligne:=y1 to y2 do   { Parcourt les lignes }
    begin    { Parcourt les colonnes }
      for Colonne:=x1 to x2 do
        begin
          VioPtr^.Attribut := Couleur;  { Enregistre la couleur  }
          inc( PTRREC(VioPtr).Ofs, 2 ); { Augmente l'offset de 2 }
        end;
      inc( PTRREC(VioPtr).Ofs, DeltaX );
    end;
end;

{***************************************************************************
*  WinShadow : dessine une ombre                                           *
**------------------------------------------------------------------------**
*  Entrées : x1, y1  = Coordonnées du coin supérieur gauche de l'ombre     *
*            x2, y2  = Coordonnées du coin infériur droit de l'ombre       *
*            BufPtr  = Pointeur désignant le buffer à manipuler            *
*                      Information. En mode couleur, l'ombre est générée   *
*                      par modification des attributs des caractères,      *
*                      tandis qu'en mode monochrome, les caractères        *
*                      recouverts par l'ombre sont remplacés par  '▒'      *
*  Variables globales : NbCol/R, Color/R, LigneOfs/R                       *
***************************************************************************}

procedure WinShadow( x1, y1, x2, y2 : byte; BufPtr : VPTR );

var Attribut : byte;   { Attribut à manipuler }
    Ligne,             { Compteur de lignes }
    Colonne,           { Compteur de colonnes }
    DeltaX   : integer;  { Distance à parcourir sur une ligne }

begin
  inc( PTRREC( BufPtr ).Ofs, ( y1 * NbCol + x1 ) shl 1 );  { Charge le pointeur }
  DeltaX := LigneOfs - ( (x2-x1) shl 1 ) - 2;  { Offset de x2 à x1 }

  if ( Color ) then   { Mode couleur ? }
    for Ligne := y1 to y2 do   { Parcourt les lignes }
      begin   { Parcourt les caractères d'une ligne }
        for Colonne := x1 to x2 do
          begin
            Attribut := BufPtr^.Attribut;  { Attribut du caractère }

            {-- Change la couleur de fond ----------------------------}

            if Attribut and 128 <> 0 then { Fond clair ? }
              Attribut := Attribut and 128  { Oui, modifie le bit 7 }
            else   { Non, fond normal }
              Attribut := Attribut and 15;  { Met un fond sombre }

            {-- Change la couleur du caractère ------------------------}

            if Attribut and 8 <> 0 then  { Caractère clair ? }
              Attribut := Attribut and (255 - 8); { Oui, modifie le bit 3 }
              BufPtr^.Attribut := Attribut;  { Remet l'attribut dans la mémoire vidéo }
            inc( PTRREC(BufPtr).Ofs, 2 );  { Pointe sur le caractère suivant }
          end;
        inc( PTRREC(BufPtr).Ofs, DeltaX );  { Pointe sur la ligne suivante}
      end
  else   { Non, mode monochrome }
    for Ligne := y1 to y2 do   { Parcourt les lignes }
      begin    { Parcourt les caractères d'une ligne }
        for Colonne := x1 to x2 do
          begin
            BufPtr^.Contenu := ord( '▒' ) + ( $7 shl 8 );  { Fixe l'attribut }
            inc( PTRREC(BufPtr).Ofs, 2 );  { Passe au caractère suivant }
          end;
        inc( PTRREC(BufPtr).Ofs, DeltaX ); { Passe à la ligne suivante }
      end
end;

{***************************************************************************
*  WinOpenShadow : ouvre une nouvelle fenêtre et dessine son ombre         *
**------------------------------------------------------------------------**
*  Entrées: x1, y1  = Coordonnées du coins supérieur gauche                *
*           x2, y2  = Coordonnées du coin inférieur droit                  *
*  Information    : - la largeur et la profondeur de l'ombre sont fixées   *
*                     par les variables globales ShadowX et ShadowY        *
*                   - les coordonnées transmises ne doivent pas inclure    *
*                     l'ombre et doivent être choisies de telle sorte qu'il*
*                     reste de la place pour dessiner l'ombre sur l'écran  *
*                   - en mode couleur, l'ombre est générée par modification*
*                     des attributs des caractères, tandis qu'en mode      *
*                     monochrome, les caractères recouverts par l'ombre    *
*                     sont remplacés par  '▒'                              *
*  Variables globales : ActWinPTr^/W                                       *
***************************************************************************}

function WinOpenShadow( x1, y1, x2, y2 : byte ) : integer;

var  Handle : integer;   { Numéro de la fenêtre ouverte }

begin
  Handle := WinOpen( x1, y1, x2 + ShadowX, y2 + ShadowY);
  if ( Handle <> WinOpenError ) then
    begin
      ActWinPtr^.Attribut := WIN_OMBRE; { La fenêtre a une ombre }
      WinSetView( x1, y1, x2, y2 ); { L'ombre est en dehors de la zone de visualisation }
      WinShadow( x2+1, y1+1, x2+ShadowX, y2+ShadowY, VPTR(ptr(VioSeg,0)) );
      WinShadow( x1+ShadowX, y2+1, x2, y2+ShadowY, VPTR(ptr(VioSeg,0)) );
    end;
  WinOpenShadow := Handle; { Renvoie le numéro de la fenêtre }
end;

{$I win2.pas}
{***************************************************************************
*  WinInit : Initialise l'unité Win.                                       *
*  Variables globales : VioCarte/W, NbCol/W, NbLig/W, Color/W, VioSeg/W,   *
*                       HaPtr/W, LigneOfs/W                                *
***************************************************************************}

procedure WinInit;

const VioMode : array [0..11] of byte = ( MDA, CGA, 0, EGA, EGA_MONO, 0,
                                          VGA_MONO,  VGA, 0, MCGA,
                                          MCGA_MONO, MCGA );

      EgaMode : array [0..2] of byte  = ( EGA, EGA, EGA_MONO );

var Regs : Registers;   { Registres du processeur pour les interruptions }

begin
  VioCarte := $ff;    { Pas encore de carte vidéo détectée }

  {-- teste s'il y a une carte VGA ou MCGA ---------------------}

  Regs.ax := $1a00;  { Invoque la fonction 1Ah du BIOS vidéo }
  intr($10, Regs);
  if Regs.al = $1a then    { VGA ou MCGA? }
    begin                  { Oui }
      VioCarte := VioMode[ Regs.bl-1 ];  { Cherche le code dans la table }
      Color := not( ( VioCarte = MDA ) or ( VioCarte = EGA_MONO ) );
    end
  else    { Ni VGA ni MCGA }
    begin    { Est-ce de l'EGA ?  }
      Regs.ah := $12;  { Appelle la fonction 12h avec BL=10h }
      Regs.bl := $10;
      intr($10, Regs);  { dans le BIOS vidéo }
      if Regs.bl <> $10 then  { EGA ? }
        begin                 { Oui }
          VioCarte := EgaMode[ (Regs.cl shr 1) div 3 ]; { Cherche le code }
          Color := VioCarte <> EGA_MONO;
        end;
    end;

  {-- Fixe le pointeur sur la mémoire vidéo -----------------------------}

  Regs.ah := 15;    { Recherche le mode vidéo actuel }
  intr($10, Regs);  { en apelant une interrution du BIOS vidéo  }
  if Regs.al = 7 then   { Mode monochrome ? }
    VioSeg := $b000   { Oui, début de mémoire vidéo en B000 }
  else                { Non, mode couleur }
    VioSeg := $b800;  { Début de mémoire vidéo en B800 }

  if VioCarte = $ff then   { ni EGA, ni VGA ni MCGA }
    begin     { Oui }
      if Regs.al = 7 then VioCarte := MDA
                     else VioCarte := CGA;
      NbLig := 25;     { Mode 25 lignes }
      Color := not( ( Regs.al=0 ) or ( Regs.al=2 ) or ( Regs.al=7 ) );
    end
  else     { = EGA, VGA ou MCGA, lit le nombre de lignes ...}
   NbLig := BPTR( Ptr( $40, $84 ) )^ + 1;

  NbCol := BPTR( Ptr( $40, $4a ) )^;  {... et de colonnes }
  LigneOfs := NbCol shl 1;  { Déplacement jusqu'au début de la }
                            { ligne suivante }

  Regs.ah := 5;    { Sélectionne la page d'écran active }
  Regs.al := 0;    { Page 0 }
  intr($10, Regs); { par l'interruption du BIOS vidéo }

  Regs.ah := 3;    { Lit la position actuelle du curseur }
  Regs.bh := 0;    { en page 0 }
  intr($10, Regs); { par l'interruption du BIOS vidéo }
  vLigne  := Regs.dh;   { Mémorise la position du curseur }
  vColonne := Regs.dl;
  WinSetView(0, 0, NbCol-1, NbLig-1);  { Zone de visualisation = }
                                       { la totalité de l'écran }
  New( HaPtr );   { Réserve de la place pour le tableau des numéros }
  FillChar( HaPtr^, SizeOf( HaPtr^ ), 0 ); { Initialise le tableau }

  {-- Dirige la variable fichier  OUTPUT vers des routines de sortie         internes -----------}

  with TextRec( Output ) do   { Manipule la variable OUTPUT }
    begin
      Handle   := $FFFF;    { Valeur attendue par Turbo Pascal
      Mode     := fmClosed; { Périphérique ferné }
      BufSize  := SizeOf( Buffer ); { Fixe la taille et l'adresse  }
      BufPtr   := @Buffer;           { du buffer  }
      OpenFunc := @OutputOpen;  { Adresse de la procédure Open }
      Name[0]  := #0;           { Pas de nom pour le moment }
    end;
  Rewrite( Output );    { Initialise la variable fichier }

  {-- Affichage par Writeln à partir de la position actuelle du curseur --}
  {   en page 0 }
  WritelnX := vColonne;
  WritelnY := vLigne;
  WritelnPtr := GetVioPtr( vColonne, vLigne );

end;
{**--------------------------------------------------------------------**}
{** Ici commence le code de l'unité                                    **}
{**--------------------------------------------------------------------**}

begin
  WinInit;       { Invoque la procédure d'initialisation }
end.