tview.pas

{ zwei.stein@worldonline.cz, zweistein.kgb.cz }
program Textsmart;

{
 (c) Petr "Zweistein" Prokop

 Program textsmart :
  Textově viewer s p r tagy na form tov nˇ ...
}

Uses Crt,dos;
var
  F: text;
  Zn,Ina: Char;
  a,b,c,d: word;
  Tcolor,Bcolor:byte;
  blnk:boolean;

Procedure Play;
Begin;
  Sound(100);
  Delay(100);
  Nosound;
End;

procedure Nvideo;
begin;
 textcolor(7);
 textBackground(0);
 Tcolor:=7;
 Bcolor:=0;
 Blnk:=false;
End;

procedure color;
Begin;
 Read(f,zn);zn:=Upcase(zn);
 Case Zn of
  'B' : Begin;
   Read(f,zn);
   zn:=Upcase(zn);
   Case Zn of
    'Q' : Tcolor:=0;
    'W' : Tcolor:=1;
    'E' : Tcolor:=2;
    'R' : Tcolor:=3;
    'T' : Tcolor:=4;
'Z','Y' : Tcolor:=5;
    'U' : Tcolor:=6;
    'I' : Tcolor:=7;
    'O' : Tcolor:=8;
    'P' : Tcolor:=9;
    'A' : Tcolor:=10;
    'S' : Tcolor:=11;
    'D' : Tcolor:=12;
    'F' : Tcolor:=13;
    'G' : Tcolor:=14;
    'H' : Tcolor:=15;
   End; End;
  'F' : Begin;
   Read(f,zn);
   zn:=Upcase(zn);
   Case Zn of
    'Q' : Bcolor:=0;
    'W' : Bcolor:=1;
    'E' : Bcolor:=2;
    'R' : Bcolor:=3;
    'T' : Bcolor:=4;
'Z','Y' : Bcolor:=5;
    'U' : Bcolor:=6;
    'I' : Bcolor:=7;
    'O' : Bcolor:=8;
    'P' : Bcolor:=9;
    'A' : Bcolor:=10;
    'S' : Bcolor:=11;
    'D' : Bcolor:=12;
    'F' : Bcolor:=13;
    'G' : Bcolor:=14;
    'H' : Bcolor:=15;
   End; End;
  'N' : Nvideo;
  Else blnk:=not(blnk);
 end;
 case blnk of
  true : Textcolor(Tcolor+Blink);
 False : Textcolor(tcolor);
 End;
 TextBackground(Bcolor);
end;

begin ;Nvideo; clrscr;
  Writeln ('Program TextSmart for DOS - Freeware v1.00 (c1998) By Petr Prokop');
  If Paramcount =0 Then
   Begin;
    Writeln ('You haven''t entered any name of doc to display');
    Textcolor(14);TextBackground(RED);Writeln ('ERROR : 001');
    Nvideo;Halt;
   End;
  Assign(f, ParamStr(1));
  Reset(f);
  while not Eof(f) do
  begin
    Read(f,Zn);
    If not(Zn = '>') Then write (zn)
                     Else
     Begin;
      Read(f,zn);
      zn:=Upcase(zn);
      Case Zn of
       'C' : color;
       'A' : Repeat Ina:=ReadKey;Until Not (Ina='');
       'W' : Delay(1000);
       'Q' : Halt;
       'B' : Play;
       'T' : Begin;gettime(a,b,c,d);write(a,':',b,':',c);End;
       'D' : Begin;getdate(a,b,c,d);write(a,'/',b,'/',c);End;
       'P' : Writeln (chr(20));
       'S' : Clrscr;
       '>' : Write ('>');
       Else Begin;nvideo;Writeln;Writeln ('There is a bad tag in text');
        Textcolor(14);TextBackground(RED);Writeln ('ERROR : 002');Nvideo;Halt;
            End;
      End;
     End;
  end;
  Nvideo;
  Writeln;
end.