HPAVC/HPAVC CD-ROM.iso/pc/PRUS101.ZIP/FCRT.PAS

Pascal/Delphi Source File | 1994-12-19 | 38.0 KB | 1,132 lines

UNIT FCRT; { FIDO unit to enhance and replace TP's CRT unit, screen handling }
 (***************************************************************************

     RELEASE 1.14 - as first contained in the file PRUS101.LZH
        by Orazio Czerwenka, 2:2450/540.55, GERMANY

           --------------------------------------------
        organized for Fido's PASCAL related echoes
           --------------------------------------------

     05/14/1994 to 12/15/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
     12/15/1994 to --/--/---- by Paul Schubert,    2:244/1181.18, GERMANY


       As far as third party copyrights are not violated this
       source code is hereby placed to the public domain. Use
       it whatever way you want, but use AT YOUR OWN RISK.

       In case you should modify the source rather send your
       modifications to the unit's current organizer (see above for
       NM address) than to spread it on your own. This will help to
       keep the unit updated and grant a certain standard to all
       other users as well.

       The unit is currently still under work. So it might greatly
       benefit of your participation.

       Those who contributed to the following piece of source,
       listed in alphabethical order:
    ================================================================
       Ralph Brown(interrupt listings), Orazio Czerwenka, Jens
       Larsson, Max Maischein, Sean Palmer, Christian Proehl, Paul
       Schubert(FCONDRV.INC), SWAG Support Team (hardware indepen-
       dend delay) ...
    ================================================================
       YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.

       Special thanx to Paul Schubert who significantly enhanced
       this unit by contributing an additional include file FCONDRV
       to partially clone and improve CRT's screen related standard
       routines.

       Credits in your own programs are as welcome as unnecessary.

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

{$I FDEFINE.DEF} { Use the general include file for conditional defines and
           common compiler directives ... }

         { ... and set the unit's specific defines aftwerwards. }

{$A+}            { A+ will slightly speed up some of the more important
           source }

{$F+,R-,S-}

Interface
USES
  dos;

CONST

  { Don't yet rely on these colour constants, they have been implemented
    only for usage by another unit currently under work but might well
    cease to be included in future releases }

  BLACK     =   0; BLUE      =  16; GREEN     =  32; CYAN      =  48;
  RED       =  64; MAGENTA   =  80; BROWN     =  96; LIGHTGRAY = 112;


  PageFlipping : Boolean = TRUE;

  TEXTATTR       : BYTE = 7;
  WINDMIN        : WORD = 0;
  WINDMAX        : WORD = 6223;
  DIRECTVIDEO    : BOOLEAN = TRUE;


TYPE
  NameStr       = STRING[8];
  CursorShape   = RECORD top, bottom : byte; END;


  { These routines are for internal use ONLY. In no way you should try to
    mess around with it, if you'd like to keep your programs being capable
    of getting compiled with further improved versions of this unit. }

  DisplayAtProc = Procedure(x,y:word;at:byte;s:string);


var
  VideoRAM         : word;                 { start address of video ram }
  VideoPageSize    : word absolute $40:$4C;{ the size of an video page  }
  CurrentVideoMode : Byte Absolute $40:$49;{ the mode currently in use  }

  StartVideoPage,                          { the page upon start }
  StartVideoMode,                          { the mode upon start }
  VisualVideoPage,                         { the page 'really' in foreground }
  ActiveVideoPage,                         { used to store page to write on  }
  MaxX, MaxY,



  { Don't yet rely on that on, it might perish in future releases as well. }

  LastVideoMode   : byte;


  { These routines are for internal use ONLY. In no way you should try to
    mess around with it, if you'd like to keep your programs being capable
    of getting compiled with further improved versions of this unit. }

  OptDisplayAt    : DisplayAtProc;   {OptDisplay      : DisplayProc;}


procedure InitFCRT;             { !!! Call prior to any other functions !!! }
procedure ReInitFCRT;

procedure DisablePageFlipping;
procedure EnablePageFlipping;

procedure EnableLightBackground (b:boolean);
procedure SetBlinkBit (b:boolean);
procedure ScrOn;
procedure ScrOff;

function  GetVideoDisplayCode: Byte;
function  GetCardStr: NameStr;
function  VGACard: boolean;
function  EGAAvail: boolean;
function  VGAAvail: boolean;
function  VGAMode: boolean;
function  EGAMode: boolean;

function  GetVideoMode: word;

procedure SetVideoMode(mode: word);

procedure SetActiveVideoPage(page: byte);
procedure SetVisualVideoPage(page: byte);

function  GetX: byte;
function  GetY: byte;
procedure SetScreenPos(x,y:byte);

procedure PutCharAttr(cha:char;attr:byte;nr:Word);
procedure CRLF;

procedure Display(at:byte;s:string);
procedure DisplayLn(at:byte;s:string);
procedure DisplayAt(x,y:word;at:byte;s:string);

(*{$F+}*)

   { These routines are basically for the units internal use and will
     possibly be changed. So don't use'em directly by now, or extract'em
     to a personal unit of yours. There is no guarantee yet that they will
     be included in future releases also. }

procedure StdDisplay(at:byte;s:string);
procedure StdDisplayAt(x,y:word;at:byte;s:string);
procedure QuickDisplay(at:byte;s:string);
procedure QuickDisplayAt(x,y:word;at:byte;s:string);
procedure FastDisplayAt(x,y:word;at:byte;s:string);

(*{$F-}*)

procedure CursorRight(m:byte);
procedure CursorLeft(m:byte);
procedure CursorUp(m:byte);
procedure CursorDown(m:byte);
procedure SaveCursorShape(VAR CurShape:CursorShape);
procedure RestoreCursorShape(CurShape:CursorShape);
procedure SetCursorShape (FirstLine, LastLine : byte);

procedure HideCursor;
procedure NormCursor;
procedure BoxCursor;
procedure MinCursor;

procedure ColourBox (x,y,xx,yy,at:byte);
procedure ColourColumn (x,y,yy,at:byte);
procedure ColourRow (x,y,xx,at:byte);
procedure ClearBox (x,y,xx,yy,at:byte);


procedure Delay(ms : Word);

{ window related operations }
procedure ClrScr;
procedure GotoXY(x,y:Byte);
function  WhereX:Byte;
function  WhereY:Byte;
procedure Window(x,y,xx,yy:Byte);
procedure ClrEoL;

procedure AssignFCRT (var F : Text);
{ AssignFCRT() works similar to AssignCRT to return to FCRT
  output after having its output reassigned }

{ non-window related operations to address the screen
  absolutely }
procedure ClrScrAbsolute;
procedure GotoXYAbsolute(x,y:Byte);
function  WhereXAbsolute:Byte;
function  WhereYAbsolute:Byte;


{ don't use yourself the following routines by now, they
 still need to be significantly modified }
procedure PushWindow;
procedure PopWindow;
procedure ClrEoS;
{ clear to end of screen }


Implementation

var
  ch               : char;
  w,CRTC           : word;
  i                : integer;

{$I FCONDRV.INC}

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetCursorShape (FirstLine , LastLine : byte)                           │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetCursorShape (FirstLine , LastLine : byte); assembler;
{ Original author: Orazio Czerwenka }
ASM
  MOV   CH,FirstLine                    { set top scan line }
  MOV   CL,LastLine                     { set bottom scan line }
  MOV   AH,01h                          { set text mode cursor shape }
  INT   10h                             { call int 10h }
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ HideCursor                                                             │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure HideCursor;                   { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
  SetCursorShape($FF,$FF);                   { top & bottom to line 256 }
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ NormCursor                                                             │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure NormCursor;                   { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
  SetCursorShape($06,$07);
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ BoxCursor                                                              │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure BoxCursor;                    { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
  SetCursorShape($01,$07);
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ MinCursor                                                              │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure MinCursor;                    { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
  SetCursorShape($07,$07);
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SaveCursorShape (var CurShape : CursorShape)                           │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SaveCursorShape (var CurShape:CursorShape);
{ Original author: Orazio Czerwenka }
var
  regs  :       Registers;
begin
  Regs.AH:= $03;                        { get cursor size }
  Regs.BH:= ActiveVideoPage;            { page number }
  INTR($10,regs);                       { call int 10h }
  with regs do begin
    CurShape.top:=CH;                   { save top scan line }
    CurShape.bottom:=CL;                { save bottom scan line }
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ RestoreCursorShape (CurShape : CursorShape)                            │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure RestoreCursorShape (CurShape:CursorShape);
{ Original author: Orazio Czerwenka }
var
  regs    :       Registers;
begin
  with regs do
  begin
    AH:= $01;                           { set text mode cursor shape }
    CH:= CurShape.top;                  { restore top scan line }
    CL:= CurShape.bottom;               { restore bottom scan line }
    INTR($10,regs);                     { call int 10h }
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorRight (m : Byte)                                                 │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorRight(m:byte); assembler;
{ Original author: Orazio Czerwenka }
  asm
    mov  ah, 03h                        { get cursor position }
    mov  bh, ActiveVideoPage            { page number }
    int  10h
    mov  ah, 02h                        { set cursor position }
    mov  bh, ActiveVideoPage            { page number }
    mov  al, m
    add  al, dl
    mov  dl, al
    int  10h
  end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorLeft (m : Byte)                                                  │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorLeft(m:byte); assembler;
{ Original author: Orazio Czerwenka }
  asm
    mov  ah, 03h                        { get cursor position }
    mov  bh, ActiveVideoPage            { page number }
    int  10h
    mov  cl, dl
    mov  ah, 02h                        { set cursor position }
    mov  bh, ActiveVideoPage            { page number }
    mov  al, m
    sub  al, cl
    mov  dl, al
    int  10h
  end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorUp (m : Byte)                                                    │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorUp(m:byte); assembler;
{ Original author: Orazio Czerwenka }
  asm
    mov  ah, 03h                        { get cursor position }
    mov  bh, ActiveVideoPage            { page number }
    int  10h
    mov  cl,  dh
    mov  ah, 02h                        { set cursor position }
    mov  bh, ActiveVideoPage            { page number }
    mov  al, m
    sub  al, cl
    mov  dh, al
    int  10h
  end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorDown (m : Byte)                                                  │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorDown(m:byte); assembler;
{ Original author: Orazio Czerwenka }
  asm
    mov  ah, 03h                        { get cursor position }
    mov  bh, ActiveVideoPage            { page number }
    int  10h
    mov  cl,  dh
    mov  ah, 02h                        { set cursor position }
    mov  bh, ActiveVideoPage            { page number }
    mov  al, m
    add  al, cl
    mov  dh, al
    int  10h
  end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetScreenPos ( x,y : Byte )                                            │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetScreenPos (x,y:byte);  assembler;
{ Original author: Orazio Czerwenka }
ASM
  MOV   AH, 02h                          { set cursor position }
  MOV   BH, ActiveVideoPage              { page number }
  MOV   DL, x                            { column }
  MOV   DH, y                            { row }
  SUB   DX, 0101h                        { dec DH,DL }
  INT   10h                              { call int 10h }
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ PutCharAttr (cha : char; attr : byte; nr : Word)                       │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure PutCharAttr(cha:char;attr:byte;nr:Word); assembler;
{ Original author: Orazio Czerwenka }
asm
  mov ah,09h                           { write character and attribute }
  mov al,cha                           { character }
  mov bh,ActiveVideoPage               { page number }
  mov bl,attr                          { attribute }
  mov cx,nr                            { number of times to write }
  int 10h                              { call int 10h }
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourBox (x,y,xx,yy,at : Byte)                                        │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourBox (x,y,xx,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
  b1,
  b2    :       byte;
  regs  :       registers;
  ch    :       char;
begin
  for b1:= x to xx do begin
    for b2:= y to yy do begin
      SetScreenPos(b1,b2);
      with regs do begin
    ah:= $08;                       { read character and attribute }
    bh:= ActiveVideoPage;           { page number }
    intr($10,regs);                 { call int 10h }
    ch:= al;                        { save character }
    PutCharAttr(chr(ord(ch)),at,1);
      end;
    end;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourColumn (x,y,yy,at : Byte)                                        │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourColumn (x,y,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
  b     :       byte;
  ch    :       char;
  regs  :       registers;
begin
  for b:= y to yy do begin
    SetScreenPos(x,b);
    With regs do begin
      ah:= $08;                         { read character and attribute }
      bh:= ActiveVideoPage;             { page number }
      intr($10,regs);                   { call int 10h }
      ch:= al;                          { save character }
      PutCharAttr(chr(ord(ch)),at,1);   { change colour attribute }
    end;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourRow (x,y,xx,at : Byte)                                           │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourRow (x,y,xx,at:byte);
{ Original author: Orazio Czerwenka }
var
  b     :       byte;
  ch    :       char;
  regs  :       registers;
begin
  for b:= x to xx do begin
    SetScreenPos(b,y);
    with regs do begin
      ah:= $08;                         { read character and attribute }
      bh:= ActiveVideoPage;             { page number }
      intr($10,regs);                   { call int 10h }
      ch:= al;                          { save character }
      PutCharAttr(chr(ord(ch)),at,1);   { change colour attribute }
    end;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ClearBox (x,y,xx,yy,at : Byte)                                         │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ClearBox (x,y,xx,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
  aa,ax,ay,axx,ayy{,
  b2}    :       byte;
begin

  aa  := TextAttr;
  ax  := Succ(Lo(WindMin));
  ay  := Succ(Hi(WindMin));
  axx := Succ(Lo(WindMax));
  ayy := Succ(Hi(WindMax));

  window(x,y,xx,yy);
  textattr:= at;
  ClrScr;
  window(ax,ay,axx,ayy);
  textattr:= aa;
  {

  for b2:= y to yy do begin
    SetScreenPos(x,b2);
    PutCharAttr(chr($20),at,xx-x+1);
  end;
  }

end;


{ ************************************************************************** }

procedure StdDisplayAt(x,y:word;at:byte;s:string);
{ Original author: Orazio Czerwenka }
var
  i     :       byte;
begin
  for i:= 1 to length(s) do begin
    SetScreenPos(x,y);
    PutCharAttr(s[i],at,1);
    inc(x);
  end;
end;


{ ************************************************************************** }

procedure QuickDisplayAt(x,y:word;at:byte;s:string);
{ Original author: Sean Palmer
  modifications Orazio Czerwenka }
var
  vidPtr : ^word;
  cnter,
  attrib : word;
begin
  attrib := swap(at);
  CASE ActiveVideoPage OF
    0: vidptr := ptr(VideoRAM,
                (MaxX * pred(Y) + pred(X)) SHL 1);
    1: vidptr := ptr(VideoRAM,  VideoPageSize
                  + (MaxX * pred(Y) + pred(X)) SHL 1
            );
    2: vidptr := ptr(VideoRAM,  VideoPageSize SHL 1
                  + (MaxX * pred(Y) + pred(X)) SHL 1
            );
    4: vidptr := ptr(VideoRAM,  VideoPageSize SHL 2
                  + (MaxX * pred(Y) + pred(X)) SHL 1
            );
  else vidptr := ptr(VideoRAM,  VideoPageSize*ActiveVideoPage
                  + (MaxX * pred(Y) + pred(X)) SHL 1
            );
  end;
  for cnter := 1 to length(s) do
  begin
    vidptr^ := attrib or byte (s[cnter]);
    inc(vidptr);
  end;
end;


{ ************************************************************************** }

procedure FastDisplayAt(x,y:word;at:byte;s:string); assembler;
{ Original author: Jens Larsson }
asm
  dec   x
  dec   y

  mov   ax,y
  mov   cl,5
  shl   ax,cl
  mov   di,ax
  mov   cl,2
  shl   ax,cl
  add   di,ax
  shl   x,1
  add   di,x

  mov   ax,VideoRAM {0b800h}     { 0b000h for mono }
  mov   es,ax
  xor   ch,ch
  push  ds
  lds   si,s
  lodsb
  mov   cl,al
  mov   ah,at
  jcxz  @@End
@@L1:
  lodsb
  stosw
  loop  @@L1
@@End:
  pop   ds
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisplayAt (x,y : Word; at : Byte; s : string)                          │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisplayAt(x,y:word;at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
  OptDisplayAt(x,y,at,s);
{  SetScreenPos(x+ord(s[0]),y);}
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetVideoDisplayCode : Byte                                             │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetVideoDisplayCode: Byte;
{ Original author: Orazio Czerwenka }
begin
  asm
    mov   ax,      1A00h              { read video-display combination code }
    int   10h
    cmp   al,      1Ah                { ps/2 compatible ? }
    je   @OK
    xor   cl,      cl                 { to evaluate unsupported or unknown  }
    mov   @result, cl
    jmp  @END
   @OK:
    mov   @result, bl
   @END:
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetCardStr : NameStr                                                   │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetCardStr: NameStr;
{ Original author: Orazio Czerwenka }
begin
  case GetVideoDisplayCode of
    $00: GetCardStr:= 'none';      { no graphics adapter }
    $01: GetCardStr:= 'mda';       { monochrome display adapter (= hgc ?) }
    $02: GetCardStr:= 'cga_c';     { _c w/ colour, _m w/ monochrome display }
    $04: GetCardStr:= 'ega_c';
    $05: GetCardStr:= 'ega_m';
    $06: GetCardStr:= 'pga_c';
    $07: GetCardStr:= 'vga_m_a';   { _a w/ analag, _d w/ digital display }
    $08: GetCardStr:= 'vga_c_a';
    $0a: GetCardStr:= 'mcga_c_d';
    $0b: GetCardStr:= 'mcga_m_a';
    $0c: GetCardStr:= 'mcga_c_a';
    $ff: GetCardStr:= 'unknown';
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGACard : Boolean                                                      │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function VGACard: boolean;      { returns true even if in ega mode }
{ Original author: Orazio Czerwenka }
var                             { should work on none ps/2 as well }
  regs  :       registers;      { for it directly goes the vgabios }
begin
  regs.ah:= $12;                { alternate function select }
  regs.bl:= $34;                { cursor emulation, vga bios only }
  regs.al:= $00;                { enable cursor emulation }
  intr($10,regs);
  VGACard:= regs.al = $12;      { al = $12 if function supported }
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EGAAvail : Boolean                                                     │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
Function EGAAvail : Boolean; Assembler;           { true for ega AND higher }
{ Original author: Orazio Czerwenka
  modifications according to Max Maischein }
Asm
  push    bp
  mov     ax, 1130h
  xor     bh, bh
  int     10h
  mov     al, 0
  cmc
  adc     al, al
  pop     bp
End;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGAAvail : Boolean                                                     │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
Function VGAAvail : Boolean;
{ Original author Orazio Czerwenka,
  modifications according to Max Maischein }
Assembler;
{INT 10 - VIDEO - GET INDIVIDUAL PALETTE REGISTER (VGA)}
Asm
  mov     ax, 1007h
  xor     bx, bx
  int     10h
  mov     al, 1
  sbb     al, 0
  ret
End;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGAMode : Boolean                                                      │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function VGAMode: boolean;              { PS,VGA/MCGA }
{ Original author: Orazio Czerwenka }
var
 regs   :       registers;
begin
    regs.ah:= $1a;                      { video display combination }
    regs.al:= $00;                      { read display combination code }
    intr($10,regs);                     { do it babe, do it }
    VGAMode:= (regs.al=$1a) and (regs.bl in [$07,$08])
  end;                                  { al=$1a if function supported,
                      bl=$07,$08 if in vga mode }


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EGAMode : Boolean                                                      │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function EGAMode: boolean;              { PS,VGA/MCGA }
{ Original author: Orazio Czerwenka }
var
 regs   :       registers;
begin
    regs.ah:= $1a;                      { video display combination }
    regs.al:= $00;                      { read display combination code }
    intr($10,regs);                     { do it babe, do it }
    EGAMode:= (regs.al=$1a) and (regs.bl in [$04,$05])
  end;                                  { al=$1a if function supported (PS,
                      VGA/MCGA), bl=$07,$08 if vga (or
                      mcga?) in egamode }


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CRLF                                                                   │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CRLF; assembler;
{ Original author: Max Maischein }
{ modifications Orazio Czerwenka }
asm
  mov al, 0Dh
  int 29h
  mov al, 0Ah
  int 29h
end;


{ ************************************************************************** }

procedure QuickDisplay(at:byte;s:string);
{ Original author: Sean Palmer
  modifications Orazio Czerwenka }
var
  vidPtr : ^word;
  cnter,
  attrib : word;
begin
  attrib := swap(at);
  vidptr := ptr(VideoRAM,  VideoPageSize*ActiveVideoPage
              + (MaxX * pred(GetY) + pred(GetX)) SHL 1
              );
  for cnter := 1 to length(s) do
  begin
    vidptr^ := attrib or byte(s[cnter]);
    inc(vidptr);
  end;
  Cursorright(length(s));
end;


{ ************************************************************************** }

procedure StdDisplay(at:byte;s:string);
{ Original author: Orazio Czerwenka }
var
  i     :       byte;
begin
  for i:= 1 to length(s) do begin
    if GetX > MaxX then SetScreenPos(1,GetY+1);
    PutCharAttr(s[i],at,1);
    CursorRight(1);
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ Display (at : Byte; s : String)                                        │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure Display(at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
  {
  quickDisplay(at,s);
  }
  textattr:= at;
  write(s);
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisplayLn (at : Byte; s : String)                                      │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisplayLn(at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
  Display(at,s);
  CRLF;
end;


{ ************************************************************************** }

procedure SetOptimalDisplay;
{ Original author: Orazio Czerwenka }
begin
  if PageFlipping then
    OptDisplayAt:= QuickDisplayAt
  else begin
    if (MaxX = 80) and (ActiveVideoPage = 0)
      then OptDisplayAt:= FastDisplayAt
      else OptDisplayAt:= QuickDisplayAt;
  end
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EnablePageFlipping                                                     │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure EnablePageFlipping;
{ Original author: Orazio Czerwenka }
begin
  PageFlipping:= true;
  SetOptimalDisplay;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisablePageFlipping                                                    │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisablePageFlipping;
{ Original author: Orazio Czerwenka }
begin
  PageFlipping:= false;
  SetOptimalDisplay;
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetX : Byte                                                            │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetX: byte;
{ Original author: Orazio Czerwenka }
begin
  GetX:= Succ(Mem[$40:$50+ActiveVideoPage shl 1]);       { tested for VGA }
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetY : Byte                                                            │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetY: byte;
{ Original author: Orazio Czerwenka }
begin
  GetY := Succ(Mem[$40:$51+ActiveVideoPage shl 1]);      { tested for VGA }
  if (not VGAAvail) and EGAAvail
    then GetY:= Mem[$40:$51+ActiveVideoPage shl 1];      { untested for EGA }
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ Delay (ms : Word)                                                      │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }

procedure Delay(ms : Word); Assembler;
{ SWAG Support Team }
Asm {machine independent Delay function}
  mov ax, 1000;
  mul ms;
  mov cx, dx;
  mov dx, ax;
  mov ah, $86;
  int $15;
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetVideoMode : Word                                                    │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetVideoMode: word;
{ Original author: Orazio Czerwenka }
var
  regs  : registers;
begin
  regs.ah:= $0F;
  intr($10,regs);
  GetVideoMode:= regs.al;
end;

procedure SetVideoMode(Mode:Word);
{ Original author: Orazio Czerwenka,
  modified by Paul Schubert }
begin
  if Mode <> CurrentVideoMode then
    LastVideoMode:= CurrentVideoMode;
  asm
    mov ax,mode
    int 10h
  end;
  ReInitFCRT;
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetActiveVideoPage (page : Byte)                                       │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetActiveVideoPage(page:byte);
{ Original author: Orazio Czerwenka
  modified by Paul Schubert }
begin
  if PageFlipping then begin
    ActiveVideoPage:= page;
    windmin := wmi[page];
    windmax := wma[page];
  end;
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetVisualVideoPage (page : Byte)                                       │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetVisualVideoPage(page:byte);
{ Original author: Orazio Czerwenka }
begin
  if PageFlipping then begin
    asm
      mov  AH, 05h                  { set active page }
      mov  AL, page                 { page number }
      int  10h
    end;
    VisualVideoPage:= page;
    Mem[$40:$62]:= VisualVideoPage;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetBlinkBit (b: Boolean)                                               │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetBlinkBit (b:boolean);       { supposed to work on HGC/EGA/VGA }
{ Posted by Christian Proehl
  05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
const
  HGC = 7;
var
  PortAddr : word;
  regs     : registers;
begin
  regs.AX:= $1003;
  if GetVideoMode = HGC
    then PortAddr:= $3B8
    else PortAddr:= $3D8;
  if b then begin
    regs.BL:= $01;
    intr($10,regs);
    if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
  end
  else begin
    regs.BL:= $00;
    intr($10,regs);
    if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EnableLightBackground (b : Boolean)                                    │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure EnableLightBackground (b:boolean);       { supposed to work on MDA/EGA/VGA }
{ Posted by Christian Proehl
  05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
const
  MDA = 7;
var
  PortAddr : word;
  regs     : registers;
begin
  regs.AX:= $1003;
  if GetVideoMode = MDA
    then PortAddr:= $3B8
    else PortAddr:= $3D8;
  if b then begin
    regs.BL:= $00;
    intr($10,regs);
    if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
  end
  else begin
    regs.BL:= $01;
    intr($10,regs);
    if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
  end;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ScrOn                                                                  │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ScrOn;
  procedure VGAScrOn; assembler;
  { Original author: Max Maischein, CRT2 }
  asm
    mov  bl, 36h
    mov  ax, 1200h
    int  10h
  end;
begin
  if VGACard then VGAScrOn;
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ScrOff                                                                 │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ScrOff;
  procedure VGAScrOff; assembler;
  { Original author: Max Maischein, CRT2 }
  asm
    mov  bl, 36h
    mov  ax, 1201h
    int  10h
  end;
begin
  if VGACard then VGAScrOff;
end;


{ ************************************************************************** }

procedure InitAtStart;
begin
  StartVideoPage  := Mem[$40:$62];
  VisualVideoPage := StartVideoPage;
  ActiveVideoPage := VisualVideoPage;
  StartVideoMode  := CurrentVideoMode;
  LastVideoMode   := StartVideoMode;
end;

{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ReInitFCRT                                                             │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ReInitFCrt;
{ Original author: Orazio Czerwenka }
begin

  if CurrentVideoMode = 7
    then VideoRAM:= $B000
    else VideoRAM:= $B800;

  MaxY:= Mem[$40:$84];
  if VGACard then inc(MaxY);
  MaxX:= Mem[$40:$4A];
  SetOptimalDisplay;

  REINITFCONDRV;
  ASSIGNFCRT(OUTPUT);
  REWRITE(OUTPUT);
end;


{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ InitFCRT                                                               │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure InitFCRT;
begin
  InitAtStart;
  ReInitFCRT;
end;

{$IFOPT O-}
begin
  InitFCRT;
{$ENDIF}
end.