{
#
    terminal demo program

    uses many features similar to the turbo pascal crt unit, including

    - colour support,
    - cursor positioning
    - unbuffered key read
    - read special keys
    - etc
}

{ assumes a terminal with ANSI support and POSIX environment.}

program Console(input, output);

  {derived from ... }
  {ANSI Alternative to turbo pascal CRT unit}
  {By Rick Housh - CIS PIN 72466,212}
  {Uses standard ANSI calls for all cursor placement, color attribute }
  { changes, etc., }

  { google "ansi console codes" for details }

(**************************************************************************)
{ All of the Text Color constants are supported.

  None of the Crt Mode constants are supplied.

  The variable CheckBreak is present, but not implemented.
  None of the other variables are supported, as almost all have to do
  with various aspects of direct screen writing, which is not supported.

  It is possible to do much more with ANSI actually, than with many of
  Turbo's standard CRT procedures, but no extras were implemented, in
  the interest of compatibility with Turbo.

  There is one major limitation.  The window procedure is not supported.
  In the interest of universal compatibility Textmode is also not supported,
  although it could be.

  The following CRT unit functions and procedures are supported as follows:
    AssignCrt      :   Not supported
    ClrEol         :   Fully supported
    ClrScr         :   Fully supported
    Delay          :   Not supported
    DelLine        :   Not supported    (Could easily be, but never used it)
    GotoXY         :   Fully supported
    HighVideo      :   Fully supported
    InsLine        :   Not Supported    (See DelLine)
    LowVideo       :   Fully supported
    NoSound        :   Not supported
    Sound          :   Not supported
    TextBackground :   Fully supported
    TextColor      :   Fully supported
    TextMode       :   Not supported
    Window         :   Not supported
    KeyPressed     :   Fully supported
    NormVideo      :   Fully supported
    ReadKey        :   Fully supported
    WhereX         :   Fully supported
    WhereY         :   Fully supported


        This program is dedicated to the public domain.
        No copyright is claimed.
        I would be interested in reports.
                    Rick Housh
                    5811 W. 85th Terr.
                    Overland Park, KS 66207
                    Tel. 913/341-7592
                    Compuserve PIN #72466,212

}

{@@ #include <termios.h> @@}
{@@ #include <sys/select.h> @@}

label 99;

  Const
    Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5;
    Brown = 6; LightGray = 7; DarkGray = 8; LightBlue = 9;
    LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13;
    Yellow = 14; White = 15; Blink = 128;

  strLen = 6;
  type
     byte   = 0..255;
     string =  packed array[1..strLen] of char;

  Var
     CheckBreak, Blinking   : Boolean;
     ForeColour, BackColour : Byte;

     x, y, i : byte;
     NameStr : string;
     ch      : char;



  {Note:
     In pascal (and C), console i/o is line buffered.
     This means you can't read a character until the return key
     is pressed.
     The keyPressed and ReadKey functions below use low level trickery to
     get round this.
  }

  { Replacement for CRT.KeyPressed
    Detects whether a key is pressed
    Does nothing with the key
    Returns true if key is pressed
    Otherwise, false
    Key remains in kbd buffer}
Function KeyPressed : boolean;

  Begin

      KeyPressed := true; {dummy asign to prevent compile error}


/**
 (POSIX) implementation of _kbhit().
 Morgan McGuire, morgan@cs.brown.edu

eg see http://www.flipcode.com/archives/_kbhit_for_Linux.shtml

see also
http://www.linuxquestions.org/questions/programming-9/differences-between-ncurses-library-and-termios-struct-w-r-t-keyboard-reading-805611/#post3956458

 */
{@@ {}

    bool r;
    struct termios term, orig;

    // Use termios to turn off line buffering
    tcgetattr(STDIN_FILENO, &orig);
    term = orig;
    term.c_lflag &= ~ICANON & ~ECHO;
    tcsetattr(STDIN_FILENO, TCSANOW, &term);
    //setbuf(stdin, NULL);

    struct timeval timeout;
    timeout.tv_sec  = 0;
    timeout.tv_usec = 0;

    fd_set rdset;
    FD_ZERO(&rdset);
    FD_SET(STDIN_FILENO, &rdset);
    select(STDIN_FILENO + 1, &rdset, NULL, NULL, &timeout);
    r = FD_ISSET(STDIN_FILENO, &rdset);
    tcsetattr(STDIN_FILENO, TCSANOW, &orig);
    return r;
@@}

  end; { KeyPressed }


  Function ReadKey : char;  { Replacement for CRT.ReadKey }
                            { Just like ReadKey in CRT unit}
  var chrout: char;
    Begin

      {Char input w/o echo}
      If CheckBreak and (chrout = chr(3)) then  {If it's a ^C and CheckBreak}
        Begin                             {then execute Ctrl_Brk}
        end;

{@@ {}
   int            ch;
   struct termios old;
   struct termios tmp;

   tcgetattr(STDIN_FILENO, &old);
   tmp = old;
   tmp.c_lflag &= ~ICANON & ~ECHO;
   tcsetattr(STDIN_FILENO, TCSANOW, (const struct termios*) &tmp);
   ch = getchar();
   tcsetattr(STDIN_FILENO, TCSANOW, (const struct termios*) &old);

  return ch;
@@}

       ReadKey := ' ';      {unused code}
    end;


  Procedure  ClrEol;     { ANSI replacement for CRT.ClrEol }
    Begin
      Write(chr(27), '[K');
    end;

  Procedure ClrScr;     { ANSI replacement for CRT.ClrScr }
    Begin
      Write(chr(27), '[2J');
    end;

  Function WhereX : byte;       { ANSI replacement for CRT.WhereX }
    var                         { Cursor position report. }
      ch  : char;               { This is column or X axis report.}
      xPos,yPos   : byte;

    begin
       Write(chr(27), '[6n');    { Ansi string to get X-Y position }
       ch := readkey;                 { Return will be }
                                 { Esc - [ - Ypos - ; - Xpos - R }
       xPos := 0;
       if ch = chr(27) then begin
          ch := readkey;
          if ch = '[' then begin
             read(yPos);
             ch := readkey;
             if ch = ';' then begin
                read(xPos);
                ch := readkey;
                {if ch = 'R' then
                   writeln('ansi terminal, cursor is at (',
                        xPos:1, ',', yPos:1, ')');}
             end;
          end;
       end;

       WhereX := xPos;            { Return the number }
    end;

  Function WhereY : byte;       { ANSI replacement for CRT.WhereY }
    var                         { Cursor position report. }
      ch  : char;               { This is row or Y axis report.}
      xPos,yPos   : byte;

    begin

       Write(chr(27), '[6n');    { Ansi string to get X-Y position }
       ch := readkey;                 { Return will be }
                                 { Esc - [ - Ypos - ; - Xpos - R }
       yPos := 0;
       if ch = chr(27) then begin
          ch := readkey;
          if ch = '[' then begin
             read(yPos);
             ch := readkey;
             if ch = ';' then begin
                read(xPos);
                ch := readkey;
                {if ch = 'R' then
                   writeln('ansi terminal, cursor is at (',
                        xPos:1, ',', yPos:1, ')');}
             end;
          end;
       end;

        WhereY := yPos;            { Return the number }
    end;


    Procedure GotoXY(x : byte ; y : byte); { ANSI replacement for CRT.GoToXY}
      Begin
        If (x >= 1) and (y >= 1) {and
           (x <= 80) and (y <= 25)} then
        Write(chr(27), '[',y,';',x,'H');
      end;

   Procedure TextBackGround(Back : Byte);{Replacement for CRT.TextBackground}
     Begin
       If Back <= 7 then begin     { No illegal values allowed }
          BackColour := Back;
          Case Back of
            0  :  Write(chr(27), '[40m');
            1  :  Write(chr(27), '[44m');
            2  :  Write(chr(27), '[42m');
            3  :  Write(chr(27), '[46m');
            4  :  Write(chr(27), '[41m');
            5  :  Write(chr(27), '[45m');
            6  :  Write(chr(27), '[43m');
            7  :  Write(chr(27), '[47m');
          end;  { Case }
       end;
     end;


   Procedure TextColor(Fore : Byte);
   label 9;
     Begin
       If not ((Fore in [0..15]) or (Fore in [128..143])) then goto 9;
       ForeColour := Fore;
       Blinking := False;
       Write(chr(27), '[0m');
       TextBackGround(BackColour);
       If Fore >  127 then
         begin
           If Fore >= 128 then Fore := Fore - 128;
           Blinking := True;
           Write(chr(27), '[5m');
         end;
        if fore in [0..15] then
           Case Fore of
             0  :  Write(chr(27), '[30m');
             1  :  Write(chr(27), '[34m');
             2  :  Write(chr(27), '[32m');
             3  :  Write(chr(27), '[36m');
             4  :  Write(chr(27), '[31m');
             5  :  Write(chr(27), '[35m');
             6  :  Write(chr(27), '[33m');
             7  :  Write(chr(27), '[37m');
             8  :  Write(chr(27), '[1;30m');
             9  :  Write(chr(27), '[1;34m');
             10  :  Write(chr(27), '[1;32m');
             11  :  Write(chr(27), '[1;36m');
             12  :  Write(chr(27), '[1;31m');
             13  :  Write(chr(27), '[1;35m');
             14  :  Write(chr(27), '[1;33m');
             15  :  Write(chr(27), '[1;37m');
           end  { Case }
     else begin
        writeln('unhandled value of fore(', fore:1, ')' );
     end;
9:
     end;

   Procedure NormVideo;   { ANSI Replacement for CRT.NormVideo }
     Begin
       Write(chr(27), '[0m');
       ForeColour := LightGray;
       BackColour := Black;
     end;

   Procedure LowVideo;    { Replacement for CRT.LowVideo }
     Begin
       If ForeColour > 7 then ForeColour := ForeColour - 8;
       Write(chr(27), '[0m');
       TextBackGround(BackColour);
       If not Blinking then TextColor(ForeColour)
          else TextColor(ForeColour + 128);
     end;

   Procedure HighVideo;   { Replacement for CRT.HighVideo }
     Begin
       If ForeColour < 8 then ForeColour := ForeColour + 8;
       If Not Blinking then TextColor(ForeColour)
           else TextColor(ForeColour + 128);
     end;



procedure setup;
var
   Ch      : char;        {Local variable to eat characters}
   isAnsi  : boolean;
begin

   { Setup }
   CheckBreak := True;
   BackColour := Black;
   ForeColour := LightGray;
   Blinking   := False;
   Write(chr(27), '[5n');   { get status report }
   {expect '^[[0n' }

   isAnsi := false;
   ch := readkey;
   if ch = chr(27) then begin
      ch := readkey;
      if ch = '[' then begin
         ch := readkey;
         if ch = '0' then begin
            ch := readkey;
            if ch = 'n' then begin
               isAnsi := true;
               writeln('ansi terminal found');
            end;
         end;
      end;
   end;

   if not isAnsi then begin
      WriteLn( chr(13), chr(7),   { then no ANSI, so abort }
               'This is not an ANSI console,  Aborting.');
      goto 99;
   end

end; { setup }


begin {console}

   setUp;
   TextBackground(Black);
   TextColor(LightGray);
   ClrScr;
   x := 1;
   y := whereY - 5;
   if y < 5 then y := 1;
   GotoXY(x,y);
   Write('CONSOLE TEST @');
   x := WhereX;
   y := WhereY;
   GotoXY(x,y);
   clreol;
   GotoXY(12,22);
   TextColor(White + Blink);
   Write('The @ sign above is on line ', y, ' at column ', x - 1);
   GotoXY(1,y + 1);
   TextColor(Yellow);
   TextBackground(Green);
   Write('(Bright yellow on green.)  Enter your name (in Bright cyan on blue): ');
   TextColor(LightCyan);
   TextBackground(Blue);
   ClrEol;
   for i := 1 to strlen do begin
      if not eoln then
         Read(NameStr[i])
      else NameStr[i] := ' ';
   end;
   ReadLn;
   writeln('hello, ', NameStr);

   LowVideo;
   Writeln('Test LowVideo, Keypressed and ReadKey - Press an arrow key');
   Repeat until Keypressed;
   ch := ReadKey;

   { mostly portable, but other systems might not return the same key codes }

   if ch <> chr(27) then
      writeln('You pressed ''', ch, '''')
   else begin
      TextColor(White + Blink);
      Write(' Special key ');
      ch := ReadKey;
      TextColor(cyan);
      if ch = '[' then begin
         ch := ReadKey;
         if ch = 'A' then
            writeln('You pressed UP arrow')
         else if ch = 'B' then
            writeln('You pressed DOWN arrow')
         else if ch = 'C' then
            writeln('You pressed RIGHT arrow')
         else if ch = 'D' then
            writeln('You pressed LEFT arrow')
         else begin
            write(' not an arrow key, code is --> ^[[');
            while not eoln do begin
               write(ch);
               read(ch);
            end;
         end;
      end
         else begin
            write(' not an arrow key, code is --> ^[' );
            while not eoln do begin
               write(ch);
               read(ch);
            end;
         end;
   end;

   WriteLn;
   HighVideo;
   WriteLn('Test HighVideo and ReadKey - Press another key');
   ch := ReadKey;
   If ch = chr(32) then Write('Space');
   If ch = chr(9) then Write('Tab');
   If ch = chr(8) then Write('Backspace');
   Write('--> you pressed ''', ch, '''');
   GotoXY(1,22);
   LowVideo;
   ClrEol;
   Write('Test of ClrEol - Press a key');
   ch := ReadKey;
   TextColor(White);
   TextBackground(Red);
   GotoXY(1,22);
   ClrEol;
   Write('All gone in white on red');
   Write('    Press any key');
   ch := ReadKey;
   GotoXY(1,22);
   NormVideo;
   ClrEol;
   Write('Press any key for color demo');
   ch := ReadKey;
   WriteLn(ch);
   ClrScr;
   for i := 0 to 7 do begin
      GotoXY(1,i + 1);
      TextColor(i);
      TextBackground(Black);
      ClrEol;
      Write('TextColor ',i);
      TextColor(i + 8);
      Write(' TextColor ',i + 8:2);
      TextColor(i + Blink);
      Write(' TextColor ',i + Blink);
      TextColor(i + 8 + Blink);
      Write(' TextColor ',i + 8 + Blink);
      TextBackground(i);
      ClrEol;
      TextColor(White);
      Write('  TextBackground ',i);
   end;
   TextBackground(Black);
   LowVideo;
   WriteLn;
   WriteLn;
99:
   normVideo;
   Write('Finished');
end.


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end of console.pas %%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
