Unit Video;

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

{* Subprograms that use GRAPHICS, CRT, or SCREEN.

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

{* BackUpLine         I/O       CRT

{* BackUpLines        I/O       CRT

{* BorderBottom       I/O       CRT

{* BorderConnectHorizontal      I/O  CRT

{* BorderConnectVertical        I/O  CRT

{* BorderTop          I/O       CRT

{* Clr                I/O       CRT

{* ClrEOS             I/O       CRT

{* ClrLine            I/O       CRT

{* DeleteSkip         I/O       CRT

{* ReverseVideo       I/O       CRT

{* Skip               I/O       CRT

{* WinBox             I/O       CRT     bordered window

{* WinIn              I/O       CRT     windows

{* WinOut             I/O       CRT     windows

{* Wr2T               I/O       CRT

{* WrLn2T             I/O       CRT

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



interface

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

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

Type

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

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



procedure BackUpLine;

procedure BackUpLines(NumLines: integer);

Procedure BorderBottom(Y: byte);

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

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

Procedure BorderTop(Y: byte);

procedure Clr;

procedure ClrEOS;

procedure ClrLine;

procedure DeleteSkip;

Procedure InitGraphics;

Procedure ReverseVideo;

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,

  Globals,

  Graph,

  MiscSubs;



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 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 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(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;

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

begin

  writeln('Fix REVERSE VIDEO!!!');

  writeln(Beep);

  readln;

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.