RBBS in a Box Volume 1 #3.1/RBBSIABOX31.cdr/apit/ansi.pas

Pascal/Delphi Source File | 1990-09-29 | 7.0 KB | 267 lines

Const
  FF = #12;
  ESC = #27;
Var Ch : Char;
 C : CHar;
 i ,FGcolor,BGcolor, CursorX, CursorY : Integer;
        escape_mode: boolean;
        escape_number: byte;
        escape_register: array [1..50] of byte;
        escape_str: string[80];
AnsiFile : Text;
(****************************************************************************)
(*                             PROCESS ESCAPE                               *)
(****************************************************************************)
Procedure
      wrt( c : char );
   begin

      Case c of
           FF :  clrscr;
          else   Write(c);
      end;
   end;

 Procedure
      set_graphics;
   var
      i     : integer;
      FG,BG : integer;
   begin
      FG := FGcolor;
      BG := BGcolor;
      for i:=1 to escape_number do begin
         case escape_register[i] of
            0 : lowvideo;
            1 : normvideo;
            5 : FG := FG + blink;
            7 : begin
                   FG := BG;
                   BG := FG;
                end;
           30 : FG := black;
           31 : FG := red;
           32 : FG := green;
           33 : FG := yellow;
           34 : FG := blue;
           35 : FG := magenta;
           36 : FG := cyan;
           37 : FG := white;
           40 : BG := black;
           41 : BG := red;
           42 : BG := green;
           43 : BG := yellow;
           44 : BG := blue;
           45 : BG := magenta;
           46 : BG := cyan;
           47 : BG := white;
         else
            ;
         end;
      end;
      textcolor( FG );
      textbackground( BG );
      escape_mode := false;
   end;

   Procedure MoveUp;
   Begin
     GotoXY(Wherex, WhereY + Escape_Register[1]);
   End;

   Procedure MoveDown;
   Begin
     GotoXY(Wherex,whereY - (Escape_Register[1]));
   End;

   Procedure MoveForeward;
   Begin
     GotoXY(WhereX + (Escape_Register[1]),WhereY);
   End;

   Procedure MoveBackward;
   Begin
     GotoXY(WhereX - (Escape_Register[1]),WhereY);
   End;


   Procedure SaveCursorPos;
   Begin
      CursorX := WhereX;
      CursorY := WhereY;
   end;

   Procedure RestoreCursorPos;
   Begin
      GoToXY(CursorX,CursorY);
   End;

   procedure
      addr_cursor;
   begin
      case escape_number of
         0 : begin
                escape_register[1]:=1;
                escape_register[2]:=1;
             end;
         1 : escape_register[2]:=1;
      else
         ;
      end;
      if escape_register[1]=25 then
         gotoxy(escape_register[2],24)
      else
         gotoxy(escape_register[2],escape_register[1]);
      escape_mode := false;
   end;

   procedure
      clear_scr;
   begin
      if ( escape_number = 1 )  and  ( escape_register[1] = 2 ) then
         clrscr;
      escape_mode := false;
   end;

   procedure
      clear_line;
   begin
      if ( escape_number = 1 )  and  ( escape_register[1] = 0 ) then
         clreol;
      escape_mode := false;
   end;

   procedure
      process_escape( c : char );
   var
      i    : integer;
      ch   : char;
   begin
      c := Upcase(c);
      case c of
          '['
             : exit;
         'F','H'
             : begin
                  addr_cursor;
                  Escape_mode := False;
                  exit;
               end;
         'J' : begin
                  clear_scr;
                  Escape_mode := False;
                  exit;
               end;
         'K' : begin
                  clear_line;
                  Escape_mode := False;
                  exit;
               end;
         'M' : begin
                  set_graphics;
                  Escape_mode := False;
                  exit;

               end;
         'S' : Begin
                 SaveCursorPos;
                  Escape_mode := False;
                 Exit;
               end;

         'U' : Begin
                 RestoreCursorPos;
                 Escape_Mode := False;
                 Exit;
               End;

         'A' : Begin
                 MoveUp;
                 Escape_mode := False;
                 Exit;
               end;



         'B' : Begin
                 MoveDown;
                 Escape_mode := False;
                 Exit;
               end;

         'C' : Begin
                MoveForeward;
                 Escape_mode := False;
                Exit;
               end;


         'D' : Begin
                MoveBackward;
                 Escape_mode := False;
                Exit;
               end;


      end;
      ch := upcase( c );
      escape_str := escape_str + ch;
      if ch in [ 'A'..'G','L'..'P' ] then exit;
      if ch in [ '0'..'9' ] then begin
         escape_register[escape_number] := (escape_register[escape_number] * 10) + ord( ch ) - ord( '0' );
         exit;
      end;
      case ch of
         ';', ',' : begin
                       escape_number := escape_number + 1;
                       escape_register[escape_number] := 0;
                    end;
         'T',  '#', '+', '-', '>', '<', '.'
                  : ;
      else
         escape_mode := false;
         for i:=1 to length( escape_str ) do
            wrt( escape_str[i] );
      end;
   end;

(****************************************************************************)
(*                             SCREEN HANDLER                               *)
(****************************************************************************)
   procedure
      scrwrite( c : char );
   var
      i  : integer;
   begin
      if c = ESC then begin
         if escape_mode then begin
            for i:=1 to length( escape_str ) do
               wrt( escape_str[i] );
         end;
         escape_str := '';
         escape_number := 1;
         escape_register[escape_number] := 0;
         escape_mode := true;
      end
      else
         if escape_mode then
            process_escape(c)
         else
            wrt( c );
   end;


Begin
Escape_Str := '';
FGColor := White;BGColor:=BLACK;
Escape_Mode := True;
ClrScr;
Assign(AnsiFile,'\bbs\gen\Welcomeg');
Reset(AnsiFile);
While not EOF(AnsiFile) do Begin
  Read(AnsiFile,ch);
  ScrWrite(Ch);
end;


End.δ`o█│?'^¥5╓ü%aå`.≡Ωbδ[á≤N∩(^BLPcYÿaå`.≡Ωbδ╣∩⌠>▒[W ╗Ö╦d5╧br╨╘µ»■!╢╛«⌡Y┴√Vb»■!╢⌡╢=√=ü}δw⌡rm÷F`Φë&å Vb»■!╢⌡╢=√s