{$D-}

Unit Scrn;



interface

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

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

Type

  WinArray = array[1..6] of byte;

  ScreenArray = array[1..25] of string[80];



procedure BackUpLine;

procedure BackUpLines(NumLines: integer);

procedure Beep;

Procedure BorderBottom(Y: byte);

Procedure BorderConnectHorizontal(Y, X1, X2: byte);

Procedure BorderConnectVertical(X, Y1, Y2: byte);

Procedure BorderTop(Y: byte);

Procedure Center(InStr: string);

procedure Clr;

procedure ClrEOS;

procedure ClrLine;

procedure DeleteSkip;

Procedure InitGraphics;

Procedure ReverseVideo(On: boolean);

procedure WinBox(Box: WinArray);

procedure WinIn(Box: WinArray);

procedure WinOut(var Box: WinArray);

procedure Wr2T(var TextFile: text; StrLine: string);

procedure WrLn2T(var TextFile: text; StrLine: string);



implementation

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

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

Uses

  Crt,

  Dos,

  Glob,

  Graph,

  Data;



procedure BackUpLine;

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

var

  PresentLine: integer;

begin

  PresentLine := WhereY;

  if PresentLine = 1 then

    PresentLine := 2;

  GotoXY(1, PresentLine - 1);

  ClrEol;

end;



procedure BackUpLines(NumLines: integer);

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

var

  alpha: integer;

begin

  for alpha := 1 to NumLines do

    BackUpLine;

end;



procedure Beep;

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

begin

  write(#7);

end;



Procedure BorderBottom(Y: byte);

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

var

  alpha: integer;

begin

  GotoXY(1, Y);

  write(DoubleBottomLeft);

  for alpha := 2 to 79 do

    write(DoubleHorizontal);

  write(DoubleBottomRight);

end;



Procedure BorderConnectHorizontal(Y, X1, X2: byte);

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

var

  alpha: byte;

begin

  GotoXY(X1, Y);

  write(DoubleTeeRight);

  for alpha := X1+1 to X2-1 do

    write(DoubleHorizontal);

  write(DoubleTeeLeft);

end;



Procedure BorderConnectVertical(X, Y1, Y2: byte);

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

var

  Y: byte;

begin

  GotoXY(X, Y1);

  write(DoubleTeeDown);

  GotoXY(X, Y2);

  write(DoubleTeeUp);

  for Y := Y1+1 to Y2-1 do

    begin

      GotoXY(X, Y);

      write(DoubleVertical);

    end;

end;



Procedure BorderTop(Y: byte);

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

var

  alpha: integer;

begin

  GotoXY(1, Y);

  write(DoubleTopLeft);

  for alpha := 2 to 79 do

    write(DoubleHorizontal);

  write(DoubleTopRight);

end;



Procedure Center(InStr: string);

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

var

  Lead,

  Tail: byte;

begin

  for Lead := 1 to (80 - (length(InStr))) div 2 do

    write(' ');

  write(InStr);

  for Tail := 1 to 80 - Lead - length(InStr) do

    write(' ');

end;

procedure Clr;

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

begin

  clrscr;

end;



procedure ClrEOS;

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

var

  alpha: integer;

  SaveY: integer;

begin

  SaveY := WhereY;

  for alpha := WhereY to 25 - WhereY do

    begin

      ClrEol;

      writeln;

    end;

  GotoXY(1, SaveY);

end;



Procedure ClrLine;

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

begin

  write(Data.MultiChar(' ',79));

  GotoXY(1, WhereY);

end;



procedure DeleteSkip;

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

var

  SaveY: integer;

begin

  SaveY := WhereY;

  GotoXY(1, SaveY - 2);

  DelLine;

  GotoXY(1, SaveY-1);

end;



Procedure InitGraphics;

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

{*  Task:  This procedure switches from CRT mode text output to graphics.

{*  Author:  C1C David W. Croft, CS-36, x4306

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

var

  GraphDriver: integer;

  GraphMode: integer;

  ErrorCode: integer;

begin

  DetectGraph(GraphDriver, GraphMode);

  InitGraph(GraphDriver, GraphMode, '');

  ErrorCode := GraphResult;

  if ErrorCode <> grOk then

    begin

      Writeln('Graphics error:  ',GraphErrorMsg(ErrorCode));

      Writeln('Program aborted...');

      Halt(1);

    end;

end;



Procedure ReverseVideo(On: boolean);

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

begin

  if On then

    begin

      TextBackground(White);

      TextColor(Black);

    end

  else

    begin

      TextBackground(Black);

      TextColor(White);

    end;

end;



procedure WinBox(Box: WinArray);

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

var

  alpha: byte;

  X1, Y1, X2, Y2: byte;

begin

  X1 := Box[1] -1;

  Y1 := Box[2] -1;

  X2 := Box[3] +1;

  Y2 := Box[4] +1;

  GotoXY(X1, Y1);

  write(#201);

  GotoXY(X2, Y1);

  write(#187);

  GotoXY(X1, Y2);

  write(#200);

  GotoXY(X2, Y2);

  write(#188);

  for alpha := X1+1 to X2-1 do

    begin

      GotoXY(alpha, Y1);

      write(#205);

      GotoXY(alpha, Y2);

      write(#205);

    end;

  for alpha := Y1+1 to Y2-1 do

    begin

      GotoXY(X1, alpha);

      write(#186);

      GotoXY(X2, alpha);

      write(#186);

    end;

end;



procedure WinIn(Box: WinArray);

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

begin

  window(Box[1], Box[2], Box[3], Box[4]);

  gotoXY(Box[5], Box[6]);

end;



procedure WinOut(var Box: WinArray);

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

begin

  Box[5] := WhereX;

  Box[6] := WhereY;

  window(1, 1, 80, 25);

end;



procedure Wr2T(var TextFile: text; StrLine: string);

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

begin

  Write(TextFile, StrLine);

  Write(StrLine);

end;



procedure WrLn2T(var TextFile: text; StrLine: string);

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

begin

  WriteLn(TextFile, StrLine);

  WriteLn(StrLine);

end;



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

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

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

begin

end.