[Back to CRT SWAG index] [Back to Main SWAG index] [Original]

    Unit IO;

    { Copyright (C) 1988 by P.Mackay. All Rights Reserved

       Name     :  IO

       Compiler :  Unit for Borland's Turbo-Pascal v4/5 ...

       Function :  Provides capability to easily use and switch between the 3
                     output methods available: ANSI/BIOS/DIRECT-WRITES.

       Guarantee:  If it breaks, you get to keep both pieces.

       Author   :  Phil Mackay,
                   21 Andrew Place, North Rocks
                   2151 N.S.W  Australia.                                      }

    interface

    Type
      OutType        = (ANSI,BIOS,DIRECT);

    Const
      CLS            = #27 + '[2J';
      Left           = #27 + '[1D';
      Right          = #27 + '[1C';
      Up             = #27 + '[1A';
      Down           = #27 + '[1B';
      Black          = #27 + '[30m';
      Blue           = #27 + '[34m';
      Green          = #27 + '[32m';
      Cyan           = #27 + '[36m';
      Orange         = #27 + '[31m';
      Purple         = #27 + '[35m';
      Red            = #27 + '[33m';
      White          = #27 + '[37m';
      BlackB         = #27 + '[40m';
      BlueB          = #27 + '[44m';
      GreenB         = #27 + '[42m';
      CyanB          = #27 + '[46m';
      OrangeB        = #27 + '[41m';
      PinkB          = #27 + '[45m';
      RedB           = #27 + '[43m';
      WhiteB         = #27 + '[47m';
      Bold           = #27 + '[1m';
      Flash          = #27 + '[5m';
      Off            = #27 + '[0m';

    var
      IOmethod         : OutType;
      backcolor        : integer;
    procedure IOGotoXY(x,y : integer);
    procedure IOTextColor(color : integer);
    procedure IOTextBackground(color : integer);
    procedure IOClrEol;
    procedure IOClrScr;
    procedure OutputMethod (Method : OutType);

    implementation

    Uses CRT;

    procedure IOGotoXY(x,y : integer);
    var
      Sx,Sy : string;
    begin
      if IOmethod = ANSI then
        begin
          Str(x,Sx);
          str(y,Sy);
          write(#27 + '[' + Sy + ';' + Sx + 'H');
        end
      else GotoXY(x,y);
    end;

    procedure IOTextColor(color : integer);

    var
      flashing : boolean;

    begin
      if IOmethod = ANSI then
        begin
          flashing := false;

          if color > 15 then
            begin
              color := color - 16;
              flashing := true;
            end
          else
            write (off);

          if color > 7 then
            begin
              color := color - 8;
              write (Bold);
            end
          else
            write (off);

          if flashing then write (flash);

          case color of
            0 : write (#27 + '[30m');
            1 : write (#27 + '[34m');
            2 : write (#27 + '[32m');
            3 : write (#27 + '[36m');
            4 : write (#27 + '[31m');
            5 : write (#27 + '[35m');
            6 : write (#27 + '[33m');
            7 : write (#27 + '[37m');
          end;
          IOTextBackground(Backcolor);
        end
      else TextColor(color);
    end;

    procedure IOTextBackground(color : integer);
    begin
      if IOmethod = ANSI then
        begin
          Case color of
            0 : write (#27 + '[40m');
            1 : write (#27 + '[44m');
            2 : write (#27 + '[42m');
            3 : write (#27 + '[46m');
            4 : write (#27 + '[41m');
            5 : write (#27 + '[45m');
            6 : write (#27 + '[43m');
            7 : write (#27 + '[47m');
            end;
          BackColor := color;
        end
      else TextBackground(color);
    end;

    procedure IOClrEol;
    begin
      if IOmethod = ANSI then write (#27 + '[K')
        else ClrEol;
    end;

    procedure IOClrScr;
    begin
      if IOmethod = ANSI then write (Cls)
        else clrscr;
    end;

    procedure OutputMethod (Method: OutType);

    begin
      Case Method of
        ANSI   : begin
                   assign (input,'');
                   reset (input);
                   assign (output,'');
                   rewrite (output);
                   IOmethod := ANSI;
                 end;
        BIOS   : begin
                   AssignCRT (output);
                   rewrite (output);
                   AssignCRT (input);
                   reset (input);
                   DirectVideo := false;
                   IOmethod := BIOS;
                 end;
        DIRECT : begin
                   AssignCRT (output);
                   rewrite (output);
                   AssignCRT (input);
                   reset (input);
                   DirectVideo := true;
                   IOmethod := DIRECT;
                 end;
      end;
    end;

    begin
      OutputMethod(ANSI);
    End.

    {--------------------------  DEMO ------------------------ }

    Program IOtester;

    Uses Crt, {only for the Keypressed function}
         IO;  {  <=== This is it }

    (*   This demo will demonstrate the pros and cons of the video addressing
         types. The only thing non-standard about it, is that this program
         uses KeyPressed to detect the "press any key .." which bypasses the
         Standard IO, and uses a BIOS keyboard routine.                       *)

    (* IO and IODEMO are written by P.Mackay. *)
    (* Copyright (C) 1988 All Rights Reserved *)

    procedure Routine;

    var
      i : integer;
      ch: char;

    begin
      IOClrScr;
      IOTextcolor(7);
      writeln ('TEST;  I/O testing program');
      IOgotoxy(6,4);
      IOtextcolor(2);
      writeln ('This program will demostrate the capabilities of the IO unit.');
      if IOmethod = ANSI then
        begin
          IOgotoxy(14,8);
          IOtextcolor(14);
          writeln ('Current operation: ANSI (standard-output)');
          IOgotoxy(1,10);
          IOtextcolor(3);
          writeln ('   ANSI output uses a special sequence of control codes to send information');
          writeln ('on things such as colour, cursor position etc .. A ANSI driver, however');
          writeln ('is required to see these. ANSI is slow, but very useful for re-direction');
          writeln ('in that it can be sent to a remote over a modem connection.');
        end;
      If IOmethod = BIOS then
        begin
          IOgotoxy(14,8);
          IOtextcolor(14);
          writeln ('Current operation: BIOS');
          IOgotoxy(1,10);
          IOtextcolor(3);
          writeln ('   BIOS output is many times slower than DIRECT, but it is useful in multi-');
          writeln ('tasking environments, where a program can re-route the BIOS video calls.');
          writeln ('Programs which have bulk output would not use BIOS, but BIOS is good for');
          writeln ('static output.');
        end;
      if IOmethod = DIRECT then
        begin
          IOgotoxy(14,8);
          IOtextcolor(14);
          writeln ('Current operation: DIRECT');
          IOgotoxy(1,10);
          IOtextcolor(3);
          writeln ('   DIRECT output is where a program directly writes to the memory on the');
          writeln ('display adapter. The only problems with this, is it sometimes causes snow');
          writeln ('and may not work on some flavours of MS-DOS. Direct-writes are used by');
          writeln ('most applications today, as it is so incredibly fast.');
          writeln ('   It is so fast, infact, you may not be able to see the line below becuase');
          writeln ('it is being updated so frequently. (depends on computer type)');
        end;

      IOgotoxy(15,16);
      IOtextcolor(15);
      write ('Speed test: (press any key)');

      i := 0;
      repeat
        IOgotoxy(5,20);
        write ('This is being written, wiped and re-written: ',i);
        IOgotoxy(5,20);
        write ('                                             ');
        i := i + 1;
      until keypressed;

      ch := readkey;
    end;

    begin
      CheckSnow := False;

      OutputMethod(ANSI);
      Write (BlackB);     (* Black background ANSI code *)
      Routine;

      OutputMethod(BIOS);
      Routine;

      OutputMethod(DIRECT);
      Routine;

      OutputMethod(ANSI);
      IOClrscr;
      IOTextcolor(15);
      IOTextbackground(1);
      Write ('IO; ANSI/BIOS/DIRECT routines for Turbo-Pascal v4 & 5 DEMO by P.Mackay');
      IOClrEol;
      IOTextbackground(0);
      IOTextcolor(7);
      writeln;
      writeln;
    end.

[Back to CRT SWAG index] [Back to Main SWAG index] [Original]