home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / WS2ASCII.ZIP / WS2ASCII.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  11.9 KB  |  430 lines
  1. Program WS_2_Ascii;
  2.  
  3. {$C-,K-}
  4.  
  5. {                    Copyright (c)  John Friel III
  6.  
  7.  
  8.        Converts files created by WordStar in (D)ocument mode to
  9.        Non document files by stripping the high bit of every byte
  10.        in the file.  This program may be modified in any way to
  11.        suit your personal tastes.  You are also encouraged to pass
  12.        this program on to anyone provided the source code is unmodified.
  13.        Please keep an unmodified copy around just for this purpose.
  14.        For more information on this program or mode detailed info
  15.        on interfacing TURBO Pascal with the I.B.M. PC (r) or
  16.        Compatibles (this was developed on a Tava PC!) write to:
  17.  
  18.                    John Friel III
  19.                    715 Walnut Street
  20.                    Cedar Falls, Iowa  50613
  21.  
  22.  
  23. }
  24.  
  25. Const
  26.   Color                         = true;
  27. Type
  28.   Names                         = String[80];
  29.   Screen_Array                  = Array [1..4000] of byte;
  30. Var
  31.   InFile, OutFile               : Text;
  32.   x, i, y, q, in_X, in_Y,
  33.   out_X, out_Y                  : Integer;
  34.   total_chars, total_words      : real;
  35.   Ok, bool, done, Screen_IO,
  36.   Stats                         : Boolean;
  37.   InFileName, OutFileName       : Names;
  38.   Real_Screen                   : Screen_Array absolute $B800:$0000;
  39.   Temp_Screen, Help_Screen,
  40.   Help_Screen2                  : Screen_Array;
  41.   Ch, ch_in, ch_out, last_char  : Char;
  42.  
  43. Procedure check_for_abort; forward;
  44.  
  45. Procedure Statistics;
  46. begin
  47.   total_chars := total_chars + 1;
  48.   if (ch_out in [' ', chr(10), chr(13)]) and
  49.       not (last_char in [' ', chr(10), chr(13)]) then
  50.         total_words := total_words + 1;
  51.   last_char := ch_out;
  52. end;
  53.  
  54. Procedure Big_exit;
  55. begin
  56.   textbackground(black);
  57.   if color then textcolor(yellow);
  58.   window (1,1,80,25);
  59.   for x := 10 downto 1 do
  60.     for y := 2 downto 1 do
  61.       begin
  62.         window (x+y-1,x+4,82-x-y,25-x);
  63.         clrscr;
  64.         delay (5);
  65.       end;
  66.   gotoxy (25,12);
  67.   writeln ('WS2ASCII completed.');
  68.   halt;
  69. end;
  70.  
  71. Procedure OpenInFile;
  72. Begin
  73.   Repeat
  74.     Write ('Enter name of Input file  :');
  75.     buflen := 14;
  76.     readln(InFileName);
  77.     if length(InFileName) = 0 then
  78.       begin
  79.         check_for_abort;
  80.         if color then textcolor(yellow);
  81.         window (2,6,79,7);
  82.         gotoxy (1,2);
  83.       end;
  84.     assign(Infile, InFileName);
  85.     {$I-} reset (InFile) {$I+};
  86.     Ok := (IOresult = 0);
  87.     if not Ok then Writeln ('Cannot find file ',InFileName);
  88.   until Ok;
  89. end;
  90.  
  91. Procedure OpenOutFile;
  92. var
  93.   answer     : String[14];
  94. Begin
  95.   Repeat
  96.     Repeat
  97.       Write ('Enter name of Output file :');
  98.       buflen := 14;
  99.       readln(OutFileName);
  100.       if OutFileName = '' then
  101.         begin
  102.           check_for_abort;
  103.           if color then textcolor(yellow);
  104.           window (2,6,79,7);
  105.           gotoxy (1,2);
  106.         end;
  107.       if OutFileName = InFileName then
  108.         Writeln ('Input filename matches Output filename');
  109.     until (OutFileName <> InFileName) and (OutFileName <> '');
  110.     assign(Outfile, OutFileName);
  111.     {$I-} Reset (OutFile) {$I+};
  112.     Ok := (IOresult = 0);
  113.     if Ok then
  114.       Begin
  115.         Write ('File ',OutFileName,' exists, use it anyway ?');
  116.         readln (answer);
  117.         if answer[1] in ['Y','y']
  118.           then Begin
  119.                  Ok := True;
  120.                  reWrite (OutFile);
  121.                end
  122.         else
  123.           Ok := False;
  124.       end
  125.    else
  126.       Begin
  127.         Ok := True;
  128.         ReWrite (OutFile);
  129.       end;
  130.   until Ok;
  131. end;
  132.  
  133. Procedure Drawbox_IBM (x1,y1,x2,y2,FG,BG : Integer; Boxname : Names);
  134. Begin
  135.   Window(x1,y1,x2,y2+1);
  136.   if color then
  137.     begin
  138.       textcolor(FG);
  139.       textbackground(BG);
  140.     end;
  141.   GotoXY(1,1);
  142.   x := x2-x1;
  143.   if length(boxname) > x then boxname[0] := chr(x-4);
  144.   Write('U',boxname);
  145.   for q := x1+length(boxname)+1 to x2-1 do Write('M');
  146.   Write('8');
  147.   for q := 2 to y2-y1 do
  148.     Begin
  149.       GotoXY(1,q); Write('3');
  150.       GotoXY(x2-x1+1,q); Write('3');
  151.     end;
  152.   gotoXY(1,y2-y1+1);
  153.   Write('T');
  154.   for q := x1+1 to x2-1 do Write('M');
  155.   Write('>');
  156. end;
  157.  
  158. Procedure Drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : Names);
  159. Begin
  160.   Drawbox_IBM (x1,y1,x2,y2,FG,BG,Boxname);
  161.   Window (x1+1,y1+1,x2-1,y2-1);
  162.   Clrscr;
  163. end;
  164.  
  165. Procedure Display_In;
  166. Begin
  167.   Window (2,10,79,15);
  168.   if color then textcolor(lightcyan);
  169.   GotoXY (in_X, in_Y);
  170.   write (ch_in);
  171.   in_X := whereX;
  172.   in_Y := whereY;
  173. end;
  174.  
  175. Procedure Display_Out;
  176. Begin
  177.   Window (2,18,79,23);
  178.   if color then textcolor(lightcyan);
  179.   gotoxy (out_X, out_Y);
  180.   Write(ch_out);
  181.   out_X := whereX;
  182.   out_Y := whereY;
  183. end;
  184.  
  185. procedure Abort;
  186. Begin
  187.   if (length(InFileName) <> 0) and (length(OutFileName) <> 0) then
  188.     begin
  189.       close (OutFile);
  190.       erase (OutFile);
  191.     end;
  192.   move (temp_Screen, real_Screen, 4000);  { restore old Screen }
  193.   big_exit;
  194. end;
  195.  
  196. Procedure Toggle_Screen;
  197. Begin
  198.   Screen_IO := not Screen_IO;
  199. end;
  200.  
  201. Procedure Toggle_Stats;
  202. Begin
  203.   stats := not stats;
  204. end;
  205.  
  206. Procedure More_Help;
  207. Begin
  208.   move (real_Screen, help_Screen2, 4000);  { save current Screen }
  209.   drawbox (20,15,77,24,White,magenta,'[ Additional Information Window ]');
  210.   Writeln (' TURBO Pascal v2.0 was used in creating this program.');
  211.   Writeln (' Anyone that uses WordStar will understand why this');
  212.   Writeln (' program was written.  It strips the HIGH bit of');
  213.   Writeln (' everything in the input file creating a new file');
  214.   Writeln (' that can be TYPED or sent over the Comm lines to');
  215.   Writeln (' computers that only use a word-length of 7.  That');
  216.   Writeln (' and to show off TURBO''s windowing capabilities!');
  217.   if color then textcolor(lightcyan);
  218.   Write   (' Press any key to Return, `M'' for More');
  219.   read (Kbd,ch);
  220.   if ch in ['M','m'] then
  221.     begin
  222.       writeln;
  223.       if color then textcolor(white);
  224.       writeln (' In fact... All of the boxes on the screen now');
  225.       writeln (' are actually independent Windows!  Just as you');
  226.       writeln (' saw this text scroll through this window, so');
  227.       writeln (' will text scroll through all the other ones too.');
  228.       writeln (' If you ever had reservations on buying TURBO');
  229.       writeln (' Pascal because of price, fear not! It''s the BEST!');
  230.       if color then textcolor(lightcyan);
  231.       write   ('     Press any key to return...');
  232.       read (kbd,ch);
  233.     end;
  234.   move ( help_Screen2,real_Screen, 4000);
  235. end;
  236.  
  237. Procedure Help_Window;
  238. Begin
  239.   move (real_Screen, help_Screen, 4000);  { save current Screen }
  240.   drawbox (13,8,70,16,white,red,'[ Help Window ]');
  241.   Writeln (' ');
  242.   Writeln (' 1) Help.     What you are reading now!');
  243.   Writeln (' 2) Continue. Exit the Intervention Window');
  244.   Writeln (' 3) Screen    Toggles ON/OFF. Off speeds up');
  245.   Writeln ('              the conversion greatly.');
  246.   Writeln (' 4) Abort     Cancels the current conversion and Ends');
  247.   Repeat
  248.     if color then textcolor(lightcyan);
  249.     if color then textbackground(red);
  250.     window (14,9,69,17);
  251.     gotoxy (1,7);
  252.     Write   ('    Press `M'' for More or `R'' to Return');
  253.     GotoXY(12,7);
  254.     read (Kbd, ch);
  255.     if ch in ['m','M'] then
  256.       Begin
  257.         more_help;
  258.       end;
  259.   until ch in ['r','R'];
  260.   move ( help_Screen,real_Screen, 4000);
  261. end;
  262.  
  263. Procedure first_time_through;
  264. Begin
  265.   move (real_Screen, temp_Screen, 4000);  { save current Screen }
  266.   Drawbox (10,10,62,19,lightmagenta,Black,'[ Initialization ]');
  267.   Repeat
  268.     Window (11,11,61,18); GotoXY(1,2);
  269.     if color then
  270.       begin
  271.         textcolor(lightmagenta);
  272.         textbackground(black);
  273.       end;
  274.     Writeln ('                Set Parameters ');
  275.     if color then textcolor(yellow);
  276.     writeln ('    C  -  Continue with the program');
  277.     writeln ('            ( leave parameters as is )');
  278.     Writeln ('    H  -  Help Window');
  279.     Write   ('    S  -  Screen output toggle. Now ');
  280.     if color then textcolor(lightgreen);
  281.     if Screen_IO then Writeln ('ON ')
  282.       else Writeln ('OFF');
  283.     if color then textcolor(yellow);
  284.     Write   ('    T  -  Statistics toggle. Now ');
  285.     if color then textcolor(lightgreen);
  286.     if stats then Writeln ('ON ')
  287.       else Writeln ('OFF');
  288.     Write   ('    ');
  289.     Repeat
  290.       read (Kbd, ch);
  291.     until ch in ['h','H','s','S','c','C','t','T'];
  292.     case ch of
  293.       's','S' : Toggle_Screen;
  294.       't','T' : Toggle_stats;
  295.       'h','H' : Help_Window;
  296.     end;
  297.   until ch in ['c','C'];
  298.   move (temp_Screen, real_Screen, 4000);
  299.   if color then textbackground(black);
  300.   if color then textcolor(yellow);
  301. end;
  302.  
  303. Procedure check_for_abort;
  304. Begin
  305.   move (real_Screen, temp_Screen, 4000);  { save current Screen }
  306.   Drawbox (7,1,63,9,white,blue,'[ Intervention Window ]');
  307.   Repeat
  308.     Window (8,2,61,8); GotoXY(1,1);
  309.     if color then textcolor(white);
  310.     if color then textbackground(blue);
  311.     Writeln ('                Command Menu Window! ');
  312.     Writeln ('    H  -  Help Window');
  313.     Writeln ('    C  -  Continue on with conversion');
  314.     Write   ('    S  -  Screen output toggle. Now ');
  315.     if Screen_IO then Writeln ('ON ')
  316.       else Writeln ('OFF');
  317.     Write   ('    T  -  Statistics toggle. Now ');
  318.     if stats then Writeln ('ON ')
  319.       else Writeln ('OFF');
  320.     Writeln ('    A  -  Abort conversion');
  321.     Write   ('    ');
  322.     Repeat
  323.       read (Kbd, ch);
  324.     until ch in ['h','H','c','C','s','S','a','A','t','T'];
  325.     case ch of
  326.       'a','A' : Abort;
  327.       's','S' : Toggle_Screen;
  328.       'h','H' : Help_Window;
  329.       't','T' : Toggle_stats;
  330.     end;
  331.   until ch in ['c','C'];
  332.   move (temp_Screen, real_Screen, 4000);
  333.   if color then
  334.     begin
  335.       textbackground(black);
  336.       textcolor(lightcyan);
  337.     end;
  338. end;
  339.  
  340. Procedure Init;
  341. Begin
  342.   textcolor(white);
  343.   Screen_io := true;
  344.   stats := true;
  345.   in_X := 1;
  346.   in_Y := 1;
  347.   out_X := 1;
  348.   out_Y := 1;
  349.   done := False;
  350.   Window (1,1,80,25);
  351.   ClrScr;
  352.   DrawBox (1,1,80,4,lightgreen,black,'');
  353.   if color then textcolor(yellow);
  354.   Writeln ('              Convert WordStar Document files to Ascii files.');
  355.   Write   ('          (c)  John Friel III   July 11, 1984   Using TURBO Pascal.');
  356.   DrawBox (1,5,80,8,lightgreen,black,'');
  357.   DrawBox (1,9,80,16,lightgreen,black,'[ InFile = ]');
  358.   DrawBox (1,17,80,24,lightgreen,black,'[ OutFile = ]');
  359. end;
  360.  
  361. Procedure Do_conversion;
  362. Begin
  363.   total_words := 0.0;
  364.   total_chars := 0.0;
  365.   While not eof(InFile) do
  366.     Begin
  367.       if keypressed then check_for_abort;
  368.       read (InFile,ch_in);
  369.       if ord(ch_in) > 127 then
  370.         ch_out := chr(ord(ch_in)-128)
  371.       else
  372.         ch_out := ch_in;
  373.       if Screen_IO then
  374.         begin
  375.           Display_in;
  376.           Display_Out;
  377.         end;
  378.       Write (OutFile,ch_out);
  379.       if stats then statistics;
  380.     end;
  381.   close (OutFile);
  382. end;
  383.  
  384. Procedure Show_statistics;
  385. Begin
  386.   if stats then
  387.   begin
  388.     DrawBox (15,11,50,14,lightcyan,blue,'[ OutFile Statistics ]');
  389.     if color then textcolor(white);
  390.     gotoxy (1,1);
  391.     total_chars := total_chars - 1;
  392.     writeln (' Total Words      = ',total_words:6:0);
  393.     write   (' Total Characters = ',total_chars:6:0);
  394.   end;
  395. end;
  396.  
  397. Procedure Open_the_files;
  398. Begin
  399.   window (2,6,79,7);
  400.   if color then textcolor(yellow);
  401.   gotoXY (1,1);
  402.   writeln ('Enter a NULL entry to show the Intervention Window.');
  403.   gotoXY (1,2);
  404.   OpenInFile;
  405.   OpenOutFile;
  406.   ClrScr;
  407.   writeln ('           Press any key for more information...');
  408.   DrawBox (1,9,80,16,lightgreen,black,'[ InFile = '+InFileName+' ]');
  409.   DrawBox (1,17,80,24,lightgreen,black,'[ OutFile = '+OutFileName+' ]');
  410. end;
  411.  
  412. Begin    { WS2ASCII }
  413.   Init;
  414.   first_time_through;
  415.   repeat
  416.     Open_the_files;
  417.     Do_conversion;
  418.     Show_statistics;
  419.     Window (2,6,79,7);   { point to middle Window }
  420.     if color then
  421.       begin
  422.         textcolor(yellow);
  423.         textbackground(black);
  424.       end;
  425.     ClrScr;
  426.     Writeln ('All Done!');
  427.     GotoXY(1,9);
  428.   until done;
  429. end.
  430.