Home
/
Pascal

Pascal Graphics

Graphics

Unit Grafix;
{$G+}

Interface

Type
  PFont = Pointer;                      { ’¨¯ - 㪠§ â¥«ì ­  ¬ âà¨ç­ë© èà¨äâ }
  TPal = Array [0..255, 1..3] of Byte;  { ’¨¯ - ¯ «¨âà , åà ­¨â ª®¬¯®­¥­âë 256-⨠}
                                        { 梥⮢: ªà á­ãî, §¥«¥­ãî ¨ ᨭîî }
  THeader = Record                      { ‘âàãªâãà  § £®«®¢ª  VOB-ä ©«  }
    ID    : Array [1..12] of Char;      { ˆ¤¥­â¨ä¨ª â®à }
    V, SV : Byte;                       { ‚¥àá¨ï ¨ ¯®¤¢¥àá¨ï }
    L, H  : Word;                       { ˜¨à¨­  ¨ ¢ëá®â  }
    Mask  : Boolean;                    { à¨§­ ª ­ «¨ç¨ï ¬ áª¨ }
    Pack  : Byte;                       { à¨§­ ª 㯠ª®¢ª¨ }
    PSize,                              {  §¬¥à ¤ ­­ëå à¨áã­ª  }
    MSize : Word;                       {  §¬¥à ¤ ­­ëå ¬ áª¨ à¨áã­ª  }
    Res   : Array [1..8] of Byte        { ¥§¥à¢ }
  End;
  TPoint = Record                       { ’¨¯ - â®çª . ã¦¥­ ¤«ï à¨á®¢ ­¨ï }
    X, Y : Integer                      { «®¬ ­ëå «¨­¨© ¨ ¬­®£®ã£®«ì­¨ª®¢  }
  End;
  TPCXHeader = Record                   { ‘âàãªâãà  § £®«®¢ª  PCX-ä ©«  }
    Manufact,
    Ver,
    Encoding,
    BitsPerPixel : Byte;
    X1, Y1, X2, Y2,
    Hdpi, Vdpi : Word;
    ColorMap : Array [0..47] of Byte;
    Res,
    Planes : Byte;
    BytesPerLine,
    PalInfo,
    HScrSize,
    VScrSize : Word;
    Filler : Array [0..53] of Byte;
  End;

Const
  VSeg        = $A000;                  { ‘¥£¬¥­â ¢¨¤¥® ¡ãä¥à  }
  MaxX        = 319;
  MaxY        = 199;
  MaxColor    = 255;
  GetMaxX     = MaxX;
  GetMaxY     = MaxY;
  GetMaxColor = MaxColor;
  GrOk        = 0;                      { ¥â ®è¨¡ª¨ }
  GrInit      = -1;                     { Žè¨¡ª  ¯à¨ ¨­¨æ¨ «¨§ æ¨¨ £à ä¨ª¨ }
  GrLoadFont  = -2;                     { Žè¨¡ª  ¯à¨ § £à㧪¥ èà¨äâ  }
  GrLoadObj   = -3;                     { Žè¨¡ª  ¯à¨ § £à㧪¥ ª à⨭ª¨ }
  GrSaveObj   = -4;                     { Žè¨¡ª  ¯à¨ § ¯¨á¨ ª à⨭ª¨ }

  Seq_Addr          = $3C4;
  CRTC_Addr         = $3D4;
  Misc_Output_Addr  = $3C2;
  Graph_Cntrl_Addr  = $3CE;

Var
  VSegA         : Word;                 { ‘¥£¬¥­â  ªâ¨¢­®© ¢¨¤¥® áâà ­¨æë }
  GrResult      : Integer;              { Žè¨¡ª  ®¯¥à æ¨¨ }
  CurFont       : PFont;                { “ª § â¥«ì ­  ⥪ã騩 èà¨äâ }
  FontSize      : Word;                 { Ž¡ê¥¬ ⥪ã饣® èà¨äâ  }
  FontX, FontY  : Byte;                 { ƒ®à¨§. ¨ ¢¥àâ. à §¬¥àë èà¨äâ  }
  TranspColor   : Byte;                 { –¢¥â ¯à®§à ç­®á⨠á¯à ©â  }

  _Poly : Array [0..319,1..2] of Integer;       { ®¤ à¨á®¢ ­¨¥ ¬­®£®ã£-ª®¢ }
                                                {                  ¨ ᤢ¨£¨ }
  _LeftTable,
  _RightTable : Array [0..199,0..2] of Integer; { ®¤ ⥪áâãà­ãî § «¨¢ªã }


Function IsVGA : Boolean;
{ ‚®§¢à é ¥â TRUE, ¥á«¨ ¢ á¨á⥬¥ ãáâ ­®¢«¥­  VGA-ª àâ  }

Procedure InitGraph;
{ ˆ­¨æ¨ «¨§¨àã¥â £à ä¨ªã; á®áâ®ï­¨¥ ¢ ¯¥à¥¬¥­­®© GrResult }

Procedure CloseGraph;
{ ‡ ªà뢠¥â £à ä¨ªã (ãáâ ­ ¢«¨¢ ¥â 梥¨­®© ⥪áâ®¢ë© à¥¦¨¬ 80x25) }

Procedure ClearScreen (C : Byte);
{ Žç¨é ¥â íªà ­ 梥⮬ C; ­   ªâ¨¢­®© áâà ­¨æ¥ }

Procedure Border (C : Byte);
{ “áâ ­ ¢«¨¢ ¥â 梥â C à ¬ª¨ íªà ­  }

Procedure PutPixel (X, Y : Word; C : Byte);
{ ¨áã¥â â®çªã ¢ ¯®§¨æ¨¨ (X,Y) 梥⮬ C; ­   ªâ¨¢­®© áâà ­¨æ¥ }

Function GetPixel (X, Y : Word) : Byte;
{ ‚®§¢à é¥â 梥â â®çª¨ ¢ ¯®§¨æ¨¨ (X,Y);  /á }

Procedure LineH (X, Y, L : Word; C : Byte);
{ ¨áã¥â £®à¨§®­â «ì­ãî «¨­¨î ®â â®çª¨ (X,Y) ¤«¨­ë L 梥⮬ C; a/c }

Procedure LineV (X, Y, H : Word; C : Byte);
{ ¨áã¥â ¢¥à⨪ «ì­ãî «¨­¨î ®â â®çª¨ (X,Y) ¢ëá®âë H 梥⮬ C; a/c }

Procedure Line (X1, Y1, X2, Y2 : Word; C : Byte);
{ ¨áã¥â «¨­¨î, ᮥ¤¨­ïîéãî â®çª¨ (X1,Y1) ¨ (X2,Y2), 梥⮬ C; a/c }

Procedure Box (X, Y, L, H : Word; C : Byte; Fill : Boolean);
{ ¨áã¥â ¯àאַ㣮«ì­¨ª ®â â®çª¨ (X,Y) ¤«¨­ë L ¨ ¢ëá®âë H 梥⮬ C,
  ¥á«¨ Fill = True, â® ¯àאַ㣮«ì­¨ª § ªà è¨¢ ¥âáï ⥬ ¦¥ 梥⮬;  /á }

Procedure Circle (X, Y, R : Word; C : Byte; Fill : Boolean);
{ ¨áã¥â ®ªà㦭®áâì æ¢¥â  C á 業â஬ ¢ â®çª¥ (X,Y) à ¤¨ãá  R;
  ¥á«¨ Fill = True, â® ®ªà㦭®áâì § ªà è¨¢ ¥âáï ⥬ ¦¥ 梥⮬;  /á }

Procedure Fill (X, Y : Word; C : Byte);
{ ¥à¥ªà è¨¢ ¥â ®¤­®æ¢¥â­ãî ®¡« áâì, ¢ ª®â®àãî ¯®¯ «  â®çª  (X,Y),
  ¢ ­®¢ë© 梥â - C; âॡã¥â 120 âëá. ¡ ©â á ª®¯¥©ª ¬¨ ᢮¡®¤­®©
  ¯ ¬ï⨠¢ ªãç¥; â® ¦ã⪮ â®à¬®§ïé ï ¯à®æ¥¤ãà ;  /á }

Procedure DrawPoly (Num : Word; PolyPoints : Array of TPoint; C : Byte);
{ ¨áã¥â «®¬ ­ãî æ¢¥â  C ¯® ¥¥ Num ¢¥à設 ¬ ¢ PolyPoints;  /á }

Procedure DrawPoly2 (Num : Word; PolyPoints : Array of TPoint; C : Byte);
{ ¨áã¥â § ¬ª­ãâãî «®¬ ­ãî æ¢¥â  C ¯® ¥¥ Num ¢¥à設 ¬ ¢
  PolyPoints;  /á }

Procedure FillPoly (Num : Word; PolyPoints : Array of TPoint; C : Byte);
{ ¨áã¥â ᯫ®è­®© ¬­®£®ã£®«ì­¨ª æ¢¥â  C ¯® ¥£® Num ¢¥à設 ¬ ¢
  PolyPoints;  /á }

Procedure FillPolyPat (Num : Word; PolyPoints : Array of TPoint;
                                                L, H : Word; Var Pat);
{ ‡ ¯®«­ï¥â ¬­®£®ã£®«ì­¨ª á Num ¢¥à設 ¬¨ ¢ PolyPoints ®¤¨­ ª®¢ë¬¨
  ¯àאַ㣮«ì­¨ª ¬¨ (à §¬¥à LxH â®ç¥ª), ¨§®¡à ¦¥­¨¥ ª®â®àëå åà ­¨âáï
  ¢ L*H-¡ ©â­®¬ ¬ áᨢ¥ Pat;  /á }

Procedure LoadFont (Name : String; Var PF : PFont; Var Size : Word);
{ ‡ £à㦠¥â ¬ âà¨ç­ë© èà¨äâ á ¤¨áª®¢ë¬ ¨¬¥­¥¬ Name, १¥à¢¨àãï ¯ ¬ïâì
  ¤«ï PF, ¢ Size ¢®§¢à é ¥âáï ®¡ê¥¬ § à¥§¥à¢¨à®¢ ­­®© ¯ ¬ïâ¨;
  á®áâ®ï­¨¥ ¢ ¯¥à¥¬¥­­®© GrResult }

Procedure SetFont (PF : PFont);
{ “áâ ­ ¢«¨¢ ¥â ⥪ã騩 èà¨äâ, ¯® 㪠§ â¥«î ­  ­¥£® PF }

Procedure WriteC (X, Y : Word; B, T : Byte; C : Char);
{ Žâ®¡à ¦ ¥â ᨬ¢®« C ¢ ¯®§¨æ¨¨ (X,Y), 梥⮬ T ­  ä®­¥ B;
  ¥á«¨ B = T, â® ä®­ ­¥ ¨§¬¥­ï¥âáï;  /á }

Procedure WriteS (X, Y : Word; B, T : Byte; S : String);
{ €­ «®£¨ç­® ¯à®æ¥¤ãॠWriteC ®â®¡à ¦ ¥â áâபã S;  /á }

Procedure ReadS (X, Y : Word; B, T : Byte; Var S : String; N : Byte);
{ ‘ç¨â뢠¥â (¨§¬¥­ï¥â) á ª« ¢¨ âãàë áâபã S ¬ ªá¨¬ «ì­®© ¤«¨­ë N,
  ®¤­®¢à¥¬¥­­® ¯à®¨§¢®¤¨âáï ¥¥ ®â®¡à ¦¥­¨¥ ­  íªà ­¥, ãá«®¢¨ï
  ®â®¡à ¦¥­¨ï â ª¨¥ ¦¥ ª ª ¨ ¢ ¯à®æ¥¤ãॠWriteC; ¯à¨¬¥ç.: ¯® ª« ¢¨è¥
  ESC ¢¢®¤ § ª ­ç¨¢ ¥âáï á ¢®§¢à é¥­¨¥¬ ¯ãá⮩ áâப¨;  /á }

Function ImageSize (L, H : Word) : Word;
{ ‚®§¢à é ¥â ®¡ê¥¬ âॡ㥬®© ¯ ¬ï⨠¤«ï á®åà ­¥­¨ï ¢ ­¥©
  ¯àאַ㣮«ì­®£® ãç á⪠ ¨§®¡à ¦¥­¨ï à §¬¥à®¬ L x H }

Procedure GetImage (X, Y, L, H : Word; Var BitMap);
{ ‘®åà ­ï¥â ¢ ¯¥à¥¬¥­­®© BitMap ¯àאַ㣮«ì­ë© ãç á⮪ ¨§®¡à ¦¥­¨ï
  ¨§ ¯®§¨æ¨¨ (X,Y) à §¬¥à®¬ L x H;  /á }

Procedure GetClippedImage (X, Y : Integer; L, H : Word; Var BitMap);
{ „¥« ¥â â® ¦¥, çâ® ¨ GetImage, á ⮩ «¨èì à §­¨æ¥©, çâ® ª à⨭ª  ­¥
  ®¡ï§ â¥«ì­® ¤®«¦­  ¯®«­®áâìî 㬥é âìáï ­  íªà ­¥, çâ® ¡ë«® ­¥®¡å®¤¨¬®
  ¤«ï ¯à ¢¨«ì­®© à ¡®âë GetImage }

Procedure PutImage (X, Y : Word; Var BitMap);
{ ‚®ááâ ­ ¢«¨¢ ¥â ¨§ ¯¥à¥¬¥­­®© BitMap ¯àאַ㣮«ì­ë© ãç á⮪
  ¨§®¡à ¦¥­¨ï ¢ ¯®§¨æ¨î (X,Y);  /á }

Procedure PutTranspImage (X, Y : Word; Var BitMap);
{ ‚®ááâ ­ ¢«¨¢ ¥â ¨§ ¯¥à¥¬¥­­®© BitMap "¯à®§à ç­ë©" ¯àאַ㣮«ì­ë©
  ãç á⮪ ¨§®¡à ¦¥­¨ï ¢ ¯®§¨æ¨î (X,Y); 梥⠯஧à ç­®á⨠åà ­¨âáï
  ¢ TranspColor;  /á }

Procedure PutImagePart (X, Y : Word; Var BitMap; PX, PY, PL, PH : Word);
{ Žâ®¡à ¦ ¥â ¯àאַ㣮«ì­ãî ç áâì ®â ª à⨭ª¨ BitMap ¢ ¯®§¨æ¨î (X,Y) ­ 
  íªà ­¥; (PX,PY) - «¥¢ë© ¢¥àå­¨© 㣮« ¯àאַ㣮«ì­¨ª  ¢ ª à⨭ª¥, PL ¨
  PH § ¤ îâ à §¬¥à ¯àאַ㣮«ì­¨ª ;  /á }

Procedure PutTranspImagePart (X, Y : Word; Var BitMap; PX, PY, PL, PH : Word);
{ Žâ®¡à ¦ ¥â ¯àאַ㣮«ì­ãî ç áâì ®â "¯à®§à ç­®©" ª à⨭ª¨ BitMap ¢
  ¯®§¨æ¨î (X,Y) ­  íªà ­¥; (PX,PY) - «¥¢ë© ¢¥àå­¨© 㣮« ¯àאַ㣮«ì­¨ª 
  ¢ ª à⨭ª¥, PL ¨ PH § ¤ îâ à §¬¥à ¯àאַ㣮«ì­¨ª ;  /á }

Procedure PutClippedImage (X, Y : Integer; Var BitMap);
{ „¥« ¥â â® ¦¥, çâ® ¨ PutImage, á ⮩ «¨èì à §­¨æ¥©, çâ® ª à⨭ª  ­¥
  ®¡ï§ â¥«ì­® ¤®«¦­  ¯®«­®áâìî 㬥é âìáï ­  íªà ­¥, çâ® ¡ë«® ­¥®¡å®¤¨¬®
  ¤«ï ¯à ¢¨«ì­®© à ¡®âë PutImage }

Procedure PutTranspClippedImage (X, Y : Integer; Var BitMap);
{ „¥« ¥â â® ¦¥, çâ® ¨ PutImage, á ⮩ «¨èì à §­¨æ¥©, çâ® "¯à®§à ç­ ï"
  ª à⨭ª  ­¥ ®¡ï§ â¥«ì­® ¤®«¦­  ¯®«­®áâìî 㬥é âìáï ­  íªà ­¥,
  çâ® ¡ë«® ­¥®¡å®¤¨¬® ¤«ï ¯à ¢¨«ì­®© à ¡®âë PutImage }

Procedure PutClippedImagePart (X, Y : Integer; Var BitMap; PX, PY, PL, PH : Word);
{ „¥« ¥â â® ¦¥, çâ® ¨ PutImagePart, á ⮩ «¨èì à §­¨æ¥©, çâ®
  ª à⨭ª  ­¥ ®¡ï§ â¥«ì­® ¤®«¦­  ¯®«­®áâìî 㬥é âìáï ­  íªà ­¥,
  çâ® ¡ë«® ­¥®¡å®¤¨¬® ¤«ï ¯à ¢¨«ì­®© à ¡®âë PutImagePart }

Procedure PutTranspClippedImagePart (X, Y : Integer; Var BitMap; PX, PY, PL, PH : Word);
{ „¥« ¥â â® ¦¥, çâ® ¨ PutTranspImagePart, á ⮩ «¨èì à §­¨æ¥©, çâ®
  "¯à®§à ç­ ï" ª à⨭ª  ­¥ ®¡ï§ â¥«ì­® ¤®«¦­  ¯®«­®áâìî 㬥é âìáï ­ 
  íªà ­¥, çâ® ¡ë«® ­¥®¡å®¤¨¬® ¤«ï ¯à ¢¨«ì­®© à ¡®âë PutTranspImagePart }

Procedure LoadObject (Name : String; Var PBitMap : Pointer; Var Size : Word);
{ ‡ £à㦠¥â ¯àאַ㣮«ì­ãî ª à⨭ªã á ¤¨áª®¢ë¬ ¨¬¥­¥¬ Name,
  १¥à¢¨àãï ¯ ¬ïâì ¤«ï PBitMap, ¢ Size ¢®§¢à é ¥âáï ®¡ê¥¬
  § à¥§¥à¢¨à®¢ ­­®© ¯ ¬ïâ¨; ¢®§¬®¦­® ¯®á«¥¤ãî饥 ®â®¡à ¦¥­¨¥
  á ¯®¬®éìî ¢á直å PutImage'© }

Procedure LoadPCX256 (Name : String; Var PBitMap : Pointer; Var Size : Word;
                      Var Pal : TPal);
{ ‡ £à㦠¥â ¯àאַ㣮«ì­ãî 256 梥â­ãî PCX-ª à⨭ªã á ¤¨áª®¢ë¬ ¨¬¥­¥¬
  Name, १¥à¢¨àãï ¯ ¬ïâì ¤«ï PBitMap, ¢ Size ¢®§¢à é ¥âáï ®¡ê¥¬
  § à¥§¥à¢¨à®¢ ­­®© ¯ ¬ïâ¨; ¢®§¬®¦­® ¯®á«¥¤ãî饥 ®â®¡à ¦¥­¨¥
  á ¯®¬®éìî ¢á¥å PutImage'©, ªà®¬¥ PutImageM }

Procedure SavePCX256 (Name : String; X, Y, L, H : Word);
{ ‡ ¯¨á뢠¥â ¢ ä ©« á ¨¬¥­¥¬ Name ¯àאַ㣮«ì­ë© ãç á⮪ ¨§®¡à ¦¥­¨ï
  á  ªâ¨¢­®© áâà ­¨æë ¢ ä®à¬ â¥ PCX; (X,Y) ¨ LxH - ª®®à¤¨­ âë ¨
  à §¬¥àë ãç á⪠ ¨§®¡à ¦¥­¨ï ­  áâà ­¨æ¥ }

Procedure PutImageM (X, Y : Word; Var BitMap);
{ ‚®ááâ ­ ¢«¨¢ ¥â ¨§ ¯¥à¥¬¥­­®© BitMap ¯àאַ㣮«ì­ë© ãç á⮪
  ¨§®¡à ¦¥­¨ï, ¨¬¥î饣® ¬ áªã, ¢ ¯®§¨æ¨î (X,Y); ¢­ ç «¥ ­  íªà ­
  ­ ª« ¤ë¢ ¥âáï ¯® AND ¬ áª , § â¥¬ ­ ª« ¤ë¢ ¥âáï ¯® XOR á ¬ 
  ª à⨭ª , - íâ® ¤«ï ⮣®, çâ®¡ë ¨§®¡à ¦¥­¨¥ ­  íªà ­¥ ­¥
  ¢ë£«ï¤¥«® 祬-â® ­  ä®­¥ ­¥¯®­ïâ­®© ¯àאַ㣮«ì­®© ⥭¨
  (¨­ë¬¨ á«®¢ ¬¨, çâ®¡ë ­¥ § â¨à «áï ¯®«­®áâìî ä®­ ª à⨭ª¨);  /á }

Procedure SetActivePage (PageSeg : Word);
{ ¥à¥ª«îç ¥â  ªâ¨¢­ãî áâà ­¨æã, ªã¤  ¡ã¤¥â ¢ë¢®¤¨âáï £à ä¨ç¥áª ï
  ¨­ä®à¬ æ¨ï, â®ç­¥¥ ¯¥à¥ª«îç ¥â ᥣ¬¥­â ¯ ¬ï⨠í⮩ áâà ­¨æë,
  ¯à¨¬¥ç.: ¯®¤ áâà ­¨æã ¤®«¦­  ¡ëâì § à¥§¥à¢¨à®¢ ­  ¯ ¬ïâì ®¡ê¥¬®¬
  64000 ¡ ©â,   çâ®¡ë ¯¥à¥ª«îç¨âìáï ­  ®â®¡à ¦ ¥¬ãî áâà ­¨æã,
  ¤®áâ â®ç­® 㪠§ âì PageSeg à ¢­ë¬ VSeg ($A000) }

Procedure DisplayPage (PageSeg : Word);
{ Žâ®¡à ¦ ¥â  ªâ¨¢­ãî áâà ­¨æã ¯® ¥¥ ᥣ¬¥­âã PageSeg ­  íªà ­ }

Procedure DisplayBox (PageSeg, X, Y, L, H : Word);
{ Žâ®¡à ¦ ¥â ¯àאַ㣮«ì­ë© ãç á⮪  ªâ¨¢­®© áâà ­¨æë ¯® ¥¥
  ᥣ¬¥­âã ¯ ¬ï⨠¨ ¯ à ¬¥âà ¬ ãç á⪠: (X,Y) ¨ LxH }

Procedure WaitRetrace;
{ „®¦¨¤ ¥âáï ¬®¬¥­â  ¢®§¢à â  «ãç  ¨§ ¯à ¢®£® ­¨¦­¥£® 㣫  í«¥ªâà®­­®- }
{ «ã祢®© âà㡪¨ ¢ «¥¢ë© ¢¥àå­¨©. ƒà ä¨ç¥áª¨¥ ¬ ­¨¯ã«ï樨 ¢ íâ®â ¬®¬¥­â}
{ ­¥ ¡ã¤ãâ ¢ë§ë¢ â¨ ¬¥«ìª ­¨ï ­  íªà ­¥. ‚ íâ®â ¬®¬¥­â 㤮¡­® ¬¥­ïâì   }
{ ¯ «¨âàã; ¢®ááâ ­ ¢«¨¢ âì ä®­®¢®¥ ¨§®¡à ¦¥­¨¥ ¯®¤ á¯à ©â®¬ ¨          }
{ à¨á®¢ âì ¤à㣮© á¯à ©â ¢ í⮩ ¯®§¨æ¨¨ ¨«¨ â®â çâ® ¡ë«, ­® ¢          }
{ ¤à㣮© ¯®§¨æ¨¨.                                                      }

Procedure GetCRGB (C : Byte; Var R, G, B : Byte);
{ ‚®§¢à é ¥â ᮤ¥à¦ ­¨¥ ªà á­®©, §¥«¥­®© ¨ ᨭ¥© ª®¬¯®­¥­â ¤«ï
  æ¢¥â  C ¢ ⥪ã饩 ¯ «¨âॠ}

Procedure SetCRGB (C : Byte; R, G, B : Byte);
{ “áâ ­ ¢«¨¢ ¥â ᮤ¥à¦ ­¨¥ ªà á­®©, §¥«¥­®© ¨ ᨭ¥© ª®¬¯®­¥­â ¤«ï
  æ¢¥â  C ¢ ⥪ã饩 ¯ «¨âॠ}

Procedure GetPal (Var Pal);
{ ‚®§¢à é ¥â ¢ Pal ⥪ãéãî ¯ «¨âàã }

Procedure SetPal (Var Pal);
{ “áâ ­ ¢«¨¢ ¥â ¯ «¨âàã Pal ⥪ã饩 }

Procedure FadeUp (Pal : TPal);
{ « ¢­® "¯à®ï¢«ï¥â" ⥪ãéãî ¯ «¨âàã ¤® ¯ «¨âàë Pal }

Procedure FadeDown;
{ « ¢­® "£ á¨â" ⥪ãéãî ¯ «¨âàã }

Procedure BlackOutPut;
{ Ž¡­ã«ï¥â ⥪ãéãî ¯ «¨âàã, ¤¥« ï ¥¥ ç¥à­®© }

Procedure TextureMapPoly (X1,Y1, X2,Y2, X3,Y3, X4,Y4, L, H : Integer;
                                                             PicSeg : Word);
{ ‡ «¨¢ ¥â ç¥âëà¥ã£®«ì­¨ª á § ¤ ­­ë¬¨ ª®®à¤¨­ â ¬¨ ⥪áâãன;
  PicSeg - ᥣ¬¥­â  ¤à¥á  ⥪áâãàë, à §¬¥é¥­­®© ¢ ªãç¥ (¯à¨
  ¯®¬®é¨ GetMem ¨«¨ New), LxH - à §¬¥à ⥪áâãàë; ¯à¨¬¥ç ­¨¥:
  ¯¥à¢ ï ª®®à¤¨­ â  ᮮ⢥âáâ¢ã¥â «¥¢®¬ã ¢¥àå­¥¬ã 㣫ã ⥪áâãàë,
  ª®®à¤¨­ âë à á¯®« £ îâáï ¯® ç á®¢®© áâ५ª¥ }

Procedure TextureMapPoly2 (X1,Y1, X2,Y2, X3,Y3, X4,Y4, L, H : Integer;
                                                   N : Byte; PicSeg : Word);
{ ‚믮«­ï¥â â® ¦¥, çâ® ¨ ¯à®æ¥¤ãà  TextureMapPoly, ­® á ⮩ }  { N: ÚÄÂÄ¿ }
{ à §­¨æ¥©, çâ® ¢ L ¨ H 㪠§ë¢ îâáï à §¬¥àë ç¥â¢¥à⨠⥪áâãàë }   { ³0³1³ }
{ (¯®«®¢¨­ë è¨à¨­ë ¨ ¢ëá®âë ⥪áâãàë),   ¢ N - ­®¬¥à ç¥â¢¥à⨠}   { ÃÄÅÄ´ }
{ ⥪áâãàë. ã¦­® íâ® ¤«ï ¨§®¡à ¦¥­¨ï ¡«¨§ª¨å ª £« §ã âà¥å-   }   { ³2³3³ }
{ ¬¥à­ëå ®¡ê¥ªâ®¢, ª®â®àë¥ ¢ë£«ï¤ïâ ¯à®á⮠㦠᭮ ¯à¨ ¨á¯®«ì- }   { ÀÄÁÄÙ }
{ §®¢ ­¨¨ TextureMapPoly. }

Procedure DisplayOff;
{ "‚몫îç ¥â" ¤¨á¯«¥© - ®­ áâ ­®¢¨âáï ç¥à­ë¬ (£à ä¨ç¥áª¨© ०¨¬) }

Procedure DisplayOn;
{ "‚ª«îç ¥â" ¤¨á¯«¥© - ¨§®¡à ¦¥­¨¥ ¯®ï¢«ï¥âáï ¢­®¢ì (£à ä¨ç¥áª¨© ०¨¬) }

Implementation

Uses
  CRT, Packer;

Function IsVGA : Boolean; Assembler;
Asm
  Mov   AX, 1A00h
  Int   10h
  Cmp   AL, 1Ah
  JNE   @@NotVGA
  Cmp   BL, 7
  JE    @@VGA
  Cmp   BL, 8
  JE    @@VGA
@@NotVGA:
  Mov   AL, 0
  Jmp   @@Quit
@@VGA:
  Mov   AL, 1
@@Quit:
End;

Procedure InitGraph; Assembler;
Asm
  Mov   AX, 013H
  Int   010H
  Mov   AH, 00FH
  Int   010H
  Cmp   AL, 013H
  JNE   @1
  Mov   GrResult, GrOk
  Jmp   @2
@1:
  Mov   GrResult, GrInit
@2:
End;

Procedure CloseGraph; Assembler;
Asm
  Mov   AX, 003H
  Int   010H
End;

Procedure ClearScreen (C : Byte); Assembler;
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Xor   DI, DI
  CLD
  Mov   AL, C
  Mov   AH, AL
  Mov   CX, 32000
  Rep   STOSW
End;

Procedure Border (C : Byte); Assembler;
Asm
  Mov   AX, 01001H
  Mov   BH, C
  Int   010H
End;

Procedure PutPixel (X, Y : Word; C : Byte); Assembler;
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AL, C
  STOSB
End;

Function GetPixel (X, Y : Word) : Byte; Assembler;
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AL, ES:[DI]
End;

Procedure LineH (X, Y, L : Word; C : Byte); Assembler;
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AL, C
  Mov   CX, L
  CLD
  Rep   STOSB
End;

Procedure LineV (X, Y, H : Word; C : Byte); Assembler;
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AL, C
  Mov   CX, H
  CLD
@1:
  STOSB
  Add   DI, 319
  Loop  @1
End;

Function Sgn (I : Integer) : Integer; Assembler;
Asm
  Mov   AX, I
  Or    AX, AX
  JZ    @end
  ShL   AX, 1
  JC    @1
  Mov   AX, 1
  Jmp   @end
@1:
  Mov   AX, -1
@end:
End;

Function _Abs (I : Integer) : Integer; Assembler;
Asm
  Mov   AX, I
  Test  AX, 8000h
  JZ    @end
  Neg   AX
@end:
End;

Procedure Line (X1, Y1, X2, Y2 : Word; C : Byte);
Var
  SX, SY, M, N,
  DX1, DY1, DX2, DY2 : Integer;
Begin
  SX := X2-X1;
  SY := Y2-Y1;
  DX1 := Sgn (SX);
  DY1 := Sgn (SY);
  M := _Abs (SX);
  N := _Abs (SY);
  DX2 := DX1;
  DY2 := 0;
  If M < N then
    Begin
      M := _Abs (SY);
      N := _Abs (SX);
      DX2 := 0;
      DY2 := DY1
    End;
  Asm
    Mov   AX, VSegA
    Mov   ES, AX
    Mov   DI, X1
    Mov   BX, Y1
    ShL   BX, 6
    Add   DI, BX
    ShL   BX, 2
    Add   DI, BX                                { ES:DI = ^ ­  ¯¥à¢ãî â®çªã }

    Mov   AX, DY1
    Test  AX, 8000h
    JZ    @lb0
    Neg   AX
    ShL   AX, 6
    Mov   BX, AX
    ShL   AX, 2
    Add   BX, AX
    Neg   BX
    Jmp   @lb1
@lb0:
    ShL   AX, 6
    Mov   BX, AX
    ShL   AX, 2
    Add   BX, AX
@lb1:
    Add   BX, DX1

    Mov   AX, DY2
    Test  AX, 8000h
    JZ    @lb2
    Neg   AX
    ShL   AX, 6
    Mov   DX, AX
    ShL   AX, 2
    Add   DX, AX
    Neg   DX
    Jmp   @lb3
@lb2:
    ShL   AX, 6
    Mov   DX, AX
    ShL   AX, 2
    Add   DX, AX
@lb3:
    Add   DX, DX2

    Mov   AL, C
    Xor   SI, SI
    Mov   CX, M
    Inc   CX
@cycle:
    Mov   ES:[DI], AL
    Add   SI, N
    Cmp   SI, M
    JC    @cl1
    Sub   SI, M
    Add   DI, BX                                { + ‘¬¥é¥­¨¥ á«¥¤. í«¥¬¥­â  }
    Loop  @cycle
    Jmp   @end
@cl1:
    Add   DI, DX                                { + ‘¬¥é¥­¨¥ á«¥¤. â®çª¨ }
    Loop  @cycle
@end:
  End
End;

Procedure Box (X, Y, L, H : Word; C : Byte; Fill : Boolean);
Begin
  If L or H = 0 then Exit;
  If not Fill then
    Begin
      LineH (X, Y, L, C);
      LineH (X, Y+H-1, L, C);
      LineV (X, Y, H, C);
      LineV (X+L-1, Y, H, C)
    End
  Else
    Asm
      Mov   AX, VSegA
      Mov   ES, AX
      Mov   DI, X
      Mov   BX, Y
      ShL   BX, 6
      Add   DI, BX
      ShL   BX, 2
      Add   DI, BX
      CLD
      Mov   BX, L
      Mov   DX, H
      Mov   AL, C
@1:
      Push  DI
      Mov   CX, BX
      Rep   STOSB
      Pop   DI
      Add   DI, 320
      Dec   DX
      JNZ   @1
    End
End;

Function SqrWN (X : Word) : Byte; Assembler; { Yi+1 = (Yi + X/Yi) / 2 }
{ ‚®§¢à é ¥â ª®à¥­ì, ª¢ ¤à â ª®â®à®£® ï¥âáï ¡«¨¦ ©è¨¬ ª  à£ã¬¥âã }
Asm
  Mov   CX, X
  Push  BP
  Mov   BP, 1
  Mov   BX, CX
  JCXZ  @end2
  Cmp   CX, 0FFFFH
  JNE   @cycle
  Mov   BX, 0FFH
  Jmp   @end2
@cycle:
  Xor   DX, DX
  Mov   AX, CX
  Div   BX
  Add   AX, BX
  Shr   AX, 1
  Mov   DI, SI
  Mov   SI, BX
  Mov   BX, AX
  Inc   BP
  Cmp   BX, SI
  JE    @end
  Cmp   BP, 3
  JC    @cycle
  Cmp   BX, DI
  JNE   @cycle
  Cmp   SI, BX
  JNC   @end
  Mov   BX, SI
@end:
  Mov   AX, BX
  Mul   BX
  Sub   AX, CX
  Neg   AX
  Inc   AX
  Mov   SI, AX                  { à §­¨æ   à£ã¬¥­â  ¨ ª¢ ¤à â  ª®à­ï }
  Inc   BX
  Mov   AX, BX
  Mul   BX
  Sub   AX, CX                  { à §­¨æ   à£. ¨ ª¢ ¤à â  㢥«¨ç¥­­®£® ª®à­ï }
  Cmp   AX, SI
  JC    @end2
  Dec   BX
@end2:
  Pop   BP
  Mov   AX, BX
End;

Procedure Circle (X, Y, R : Word; C : Byte; Fill : Boolean);
Var
  A, B : Word;
begin
  If R = 0 then Exit;
  If not Fill then
    For A := 0 to R do
      Begin
        B := SqrWN(Sqr(R)-Sqr(A));
        PutPixel (X-A, Y-B, C);
        PutPixel (X+A, Y-B, C);
        PutPixel (X-A, Y+B, C);
        PutPixel (X+A, Y+B, C);
        PutPixel (X-B, Y-A, C);
        PutPixel (X-B, Y+A, C);
        PutPixel (X+B, Y-A, C);
        PutPixel (X+B, Y+A, C)
      End
  Else
    For A := 0 to R do
      Begin
        B := SqrWN(Sqr(R)-Sqr(A));
        LineH (X-B, Y-A, 1+B shl 1, C);
        LineH (X-B, Y+A, 1+B shl 1, C)
      End
End;

Procedure Fill (X, Y : Word; C : Byte);
Var
  P1, P2     : Pointer;
  Sg1, Sg2, P,
  ZX, ZY, ZP : Word;
  CO         : Byte;
Begin
  GetMem (P1, 64000);
  GetMem (P2, 64000);
  Sg1 := Seg(P1^);
  Sg2 := Seg(P2^);
Asm
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AL, ES:[DI]
  Cmp   AL, C
  JE    @end
  Mov   CO, AL
  Mov   ZP, 0
  Mov   AX, X
  Mov   ZX, AX
  Mov   AX, Y
  Mov   ZY, AX
@cycle:
  Mov   AX, VSegA
  Mov   ES, AX
  Mov   DI, ZX
  Mov   BX, ZY
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   P, DI
  Mov   AL, C
  Mov   ES:[DI], AL

  Mov   AX, ZX
  Or    AX, AX
  JZ    @l2
  Mov   AL, ES:[DI-1]
  Cmp   AL, CO
  JNE   @l2
  Dec   DI
  Push  ES
  Mov   AX, Sg1
  Mov   BX, ZP
  Cmp   BX, 32000
  JC    @l1
  Mov   AX, Sg2
  Sub   BX, 32000
@l1:
  Mov   ES, AX
  Shl   BX, 1
  Mov   ES:[BX], DI
  Inc   ZP
  Pop   ES
  Inc   DI
@l2:
  Mov   AX, ZX
  Cmp   AX, 319
  JNC   @r2
  Mov   AL, ES:[DI+1]
  Cmp   AL, CO
  JNE   @r2
  Inc   DI
  Push  ES
  Mov   AX, Sg1
  Mov   BX, ZP
  Cmp   BX, 32000
  JC    @r1
  Mov   AX, Sg2
  Sub   BX, 32000
@r1:
  Mov   ES, AX
  Shl   BX, 1
  Mov   ES:[BX], DI
  Inc   ZP
  Pop   ES
  Dec   DI
@r2:
  Mov   AX, ZY
  Or    AX, AX
  JZ    @u2
  Mov   AL, ES:[DI-320]
  Cmp   AL, CO
  JNE   @u2
  Sub   DI, 320
  Push  ES
  Mov   AX, Sg1
  Mov   BX, ZP
  Cmp   BX, 32000
  JC    @u1
  Mov   AX, Sg2
  Sub   BX, 32000
@u1:
  Mov   ES, AX
  Shl   BX, 1
  Mov   ES:[BX], DI
  Inc   ZP
  Pop   ES
  Add   DI, 320
@u2:
  Mov   AX, ZY
  Cmp   AX, 199
  JNC   @d2
  Mov   AL, ES:[DI+320]
  Cmp   AL, CO
  JNE   @d2
  Add   DI, 320
  Push  ES
  Mov   AX, Sg1
  Mov   BX, ZP
  Cmp   BX, 32000
  JC    @d1
  Mov   AX, Sg2
  Sub   BX, 32000
@d1:
  Mov   ES, AX
  Shl   BX, 1
  Mov   ES:[BX], DI
  Inc   ZP
  Pop   ES
  Sub   DI, 320
@d2:
  Mov   BX, ZP
  Or    BX, BX
  JZ    @end
  Dec   BX
  Mov   ZP, BX
  Mov   AX, Sg1
  Cmp   BX, 32000
  JC    @p1
  Mov   AX, Sg2
  Sub   BX, 32000
@p1:
  Mov   ES, AX
  Shl   BX, 1
  Mov   AX, ES:[BX]
  Mov   P, AX

  Mov   AX, P
  Xor   DX, DX
  Mov   BX, 320
  Div   BX
  Mov   ZY, AX
  Mov   ZX, DX
  Jmp   @cycle
@end:
End;
  FreeMem (P2, 64000);
  FreeMem (P1, 64000)
End;

Procedure DrawPoly (Num : Word; PolyPoints : Array of TPoint; C : Byte);
Var I : Word;
Begin
  If Num > 1 then
    For I := 0 to Num-2 do Begin
      Line (PolyPoints[I].X, PolyPoints[I].Y,
            PolyPoints[I+1].X, PolyPoints[I+1].Y, C)
    End
End;

Procedure DrawPoly2 (Num : Word; PolyPoints : Array of TPoint; C : Byte);
Var I : Word;
Begin
  If Num > 0 then Begin
    For I := 0 to Num-2 do Begin
      Line (PolyPoints[I].X, PolyPoints[I].Y,
            PolyPoints[I+1].X, PolyPoints[I+1].Y, C)
    End;
    Line (PolyPoints[Num-1].X, PolyPoints[Num-1].Y,
          PolyPoints[0].X, PolyPoints[0].Y, C)
  End
End;

Procedure FillPoly (Num : Word; PolyPoints : Array of TPoint; C : Byte);
Var I, Y, Ymin, Ymax : Integer;
  Procedure DoSide (X1, Y1, X2, Y2 : Integer);
  Var
    Temp, I, X, Y,
    SX, SY, M, N,
    DX1, DY1, DX2, DY2 : Integer;
  Begin
    SX := X2-X1; SY := Y2-Y1;
    DX1 := Sgn(SX); DY1 := Sgn(SY);
    M := _Abs(SX); N := _Abs(SY);
    DX2 := DX1; DY2 := 0;
    If M < N then Begin
      M := _Abs(SY); N := _Abs(SX);
      DX2 := 0; DY2 := DY1
    End;
    X := X1; Y := Y1;
    Temp := 0;
    For I := 0 to M do Begin
      If (Y >= 0) and (Y <= 199) then Begin
        If X < _Poly[Y,1] then _Poly[Y,1] := X;
        If X > _Poly[Y,2] then _Poly[Y,2] := X
      End;
      Inc (Temp, N);
      If Temp < M then Begin
        Inc (X, DX2); Inc (Y, DY2)
      End
      Else Begin
        Dec (Temp, M);
        Inc (X, DX1); Inc (Y, DY1)
      End
    End
  End;
Begin
  If Num < 3 then Exit;
  Ymin := PolyPoints[0].Y; Ymax := Ymin;
  For I := 0 to Num-1 do Begin
    If PolyPoints[I].Y < Ymin then Ymin := PolyPoints[I].Y;
    If PolyPoints[I].Y > Ymax then Ymax := PolyPoints[I].Y
  End;
  If (Ymin > 199) or (Ymax < 0) then Exit;
  If Ymin < 0 then Ymin := 0; If Ymax > 199 then Ymax := 199;
  For Y := Ymin to Ymax do Begin
    _Poly[Y,1] := 320; _Poly[Y,2] := -1
  End;
  For I := 0 to Num-2 do
    DoSide (PolyPoints[I].X, PolyPoints[I].Y,
            PolyPoints[I+1].X, PolyPoints[I+1].Y);
  DoSide (PolyPoints[Num-1].X, PolyPoints[Num-1].Y,
          PolyPoints[0].X, PolyPoints[0].Y);
  For Y := Ymin to Ymax do Begin
    If _Poly[Y,1] < 0 then _Poly[Y,1] := 0;
    If _Poly[Y,2] > 319 then _Poly[Y,2] := 319;
    LineH (_Poly[Y,1], Y, _Poly[Y,2]-_Poly[Y,1]+1, C)
  End
End;

Procedure FillPolyPat (Num : Word; PolyPoints : Array of TPoint;
                                                L, H : Word; Var Pat);
Var
  I, X, Y, Ymin, Ymax : Integer;
  PA : Array [0..63999] of byte absolute Pat;
  Procedure DoSide (X1, Y1, X2, Y2 : Integer);
  Var
    Temp, I, X, Y,
    SX, SY, M, N,
    DX1, DY1, DX2, DY2 : Integer;
  Begin
    SX := X2-X1; SY := Y2-Y1;
    DX1 := Sgn(SX); DY1 := Sgn(SY);
    M := _Abs(SX); N := _Abs(SY);
    DX2 := DX1; DY2 := 0;
    If M < N then Begin
      M := _Abs(SY); N := _Abs(SX);
      DX2 := 0; DY2 := DY1
    End;
    X := X1; Y := Y1;
    Temp := 0;
    For I := 0 to M do Begin
      If (Y >= 0) and (Y <= 199) then Begin
        If X < _Poly[Y,1] then _Poly[Y,1] := X;
        If X > _Poly[Y,2] then _Poly[Y,2] := X
      End;
      Inc (Temp, N);
      If Temp < M then Begin
        Inc (X, DX2); Inc (Y, DY2)
      End
      Else Begin
        Dec (Temp, M);
        Inc (X, DX1); Inc (Y, DY1)
      End
    End
  End;
Begin
  If Num < 3 then Exit;
  Ymin := PolyPoints[0].Y; Ymax := Ymin;
  For I := 0 to Num-1 do Begin
    If PolyPoints[I].Y < Ymin then Ymin := PolyPoints[I].Y;
    If PolyPoints[I].Y > Ymax then Ymax := PolyPoints[I].Y
  End;
  If (Ymin > 199) or (Ymax < 0) then Exit;
  If Ymin < 0 then Ymin := 0; If Ymax > 199 then Ymax := 199;
  For Y := Ymin to Ymax do Begin
    _Poly[Y,1] := 320; _Poly[Y,2] := -1
  End;
  For I := 0 to Num-2 do
    DoSide (PolyPoints[I].X, PolyPoints[I].Y,
            PolyPoints[I+1].X, PolyPoints[I+1].Y);
  DoSide (PolyPoints[Num-1].X, PolyPoints[Num-1].Y,
          PolyPoints[0].X, PolyPoints[0].Y);
  For Y := Ymin to Ymax do Begin
    If _Poly[Y,1] < 0 then _Poly[Y,1] := 0;
    If _Poly[Y,2] > 319 then _Poly[Y,2] := 319;
    I := L * (Y mod H);
    For X := _Poly[Y,1] to _Poly[Y,2] do
      PutPixel (X, Y, PA[I + (X mod 8)])
  End
End;

Procedure LoadFont (Name : String; Var PF : PFont; Var Size : Word);
Var
  F : File;
Label
  LErr;
Begin
  PF := nil;
  Assign (F, Name);
  {$i-}
  Reset (F, 1);
  {$i+}
  If IOResult <> 0 then
    Begin
LErr:
      If PF <> nil then
        FreeMem (PF, Size);
      PF := nil;
      Size := 0;
      GrResult := GrLoadFont;
      Exit
    End;
  {$i-} Size := FileSize(F); {$i+}
  If IOResult <> 0 then Goto LErr;
  GetMem (PF, Size);
  {$i-} BlockRead (F, PF^, Size); {$i+}
  If IOResult <> 0 then Goto LErr;
  {$i-} Close (F); {$i+}
  If IOResult <> 0 then Goto LErr;
  GrResult := GrOk
End;

Procedure SetFont (PF : PFont);
Begin
  FontX := Lo(Word(PF^));
  FontY := Hi(Word(PF^));
  CurFont := PF
End;

Procedure WriteC (X, Y : Word; B, T : Byte; C : Char); Assembler;
Asm
  Push  BP
  Push  DS
  Mov   AX, Word Ptr CurFont+2
  Mov   ES, AX
  Mov   DI, Word Ptr CurFont            { ES:DI - Font Addr }
  Mov   CX, AX
  Or    CX, DI
  JZ    @End                            { ES:DI - nil }
  Add   DI, 2
  Xor   AH, AH
  Mov   AL, C
  Shl   AX, 1
  Shl   AX, 1
  Shl   AX, 1
  Add   DI, AX                          { ES:DI - Char Addr }
  Mov   AH, FontY
  Mov   AL, FontX                       { Char size -> stack }
  Push  AX
  Mov   AX, VSegA
  Mov   DS, AX
  Mov   AX, Y
  Mov   BX, 320
  Mul   BX
  Add   AX, X
  Mov   BX, AX                          { DS:BX - Screen Addr }
  Mov   DH, B
  Mov   DL, T                           { DX - Colors Back & Text }
  Mov   AX, SP
  Mov   BP, AX
  Mov   CH, SS:[BP+1]
@1:
  Mov   CL, SS:[BP]
  Push  BX
  Mov   AL, ES:[DI]
@2:
  Mov   AH, DL
  Shl   AL, 1
  JC    @Put
  Cmp   DH, DL
  JE    @NoPut
  Mov   AH, DH
@Put:
  Mov   DS:[BX], AH
@NoPut:
  Inc   BX
  Dec   CL
  JNZ   @2
  Inc   DI
  Pop   BX
  Add   BX, 320
  Dec   CH
  JNZ   @1
  Pop   AX
@End:
  Pop   DS
  Pop   BP
End;

Procedure WriteS (X, Y : Word; B, T : Byte; S : String);
Var
  N  : Byte;
Begin
  If S = '' then Exit;
  For N := 1 to Length(S) do
    Begin
      WriteC (X, Y, B, T, S[N]);
      Inc (X, FontX)
    End
End;

Procedure ReadS (X, Y : Word; B, T : Byte; Var S : String; N : Byte);
Const
  CM = 20;
Var
  C : Char;
  P : Byte;
  Cnt : Byte;
Begin
  Box (X, Y, N*FontX, FontY, B, True);
  WriteS (X, Y, B, T, S);
  P := Length(S);
  If P < N then
    WriteC (X+P*FontX, Y, B, T, '_');
  Cnt := 0;
  Repeat
    If KeyPressed then C := ReadKey
    Else C := #$FF;
    If C = #0 then
      Begin
        ReadKey;
        C := #$FF
      End;
    If C = #27 then
      Begin
        S := '';
        Break
      End;
    If C = #13 then Break;
    If (C = #8) and (P > 0) then
      Begin
        Dec (S[0]);
        If P < N then
          WriteC (X+P*FontX, Y, B, T, ' ');
        Dec (P);
        WriteC (X+P*FontX, Y, B, T, '_');
        Continue
      End;
    If (C in [#32..#254]) and (P < N) then
      Begin
        S := S + C;
        WriteC (X+P*FontX, Y, B, T, C);
        Inc (P);
        If P < N then
          WriteC (X+P*FontX, Y, B, T, '_')
      End;
      Delay (20);
      Inc (Cnt);
      If Cnt = CM then Cnt := 0;
      If P < N then
        If Cnt < CM div 2 then
          WriteC (X+P*FontX, Y, B, T, '_')
        Else
          WriteC (X+P*FontX, Y, B, T, ' ')
  Until False
End;

Function ImageSize (L, H : Word) : Word;
Begin
  ImageSize := 4+L*H
End;

Procedure GetImage (X, Y, L, H : Word; Var BitMap); Assembler;
Asm
  Push  DS
  Mov   AX, H
  Push  AX
  Mov   DX, L
  LES   DI, BitMap                      { ES:DI - Memory Addr (BitMap^) }
  Mov   SI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   SI, BX
  ShL   BX, 2
  Add   SI, BX
  Mov   AX, VSegA
  Mov   DS, AX                          { DS:SI - Screen Addr }
  Mov   ES:[DI], DX
  Pop   AX
  Mov   ES:[DI+2], AX                   { L & H -> BitMap }
  Add   DI, 4
  CLD
  Shr   DX, 1
  JC    @2                              { If L is ODD }
@1:
  Mov   BX, SI
  Mov   CX, DX
  Rep   MovSW
  Mov   SI, BX
  Add   SI, 320
  Dec   AX
  JNZ   @1
  Pop   DS
  Jmp   @end
@2:
  Mov   BX, SI
  Mov   CX, DX
  MovSB
  Rep   MovSW
  Mov   SI, BX
  Add   SI, 320
  Dec   AX
  JNZ   @2
  Pop   DS
@end:
End;

Procedure GetImagePart (X, Y, L, H : Word; Var BitMap; PX, PY, PL, PH : Word); Assembler;
Asm
  Push  DS
  Push  BP
  Mov   SI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   SI, BX
  ShL   BX, 2
  Add   SI, BX
  Mov   AX, VSegA
  Mov   DS, AX                          { DS:SI - Screen Addr }

  LES   DI, BitMap                      { ES:DI - ^BitMap }
  Mov   AX, L
  Mov   Word Ptr ES:[DI], AX
  Mov   AX, H
  Mov   Word Ptr ES:[DI+2], AX

  Mov   AX, PY
  Mul   L                               { DX:AX - vertical offset in image }
  Add   AX, 4
  Add   AX, PX

  Mov   DX, PL                          { Output length }
  Mov   BX, PH                          { Output height }
  Mov   BP, L                           { Image length }

  Add   DI, AX                          { ES:DI - correct starting addr }

  CLD
  Shr   DX, 1
  JC    @2
@1:
  Mov   AX, SI
  Mov   CX, DX
  Push  DI
  Rep   MovSW
  Pop   DI
  Add   DI, BP
  Mov   SI, AX
  Add   SI, 320
  Dec   BX
  JNZ   @1
  Jmp   @end
@2:
  Mov   AX, SI
  Mov   CX, DX
  Push  DI
  Rep   MovSW
  MovSB
  Pop   DI
  Add   DI, BP
  Mov   SI, AX
  Add   SI, 320
  Dec   BX
  JNZ   @2
@end:
  Pop   BP
  Pop   DS
End;

Procedure GetClippedImage (X, Y : Integer; L, H : Word; Var BitMap);
Var
  Dims : Array [0..1] of Word absolute BitMap; {Dims[0]=Length;Dims[1]=Height}
  RX, RY, RL, RH, IX, IY : Integer;
Begin
  If (X > 319) or (Y > 199) then Exit;          { Image is out of screen }
  RX := X; RY := Y;                             { Start X & Y at screen }
  RL := L; RH := H;                             { Length & Height at begining }
  IX := 0; IY := 0;                             { IX & IY - coos in image to }
                                                { start drawin it (at begining) }
  If RX < 0 then Begin
    Inc (RL, RX);                               { Output length corrected }
    Dec (IX, RX);                               { IX corrected }
    RX := 0                                     { Screen X corrected }
  End;
  If RY < 0 then Begin
    Inc (RH, RY);                               { Output height corrected }
    Dec (IY, RY);                               { IY corrected }
    RY := 0                                     { Screen Y corrected }
  End;
  If (RL <= 0) or (RH <= 0) then Exit;          { Image is out of screen }
  If RX+RL > 320 then RL := 320-RX;             { Last correct in a length }
  If RY+RH > 200 then RH := 200-RY;             { Last correct in a height }
  GetImagePart (RX, RY, L, H, BitMap, IX, IY, RL, RH) { Drawing clipped image... }
End;

Procedure PutImage (X, Y : Word; Var BitMap); Assembler;
Asm
  Push  DS
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AX, VSegA
  Mov   ES, AX                          { ES:DI - Screen Addr }
  LDS   SI, BitMap                      { DS:SI - BitMap }
  Mov   DX, DS:[SI]                     { L }
  Mov   BX, DS:[SI+2]                   { H }
  Add   SI, 4
  CLD
  Shr   DX, 1
  JC    @2
@1:
  Mov   AX, DI
  Mov   CX, DX
  Rep   MovSW
  Mov   DI, AX
  Add   DI, 320
  Dec   BX
  JNZ   @1
  Pop   DS
  Jmp   @end
@2:
  Mov   AX, DI
  Mov   CX, DX
  Rep   MovSW
  MovSB
  Mov   DI, AX
  Add   DI, 320
  Dec   BX
  JNZ   @2
  Pop   DS
@end:
End;

Procedure PutTranspImage (X, Y : Word; Var BitMap); Assembler;
Asm
  Push  DS
  Push  BP
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AX, VSegA
  Mov   ES, AX                          { ES:DI - Screen Addr }
  Mov   AH, TranspColor
  LDS   SI, BitMap                      { DS:SI - BitMap }
  Mov   DX, DS:[SI]                     { L }
  Mov   BX, DS:[SI+2]                   { H }
  Add   SI, 4
  CLD
@cycle:
  Mov   BP, DI
  Mov   CX, DX
@cyc:
  LODSB
  Cmp   AL, AH
  JE    @transp
  STOSB
  Jmp   @norm
@transp:
  Inc   DI
@norm:
  Loop  @cyc
  Mov   DI, BP
  Add   DI, 320
  Dec   BX
  JNZ   @cycle
  Pop   BP
  Pop   DS
End;

Procedure PutImagePart (X, Y : Word; Var BitMap; PX, PY, PL, PH : Word); Assembler;
Asm
  Push  DS
  Push  BP
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AX, VSegA
  Mov   ES, AX                          { ES:DI - Screen Addr }
  LDS   SI, BitMap                      { DS:SI - ^BitMap }
  Mov   AX, PY
  Mul   Word Ptr DS:[SI]                { DX:AX - vertical offset in image }
  Add   AX, 4
  Add   AX, PX
  Mov   DX, PL                          { Output length }
  Mov   BX, PH                          { Output height }
  Mov   BP, DS:[SI]                     { Image length }
  Add   SI, AX                          { DS:SI - correct starting addr }
  CLD
  Shr   DX, 1
  JC    @2
@1:
  Mov   AX, DI
  Mov   CX, DX
  Push  SI
  Rep   MovSW
  Pop   SI
  Add   SI, BP
  Mov   DI, AX
  Add   DI, 320
  Dec   BX
  JNZ   @1
  Jmp   @end
@2:
  Mov   AX, DI
  Mov   CX, DX
  Push  SI
  Rep   MovSW
  MovSB
  Pop   SI
  Add   SI, BP
  Mov   DI, AX
  Add   DI, 320
  Dec   BX
  JNZ   @2
@end:
  Pop   BP
  Pop   DS
End;

Procedure PutTranspImagePart (X, Y : Word; Var BitMap; PX, PY, PL, PH : Word); Assembler;
Asm
  Push  DS
  Push  BP
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AX, VSegA
  Mov   ES, AX                          { ES:DI - Screen Addr }
  Push  Word Ptr TranspColor
  LDS   SI, BitMap                      { DS:SI - ^BitMap }
  Mov   AX, PY
  Mul   Word Ptr DS:[SI]                { DX:AX - vertical offset in image }
  Add   AX, 4
  Add   AX, PX
  Mov   DX, PL                          { Output length }
  Mov   BX, PH                          { Output height }
  Mov   BP, DS:[SI]                     { Image length }
  Add   SI, AX                          { DS:SI - correct starting addr }
  CLD
  Pop   AX
@cycle:
  Push  DI
  Mov   CX, DX
  Push  SI
@cyc:
  LODSB
  Cmp   AL, AH
  JE    @transp
  STOSB
  Jmp   @norm
@transp:
  Inc   DI
@norm:
  Loop  @cyc
  Pop   SI
  Add   SI, BP
  Pop   DI
  Add   DI, 320
  Dec   BX
  JNZ   @cycle
  Pop   BP
  Pop   DS
End;

Procedure PutClippedImage (X, Y : Integer; Var BitMap);
Var
  Dims : Array [0..1] of Word absolute BitMap; {Dims[0]=Length;Dims[1]=Height}
  RX, RY, RL, RH, IX, IY : Integer;
Begin
  If (X > 319) or (Y > 199) then Exit;          { Image is out of screen }
  RX := X; RY := Y;                             { Start X & Y at screen }
  RL := Dims[0]; RH := Dims[1];                 { Length & Height at begining }
  IX := 0; IY := 0;                             { IX & IY - coos in image to }
                                                { start drawin it (at begining) }
  If RX < 0 then Begin
    Inc (RL, RX);                               { Output length corrected }
    Dec (IX, RX);                               { IX corrected }
    RX := 0                                     { Screen X corrected }
  End;
  If RY < 0 then Begin
    Inc (RH, RY);                               { Output height corrected }
    Dec (IY, RY);                               { IY corrected }
    RY := 0                                     { Screen Y corrected }
  End;
  If (RL <= 0) or (RH <= 0) then Exit;          { Image is out of screen }
  If RX+RL > 320 then RL := 320-RX;             { Last correct in a length }
  If RY+RH > 200 then RH := 200-RY;             { Last correct in a height }
  PutImagePart (RX, RY, BitMap, IX, IY, RL, RH) { Drawing clipped image... }
End;

Procedure PutTranspClippedImage (X, Y : Integer; Var BitMap);
Var
  Dims : Array [0..1] of Word absolute BitMap; {Dims[0]=Length;Dims[1]=Height}
  RX, RY, RL, RH, IX, IY : Integer;
Begin
  If (X > 319) or (Y > 199) then Exit;          { Image is out of screen }
  RX := X; RY := Y;                             { Start X & Y at screen }
  RL := Dims[0]; RH := Dims[1];                 { Length & Height at begining }
  IX := 0; IY := 0;                             { IX & IY - coos in image to }
                                                { start drawin it (at begining) }
  If RX < 0 then Begin
    Inc (RL, RX);                               { Output length corrected }
    Dec (IX, RX);                               { IX corrected }
    RX := 0                                     { Screen X corrected }
  End;
  If RY < 0 then Begin
    Inc (RH, RY);                               { Output height corrected }
    Dec (IY, RY);                               { IY corrected }
    RY := 0                                     { Screen Y corrected }
  End;
  If (RL <= 0) or (RH <= 0) then Exit;          { Image is out of screen }
  If RX+RL > 320 then RL := 320-RX;             { Last correct in a length }
  If RY+RH > 200 then RH := 200-RY;             { Last correct in a height }
  PutTranspImagePart (RX, RY, BitMap, IX, IY, RL, RH) { Drawing clipped image... }
End;

Procedure PutClippedImagePart (X, Y : Integer; Var BitMap; PX, PY, PL, PH : Word);
Var
  Dims : Array [0..1] of Word absolute BitMap; {Dims[0]=Length;Dims[1]=Height}
  RX, RY, RL, RH, IX, IY : Integer;
Begin
  If (X > 319) or (Y > 199) then Exit;          { Image is out of screen }
  RX := X; RY := Y;                             { Start X & Y at screen }
  RL := PL; RH := PH;                           { Length & Height at begining }
  IX := PX; IY := PY;                           { IX & IY - coos in image to }
                                                { start drawin it (at begining) }
  If RX < 0 then Begin
    Inc (RL, RX);                               { Output length corrected }
    Dec (IX, RX);                               { IX corrected }
    RX := 0                                     { Screen X corrected }
  End;
  If RY < 0 then Begin
    Inc (RH, RY);                               { Output height corrected }
    Dec (IY, RY);                               { IY corrected }
    RY := 0                                     { Screen Y corrected }
  End;
  If (RL <= 0) or (RH <= 0) then Exit;          { Image is out of screen }
  If RX+RL > 320 then RL := 320-RX;             { Last correct in a length }
  If RY+RH > 200 then RH := 200-RY;             { Last correct in a height }
  PutImagePart (RX, RY, BitMap, IX, IY, RL, RH) { Drawing clipped image... }
End;

Procedure PutTranspClippedImagePart (X, Y : Integer; Var BitMap; PX, PY, PL, PH : Word);
Var
  Dims : Array [0..1] of Word absolute BitMap; {Dims[0]=Length;Dims[1]=Height}
  RX, RY, RL, RH, IX, IY : Integer;
Begin
  If (X > 319) or (Y > 199) then Exit;          { Image is out of screen }
  RX := X; RY := Y;                             { Start X & Y at screen }
  RL := PL; RH := PH;                           { Length & Height at begining }
  IX := PX; IY := PY;                           { IX & IY - coos in image to }
                                                { start drawin it (at begining) }
  If RX < 0 then Begin
    Inc (RL, RX);                               { Output length corrected }
    Dec (IX, RX);                               { IX corrected }
    RX := 0                                     { Screen X corrected }
  End;
  If RY < 0 then Begin
    Inc (RH, RY);                               { Output height corrected }
    Dec (IY, RY);                               { IY corrected }
    RY := 0                                     { Screen Y corrected }
  End;
  If (RL <= 0) or (RH <= 0) then Exit;          { Image is out of screen }
  If RX+RL > 320 then RL := 320-RX;             { Last correct in a length }
  If RY+RH > 200 then RH := 200-RY;             { Last correct in a height }
  PutTranspImagePart (RX, RY, BitMap, IX, IY, RL, RH) { Drawing clipped image... }
End;

Procedure LoadObject (Name : String; Var PBitMap : Pointer; Var Size : Word);
Const
  ID : Array [1..12] of Char = 'EGO''S FILE. ';
Var
  F : File;
  H : THeader;
  I : Byte;
  P : Pointer;
  SF: Word;
Label
  LErr;
Begin
  PBitMap := nil;
  Assign (F, Name);
  {$i-}
  Reset (F, 1);
  {$i+}
  If IOResult <> 0 then
    Begin
LErr:
      If PBitMap <> nil then
        FreeMem (PBitMap, Size);
      PBitMap := nil;
      Size := 0;
      GrResult := GrLoadObj;
      Exit
    End;
  {$i-} BlockRead (F, H, SizeOf(H)); {$i+}
  If IOResult <> 0 then Goto LErr;
  For I := 1 to 12 do
    If H.ID[I] <> ID[I] then Goto LErr;
  Case H.Pack of
    $00, $FF:
      Begin
        Size := (Ord(H.Mask)+1)*H.L*H.H+4;
        GetMem (PBitMap, Size);
        Word(PBitMap^) := H.L;
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)+2);
        Word(PBitMap^) := H.H;
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)+2);
        {$i-} BlockRead (F, PBitMap^, Size-4); {$i+}
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)-4);
        If IOResult <> 0 then Goto LErr;
        {$i-} Close (F); {$i+}
        If IOResult <> 0 then Goto LErr;
      End;
    $01:
      Begin
        {$I-} SF := FileSize(F)-32; {$I+}
        If IOResult <> 0 then Goto LErr;
        Size := (Ord(H.Mask)+1)*H.L*H.H+4;
        GetMem (PBitMap, Size);
        GetMem (P, SF);
        {$I-} BlockRead (F, P^, SF); {$I+}
        If IOResult <> 0 then
          Begin FreeMem (P, SF); Goto LErr End;
        {$I-} Close (F); {$I+}
        If IOResult <> 0 then
          Begin FreeMem (P, SF); Goto LErr End;
        Word(PBitMap^) := H.L;
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)+2);
        Word(PBitMap^) := H.H;
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)+2);
        UnPack (P^, PBitMap^, H.PSize);
        If H.Mask then
          Begin
            P := Ptr(Seg(P^), Ofs(P^)+H.PSize);
            PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)+H.L*H.H);
            UnPack (P^, PBitMap^, H.MSize);
            PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)-H.L*H.H);
            P := Ptr(Seg(P^), Ofs(P^)-H.PSize)
          End;
        PBitMap := Ptr(Seg(PBitMap^), Ofs(PBitMap^)-4);
        FreeMem (P, SF)
      End;
  End;
  GrResult := GrOk
End;

Procedure LoadPCX256 (Name : String; Var PBitMap : Pointer; Var Size : Word;
                      Var Pal : TPal);
Var
  Hd : TPCXHeader;
  F : File;
  L, H : Word;
  PFBuf, Temp : Pointer;
  Sz : Word;
Label LErr;
Begin
  GrResult := GrOk;
  Temp := nil;
  Assign (F, Name);
  {$I-} Reset (F, 1); {$I+}
  If IOResult <> 0 then Begin
LErr:
    If Temp <> nil then FreeMem (Temp, Size);
    GrResult := GrLoadObj;
    PBitMap := nil;
    Size := 0;
    Exit
  End;
  {$I-} BlockRead (F, Hd, 128); {$I+}           { Load header }
  If IOResult <> 0 then Goto LErr;
  If (Hd.BitsPerPixel <> 8) or (Hd.Planes <> 1) then Goto LErr;
  L := Hd.X2 - Hd.X1 + 1;
  H := Hd.Y2 - Hd.Y1 + 1;
  Size := 4 + L*H;
  If Size > 64004 then Goto LErr;               { If not in the range }
  GetMem (Temp, Size);                          { Allocate memory for unpacked bitmap }
  {$I-} Seek (F, FileSize(F)-768); {$I+}
  If IOResult <> 0 then Goto LErr;
  {$I-} BlockRead (F, Pal, 768); {$I+}          { Load palette part }
  If IOResult <> 0 then Goto LErr;
  {$I-} Seek (F, 128); {$I+}
  If IOResult <> 0 then Goto LErr;
  Sz := FileSize(F)-896;
  GetMem (PFBuf, Sz);                           { Allocate memory for file buffer }
  {$I-} BlockRead (F, PFBuf^, Sz); {$I+}        { Load picture body }
  If IOResult <> 0 then Begin
    FreeMem (PFBuf, Sz);
    Goto LErr
  End;
  {$I-} Close (F); {$I+}
  If IOResult <> 0 then Begin
    FreeMem (PFBuf, Sz);
    Goto LErr
  End;
  Asm
    Push  DS
    Mov   SI, Word Ptr Pal;
    Mov   DI, SI
    Mov   AX, Word Ptr Pal+2;
    Mov   DS, AX
    Mov   ES, AX
    Mov   CX, 768
    CLD
@loop:
    LODSB
    Shr   AL, 2                                 { Normalizing palette }
    STOSB
    Loop  @loop
    Pop   DS
  End;
  Asm
    Push  DS
    Push  BP
    LES   DI, Temp                      { ES:DI = ^ unpacking buffer }
    CLD
    Mov   AX, L                         { Picture length stored to memory }
    STOSW
    Push  AX                            { Local constant L }
    Mov   AX, H
    STOSW                               { Picture height stored to memory }
    Mov   BX, H
    Push  Hd.BytesPerLine               { Local constant Hd.BytesPerLine }
    LDS   SI, PFBuf                     { DS:SI = ^ file buffer with packed pic }
    Mov   BP, SP                        { Pointer to the local constants }
    Xor   CH, CH                        { Hi byte of repeat counter,always 0 }
    Xor   DX, DX                        { Written pixels counter }
@cyc:
    LODSB
    Cmp   AL, 0C0h
    JNC   @repeat                       { If need to repeat pixel }
    Cmp   DX, SS:[BP+2]
    JNC   @1                            { If run off the line }
    STOSB                               { Writing if all right }
@1:
    Inc   DX
    Jmp   @next
@repeat:
    And   AL, 3Fh
    Mov   CL, AL                        { CX = repeat count }
    Add   DX, CX
    LODSB                               { AL = repeated pixel (color) }
    Cmp   DX, SS:[BP+2]
    JG    @2                            { If run off the line }
    Rep   STOSB                         { Writing if all right }
    Jmp   @next
@2:
    Add   CX, SS:[BP+2]
    Sub   CX, DX                        { CX = corrected repeat count }
    Rep   STOSB
@next:
    Cmp   DX, SS:[BP]
    JNE   @cyc                          { Line isn't done }
    Xor   DX, DX
    Dec   BX
    JNZ   @cyc                          { Going to the next line }
    Add   SP, 4                         { Remove local constants from stack }
    Pop   BP                            { Restore original BP }
    Pop   DS                            { Restore original DS }
  End;
  FreeMem (PFBuf, Sz);                  { Deallocating file buffer }
  PBitMap := Temp                       { Returning address of our bitmap }
End;

Procedure SavePCX256 (Name : String; X, Y, L, H : Word);
Const
  Z : Byte = 12;
Var
  F : File;
  Hd : TPCXHeader;
  Pal,
  Buf : Array [0..767] of Byte;
  J, Cnt,
  Len : Word;
  Rep, B : Byte;
  PLeft, P : ^Byte;
Label
  LErr;
Begin
  FillChar (Hd, SizeOf(Hd), 0);
  Hd.X1 := 0; Hd.Y1 := 0; Hd.X2 := L-1; Hd.Y2 := H-1;
  Hd.Manufact := 10; Hd.Ver := 5; Hd.Encoding := 1;
  Hd.BitsPerPixel := 8; Hd.Planes := 1; Hd.PalInfo := 1;
  Hd.BytesPerLine := L + (L and 1);
  Assign (F, Name);
  {$I-} Rewrite (F, 1); {$I+}
  If IOResult <> 0 then Begin
LErr:
    GrResult := GrSaveObj;
    Exit
  End;
  {$I-} BlockWrite (F, Hd, SizeOf(Hd)); {$I+}
  If IOResult <> 0 then Begin
    {$I-} Close (F); {$I+}
    Goto LErr
  End;
  PLeft := Ptr (VSegA, Y*320+X);
  For J := 0 to H-1 do Begin
    Cnt := 0;
    Len := 0;
    P := PLeft;
    Repeat
      B := P^; Inc (Word(P)); Inc (Cnt);
      Rep := 1;
      While (B = P^) and (Rep < 63) and (Cnt < L) do Begin
        Inc (Rep);
        Inc (Cnt);
        Inc (Word(P))
      End;
      If Rep > 1 then Begin
        Buf[Len] := $C0 or Rep;
        Buf[Len+1] := B;
        Inc (Len, 2)
      End
      Else Begin
        If B >= $C0 then Begin
          Buf[Len] := $C1; Inc (Len)
        End;
        Buf[Len] := B;
        Inc (Len)
      End
    Until Cnt = L;
    Buf[Len] := 0;
    {$I-} BlockWrite (F, Buf, Len + (L and 1)); {$I+}
    If IOResult <> 0 then Begin
      {$I-} Close (F); {$I+}
      Goto LErr
    End;
    Inc (Word(PLeft), 320)
  End;
  BlockWrite (F, Z, 1);
  GetPal (Pal);
  For J := 0 to 767 do Pal[J] := Pal[J] shl 2;
  BlockWrite (F, Pal, 768);
  Close (F)
End;

Procedure PutImageM (X, Y : Word; Var BitMap); Assembler;
Asm
  Push  DS
  Push  BP
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX
  Mov   AX, VSegA
  Mov   ES, AX                          { ES:DI - Screen Addr }
  LDS   SI, BitMap                      { DS:SI - BitMap }
  Mov   AX, DS:[SI]                     { L }
  Mov   BX, DS:[SI+2]                   { H }
  Mul   BX
  Mov   BP, AX                          { BP = L*H }
  Mov   DX, DS:[SI]                     { L }
  Add   SI, 4
  CLD
@1:
  Push  DI
  Mov   CX, DX
@2:
  Mov   AL, ES:[DI]
  And   AL, DS:[SI+BP]
  Xor   AL, DS:[SI]
  STOSB
  Inc   SI
  Loop  @2
  Pop   DI
  Add   DI, 320
  Dec   BX
  JNZ   @1
  Pop   BP
  Pop   DS
End;

Procedure SetActivePage (PageSeg : Word);
Begin
  VSegA := PageSeg
End;

Procedure DisplayPage (PageSeg : Word); Assembler;
Asm
  Push  DS
  Mov   AX, SegA000
  Mov   ES, AX
  Xor   DI, DI
  Mov   AX, PageSeg
  Mov   DS, AX
  Mov   SI, DI
  CLD
  Mov   CX, 32000
  Rep   MovSW
  Pop   DS
End;

Procedure DisplayBox (PageSeg, X, Y, L, H : Word); Assembler;
Asm
  Push  DS
  Mov   AX, SegA000
  Mov   ES, AX
  Mov   DI, X
  Mov   BX, Y
  ShL   BX, 6
  Add   DI, BX
  ShL   BX, 2
  Add   DI, BX                          { ES:DI - Screen Addr }
  Mov   BX, H                           { H }
  Mov   DX, L                           { L }
  Mov   AX, PageSeg
  Mov   SI, DI                          { DI - Offset in Page }
  Mov   DS, AX                          { DS:SI - Addr in Page }
  CLD
  Shr   DX, 1
  JC    @2                              { If L is ODD }
@1:
  Mov   CX, DX
  Push  SI
  Rep   MovSW
  Pop   SI
  Add   SI, 320
  Mov   DI, SI
  Dec   BX
  JNZ   @1
  Pop   DS
  Jmp   @end
@2:
  Mov   CX, DX
  Push  SI
  MovSB
  Rep   MovSW
  Pop   SI
  Add   SI, 320
  Mov   DI, SI
  Dec   BX
  JNZ   @2
  Pop   DS
@end:
End;

Procedure WaitRetrace; Assembler;
  { This waits until you are in a Verticle Retrace ... this means that all
    screen manipulation you do only appears on screen in the next verticle
    retrace ... this removes most of the "fuzz" that you see on the screen
    when changing the pallette. It unfortunately slows down your program
    by "synching" your program with your monitor card ... it does mean
    that the program will run at almost the same speed on different
    speeds of computers which have similar monitors. In our SilkyDemo,
    we used a WaitRetrace, and it therefore runs at the same (fairly
    fast) speed when Turbo is on or off. }

Label
  L1, L2;
Asm
    Mov DX, 3DAH
L1:
    In AL,DX
    And AL,08H
    JNZ L1
L2:
    In AL,DX
    And AL,08H
    JZ  L2
End;

Procedure GetCRGB (C : Byte; Var R, G, B : Byte);
Begin
  Port[$3C7] := C;
  R := Port[$3C9];
  G := Port[$3C9];
  B := Port[$3C9]
End;

Procedure SetCRGB (C : Byte; R, G, B : Byte);
Begin
  Port[$3C8] := C;
  Port[$3C9] := R;
  Port[$3C9] := G;
  Port[$3C9] := B
End;

Procedure GetPal (Var Pal); Assembler;
Asm
  LES   DI, Pal
  Mov   CX, 768
  CLD
  Mov   DX, 3C7h
  Xor   AL, AL
  Out   DX, AL
  Inc   DX
  Inc   DX
  Rep   InSB
End;

Procedure SetPal (Var Pal); Assembler;
Asm
  Mov   BX, DS
  LDS   SI, Pal
  Mov   CX, 768
  CLD
  Mov   DX, 3C8h
  Xor   AL, AL
  Out   DX, AL
  Inc   DX
  Rep   OutSB
  Mov   DS, BX
End;

Procedure FadeUp (Pal : TPal);
Var
  Cnt, C,
  R, G, B : Byte;
Begin
  For Cnt := 0 to 63 do
    Begin
      WaitRetrace;
      For C := 0 to 255 do
        Begin
          GetCRGB (C, R, G, B);
          If 64-Cnt <= Pal[C,1]-R then
            Inc (R);
          If 64-Cnt <= Pal[C,2]-G then
            Inc (G);
          If 64-Cnt <= Pal[C,3]-B then
            Inc (B);
          SetCRGB (C, R, G, B)
        End
    End
End;

Procedure FadeDown;
Var
  Cnt, C,
  R, G, B : Byte;
Begin
  For Cnt := 0 to 63 do
    Begin
      WaitRetrace;
      For C := 0 to 255 do
        Begin
          GetCRGB (C, R, G, B);
          If R > 0 then Dec (R);
          If G > 0 then Dec (G);
          If B > 0 then Dec (B);
          SetCRGB (C, R, G, B)
        End
    End
End;

Procedure BlackOutPut;
Var C : Byte;
Begin
  For C := 0 to 255 do
    SetCRGB (C, 0, 0, 0)
End;

Procedure TextureMapPoly (X1,Y1, X2,Y2, X3,Y3, X4,Y4, L, H : Integer;
                                                             PicSeg : Word);

Procedure ScanLeftSide (X1,X2,Ytop,LH:Integer;Side:Byte);
{ Scan in our needed variables ... X on the left, texturmap X, texturemap Y }
Var
  Y, X, PX, PY, DPX, DPY,
  SX, SY, M, N, DX1, DY1, DX2, DY2, I, T, Xm, Yt : Integer;
Begin
{  SX := X2-X1; SY := LH;}                      { !!! }
  SX := X1-X2; SY := -LH;                       { !!! }
  DX1 := Sgn(SX); DY1 := Sgn(SY);
  M := _Abs(SX); N := _Abs(SY);
  DX2 := DX1; DY2 := 0;
  If M < N then Begin
    M := _Abs(SY); N := _Abs(SX);
    DX2 := 0; DY2 := DY1
  End;
  LH := LH + 1;
  If Side = 1 then Begin
    PX := (L-1) shl 7;
    PY := 0;
    DPX:= (-(L-1) shl 7) div LH;
    DPY := 0;
  End;
  If Side = 2 then Begin
    PX := (L-1) shl 7;
    PY := (H-1) shl 7;
    DPX := 0;
    DPY := (-(H-1) shl 7) div LH;
  End;
  If Side = 3 then Begin
    PX := 0;
    PY := (H-1) shl 7;
    DPX := (L-1) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 4 then Begin
    PX := 0;
    PY := 0;
    DPX := 0;
    DPY := (H-1) shl 7 div LH;
  End;
{  X := X1; Y := Ytop;}                         { !!! }
  X := X2; Y := Ytop+LH-1;                      { !!! }
  Yt := Y; Xm := X;
  T := 0;
  For I := 0 to M do Begin
    If Y = Yt then Begin
      If Xm > X then Xm := X
    End
    Else Begin
      If (Yt >= 0) and (Yt <= 199) then
        _LeftTable[Yt,0] := Xm;
      Yt := Y; Xm := X
    End;
    Inc (T, N);
    If T < M then Begin
      Inc (X, DX2); Inc (Y, DY2)
    End
    Else Begin
      Dec (T, M);
      Inc (X, DX1); Inc (Y, DY1)
    End;
  End;
  If (Yt >= 0) and (Yt <= 199) then
    _LeftTable[Yt,0] := Xm;
  For Y := 0 to LH-1 do Begin
    If (Ytop+Y >= 0) and (Ytop+Y <= 199) then Begin
      _LeftTable[Ytop+Y,1] := PX shr 7;
      _LeftTable[Ytop+Y,2] := PY shr 7
    End;
    PX := PX + DPX;
    PY := PY + DPY
  End
End;

Procedure ScanRightSide (X1, X2, Ytop, LH : Integer; Side : Byte);
{ Scan in our needed variables ... X on the right, texturmap X, texturemap Y }
Var
  Y, X, PX, PY, DPX, DPY,
  SX, SY, M, N, DX1, DY1, DX2, DY2, I, T, Xm, Yt : Integer;
Begin
  SX := X2-X1; SY := LH;
  DX1 := Sgn(SX); DY1 := Sgn(SY);
  M := _Abs(SX); N := _Abs(SY);
  DX2 := DX1; DY2 := 0;
  If M < N then Begin
    M := _Abs(SY); N := _Abs(SX);
    DX2 := 0; DY2 := DY1
  End;
  LH := LH + 1;
  If Side = 1 then Begin
    PX := 0;
    PY := 0;
    DPX := (L-1) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 2 then Begin
    PX := (L-1) shl 7;
    PY := 0;
    DPX := 0;
    DPY := (H-1) shl 7 div LH;
  End;
  If Side = 3 then Begin
    PX := (L-1) shl 7;
    PY := (H-1) shl 7;
    DPX := (-(L-1)) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 4 then Begin
    PX := 0;
    PY := (H-1) shl 7;
    DPX := 0;
    DPY := (-(H-1)) shl 7 div LH;
  End;
  X := X1; Y := Ytop;
  Yt := Y; Xm := X;
  T := 0;
  For I := 0 to M do Begin
    If Y = Yt then Begin
      If Xm < X then Xm := X
    End
    Else Begin
      If (Yt >= 0) and (Yt <= 199) then
        _RightTable[Yt,0] := Xm;
      Yt := Y; Xm := X
    End;
    Inc (T, N);
    If T < M then Begin
      Inc (X, DX2); Inc (Y, DY2)
    End
    Else Begin
      Dec (T, M);
      Inc (X, DX1); Inc (Y, DY1)
    End;
  End;
  If (Yt >= 0) and (Yt <= 199) then
    _RightTable[Yt,0] := Xm;
  For Y := 0 to LH-1 do Begin
    If (Ytop+Y >= 0) and (Ytop+Y <= 199) then Begin
      _RightTable[Ytop+Y,1] := PX shr 7;
      _RightTable[Ytop+Y,2] := PY shr 7
    End;
    PX := PX + DPX;
    PY := PY + DPY
  End
End;

Var
  Ymin, Ymax,
  PX1, PY1, PX2, PY2,
  XL, XR, X, Y, LW,
  DPX, DPY : Integer;

Label LC;

Begin
  Ymin := Y1; Ymax := Y1;

  If Y1 < Ymin then Ymin := Y1;
  If Y1 > Ymax then Ymax := Y1;
  If Y2 < Ymin then Ymin := Y2;
  If Y2 > Ymax then Ymax := Y2;
  If Y3 < Ymin then Ymin := Y3;
  If Y3 > Ymax then Ymax := Y3;
  If Y4 < Ymin then Ymin := Y4;
  If Y4 > Ymax then Ymax := Y4;

  If Ymax-Ymin < 2 then Exit;
  If (Ymin > 199) or (Ymax < 0) then Exit;

  If Y2 < Y1 then ScanLeftSide (X2, X1, Y2, Y1-Y2, 1)
  Else ScanRightSide (X1, X2, Y1, Y2-Y1, 1);
  { If point2.Y is above point1.Y, Point1 to Point2 is on the "left",
    and our leftside array must be altered }

  If Y3 < Y2 then ScanLeftSide (X3, X2, Y3, Y2-Y3, 2)
  Else ScanRightSide (X2, X3, Y2, Y3-Y2, 2);

  If Y4 < Y3 then ScanLeftSide (X4, X3, Y4, Y3-Y4, 3)
  Else ScanRightSide (X3, X4, Y3, Y4-Y3, 3);

  If Y1 < Y4 then ScanLeftSide (X1, X4, Y1, Y4-Y1, 4)
  Else ScanRightSide (X4, X1, Y4, Y1-Y4, 4);

  { This uses the tables we have created to actually draw the texture }

  If Ymin < 0 then Ymin:=0;
  If Ymax > 199 then Ymax:=199;
  For Y := Ymin to Ymax do Begin
    XL := _LeftTable[Y,0];          { X Starting position }
    PX1 := _LeftTable[Y,1] shl 7;   { Texture X at start  }
    PY1 := _LeftTable[Y,2] shl 7;   { Texture Y at stary  }
    XR := _RightTable[Y,0];         { X Ending position   }
    PX2 := _RightTable[Y,1] shl 7;  { Texture X at End    }
    PY2 := _RightTable[Y,2] shl 7;  { Texture Y at End    }
    LW := XR-XL;                    { Width of line }
    If LW <= 0 then Goto LC;
    DPX := (PX2-PX1) div LW;
    DPY := (PY2-PY1) div LW;
    While XL < 0 do Begin
      PX1 := PX1 + DPX;
      PY1 := PY1 + DPY;
      Inc (XL);
      Dec (LW); If LW < 0 then Goto LC
    End;
    While XR > 319 do Begin
      Dec (XR);
      Dec (LW); If LW < 0 then Goto LC
    End;
    Asm
      Push  DS
      Mov   AX, VSegA
      Mov   ES, AX
      Mov   DI, XL
      Mov   BX, Y
      ShL   BX, 6
      Add   DI, BX
      ShL   BX, 2
      Add   DI, BX                              { ES:DI - Screen start addr }
      Mov   AX, PicSeg
      Mov   DS, AX
      Mov   CX, LW
      Inc   CX                                  { Line length }
      Mov   BX, PX1                             { Texture X }
      Mov   DX, PY1                             { Texture Y }
      CLD
@cyc:
      Mov   SI, BX
      Shr   SI, 7
      Push  DX
      Shr   DX, 7
      Mov   AX, L
      Mul   DX
      Add   SI, AX                              { DS:SI - Addres in texture }
      Pop   DX
      MOVSB                                     { Copy pixel:texture->screen }
      Add   BX, DPX                             { PX1 = PX1 + DPX }
      Add   DX, DPY                             { PY1 = PY1 + DPY }
      Loop  @cyc
      Pop   DS
    End;
LC:
  End;
End;

Procedure TextureMapPoly2 (X1,Y1, X2,Y2, X3,Y3, X4,Y4, L, H : Integer;
                                                   N : Byte; PicSeg : Word);

Procedure ScanLeftSide (X1,X2,Ytop,LH:Integer;Side:Byte);
{ Scan in our needed variables ... X on the left, texturmap X, texturemap Y }
Var
  Y, X, PX, PY, DPX, DPY,
  SX, SY, M, N, DX1, DY1, DX2, DY2, I, T, Xm, Yt : Integer;
Begin
{  SX := X2-X1; SY := LH;}                      { !!! }
  SX := X1-X2; SY := -LH;                       { !!! }
  DX1 := Sgn(SX); DY1 := Sgn(SY);
  M := _Abs(SX); N := _Abs(SY);
  DX2 := DX1; DY2 := 0;
  If M < N then Begin
    M := _Abs(SY); N := _Abs(SX);
    DX2 := 0; DY2 := DY1
  End;
  LH := LH + 1;
  If Side = 1 then Begin
    PX := (L-1) shl 7;
    PY := 0;
    DPX:= (-(L-1) shl 7) div LH;
    DPY := 0;
  End;
  If Side = 2 then Begin
    PX := (L-1) shl 7;
    PY := (H-1) shl 7;
    DPX := 0;
    DPY := (-(H-1) shl 7) div LH;
  End;
  If Side = 3 then Begin
    PX := 0;
    PY := (H-1) shl 7;
    DPX := (L-1) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 4 then Begin
    PX := 0;
    PY := 0;
    DPX := 0;
    DPY := (H-1) shl 7 div LH;
  End;
{  X := X1; Y := Ytop;}                         { !!! }
  X := X2; Y := Ytop+LH-1;                      { !!! }
  Yt := Y; Xm := X;
  T := 0;
  For I := 0 to M do Begin
    If Y = Yt then Begin
      If Xm > X then Xm := X
    End
    Else Begin
      If (Yt >= 0) and (Yt <= 199) then
        _LeftTable[Yt,0] := Xm;
      Yt := Y; Xm := X
    End;
    Inc (T, N);
    If T < M then Begin
      Inc (X, DX2); Inc (Y, DY2)
    End
    Else Begin
      Dec (T, M);
      Inc (X, DX1); Inc (Y, DY1)
    End;
  End;
  If (Yt >= 0) and (Yt <= 199) then
    _LeftTable[Yt,0] := Xm;
  For Y := 0 to LH-1 do Begin
    If (Ytop+Y >= 0) and (Ytop+Y <= 199) then Begin
      _LeftTable[Ytop+Y,1] := PX shr 7;
      _LeftTable[Ytop+Y,2] := PY shr 7
    End;
    PX := PX + DPX;
    PY := PY + DPY
  End
End;

Procedure ScanRightSide (X1, X2, Ytop, LH : Integer; Side : Byte);
{ Scan in our needed variables ... X on the right, texturmap X, texturemap Y }
Var
  Y, X, PX, PY, DPX, DPY,
  SX, SY, M, N, DX1, DY1, DX2, DY2, I, T, Xm, Yt : Integer;
Begin
  SX := X2-X1; SY := LH;
  DX1 := Sgn(SX); DY1 := Sgn(SY);
  M := _Abs(SX); N := _Abs(SY);
  DX2 := DX1; DY2 := 0;
  If M < N then Begin
    M := _Abs(SY); N := _Abs(SX);
    DX2 := 0; DY2 := DY1
  End;
  LH := LH + 1;
  If Side = 1 then Begin
    PX := 0;
    PY := 0;
    DPX := (L-1) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 2 then Begin
    PX := (L-1) shl 7;
    PY := 0;
    DPX := 0;
    DPY := (H-1) shl 7 div LH;
  End;
  If Side = 3 then Begin
    PX := (L-1) shl 7;
    PY := (H-1) shl 7;
    DPX := (-(L-1)) shl 7 div LH;
    DPY := 0;
  End;
  If Side = 4 then Begin
    PX := 0;
    PY := (H-1) shl 7;
    DPX := 0;
    DPY := (-(H-1)) shl 7 div LH;
  End;
  X := X1; Y := Ytop;
  Yt := Y; Xm := X;
  T := 0;
  For I := 0 to M do Begin
    If Y = Yt then Begin
      If Xm < X then Xm := X
    End
    Else Begin
      If (Yt >= 0) and (Yt <= 199) then
        _RightTable[Yt,0] := Xm;
      Yt := Y; Xm := X
    End;
    Inc (T, N);
    If T < M then Begin
      Inc (X, DX2); Inc (Y, DY2)
    End
    Else Begin
      Dec (T, M);
      Inc (X, DX1); Inc (Y, DY1)
    End;
  End;
  If (Yt >= 0) and (Yt <= 199) then
    _RightTable[Yt,0] := Xm;
  For Y := 0 to LH-1 do Begin
    If (Ytop+Y >= 0) and (Ytop+Y <= 199) then Begin
      _RightTable[Ytop+Y,1] := PX shr 7;
      _RightTable[Ytop+Y,2] := PY shr 7
    End;
    PX := PX + DPX;
    PY := PY + DPY
  End
End;

Var
  Ymin, Ymax,
  PX1, PY1, PX2, PY2,
  XL, XR, X, Y, LW,
  DPX, DPY : Integer;

Label LC;

Begin
  Ymin := Y1; Ymax := Y1;

  If Y1 < Ymin then Ymin := Y1;
  If Y1 > Ymax then Ymax := Y1;
  If Y2 < Ymin then Ymin := Y2;
  If Y2 > Ymax then Ymax := Y2;
  If Y3 < Ymin then Ymin := Y3;
  If Y3 > Ymax then Ymax := Y3;
  If Y4 < Ymin then Ymin := Y4;
  If Y4 > Ymax then Ymax := Y4;

  If Ymax-Ymin < 2 then Exit;
  If (Ymin > 199) or (Ymax < 0) then Exit;

  If Y2 < Y1 then ScanLeftSide (X2, X1, Y2, Y1-Y2, 1)
  Else ScanRightSide (X1, X2, Y1, Y2-Y1, 1);
  { If point2.Y is above point1.Y, Point1 to Point2 is on the "left",
    and our leftside array must be altered }

  If Y3 < Y2 then ScanLeftSide (X3, X2, Y3, Y2-Y3, 2)
  Else ScanRightSide (X2, X3, Y2, Y3-Y2, 2);

  If Y4 < Y3 then ScanLeftSide (X4, X3, Y4, Y3-Y4, 3)
  Else ScanRightSide (X3, X4, Y3, Y4-Y3, 3);

  If Y1 < Y4 then ScanLeftSide (X1, X4, Y1, Y4-Y1, 4)
  Else ScanRightSide (X4, X1, Y4, Y1-Y4, 4);

  { This uses the tables we have created to actually draw the texture }

  If Ymin < 0 then Ymin:=0;
  If Ymax > 199 then Ymax:=199;
  For Y := Ymin to Ymax do Begin
    XL := _LeftTable[Y,0];          { X Starting position }
    PX1 := _LeftTable[Y,1] shl 7;   { Texture X at start  }
    PY1 := _LeftTable[Y,2] shl 7;   { Texture Y at stary  }
    XR := _RightTable[Y,0];         { X Ending position   }
    PX2 := _RightTable[Y,1] shl 7;  { Texture X at End    }
    PY2 := _RightTable[Y,2] shl 7;  { Texture Y at End    }
    LW := XR-XL;                    { Width of line }
    If LW <= 0 then Goto LC;
    DPX := (PX2-PX1) div LW;
    DPY := (PY2-PY1) div LW;
    While XL < 0 do Begin
      PX1 := PX1 + DPX;
      PY1 := PY1 + DPY;
      Inc (XL);
      Dec (LW); If LW < 0 then Goto LC
    End;
    While XR > 319 do Begin
      Dec (XR);
      Dec (LW); If LW < 0 then Goto LC
    End;
    Inc (PX1, (L * (N and 1)) shl 7);
    Inc (PY1, (H * (N shr 1)) shl 7);
    Asm
      Push  DS
      Mov   AX, VSegA
      Mov   ES, AX
      Mov   DI, XL
      Mov   BX, Y
      ShL   BX, 6
      Add   DI, BX
      ShL   BX, 2
      Add   DI, BX                              { ES:DI - Screen start addr }
      Mov   AX, PicSeg
      Mov   DS, AX
      Mov   CX, LW
      Inc   CX                                  { Line length }
      Mov   BX, PX1                             { Texture X }
      Mov   DX, PY1                             { Texture Y }
      CLD
@cyc:
      Mov   SI, BX
      Shr   SI, 7
      Push  DX
      Shr   DX, 7
      Mov   AX, L
      Mul   DX
      Shl   AX, 1
      Add   SI, AX                              { DS:SI - Addres in texture }
      Pop   DX
      MOVSB                                     { Copy pixel:texture->screen }
      Add   BX, DPX                             { PX1 = PX1 + DPX }
      Add   DX, DPY                             { PY1 = PY1 + DPY }
      Loop  @cyc
      Pop   DS
    End;
LC:
  End;
End;

Procedure DisplayOff; Assembler;
Asm
  CLI
  Mov   DX, Seq_Addr
  Mov   AL, 1
  Out   DX, AL
  Inc   DX
  In    AL, DX
  Or    AL, 20h
  Mov   AH, AL
  Mov   AL, 1
  Dec   DX
  Out   DX, AX
  STI
End;

Procedure DisplayOn; Assembler;
Asm
  CLI
  Mov   DX, Seq_Addr
  Mov   AL, 1
  Out   DX, AL
  Inc   DX
  In    AL, DX
  And   AL, 0DFh
  Mov   AH, AL
  Mov   AL, 1
  Dec   DX
  Out   DX, AX
  STI
End;

Begin
  GrResult := GrOk;
  CurFont := nil;
  FontX := 0;
  FontY := 0;
  VSegA := SegA000;
  TranspColor := Black
End.

Related Snippets