home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / CASE.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  3KB  |  109 lines
  1. {-----------------------------}
  2. {             CASE            }
  3. {      by Jeff Duntemann      }
  4. {                             }
  5. { Two-way case filter program }
  6. {      Turbo Pascal V2.0      }
  7. {      Last Update 1/4/85     }
  8. {-----------------------------}
  9.  
  10.  
  11. PROGRAM CASER;           { "CASE" is a reserved word... }
  12.  
  13. CONST UPPER = TRUE;
  14.       LOWER = FALSE;
  15.  
  16. TYPE STRING40    = STRING[40];
  17.      STRING80    = STRING[80];
  18.      STRING255   = STRING[255];
  19.      PARM_ARRAY  = ARRAY[1..10] OF STRING40;
  20.  
  21.  
  22. VAR I,J,K       : INTEGER;
  23.                   { Comment out "CSEG :" for CP/M-80: }
  24.     RAM_TAIL    : STRING[128] ABSOLUTE CSEG : $80;
  25.     PARMS       : PARM_ARRAY;   { Holds command line paraeters }
  26.     CH          : CHAR;
  27.     WORKFILE    : TEXT;
  28.     TEMPFILE    : TEXT;
  29.     NEW_CASE    : BOOLEAN;
  30.     WORKLINE    : STRING80;
  31.     WORKNAME    : STRING80;
  32.     TEMPNAME    : STRING80;
  33.     CASE_TAG    : STRING80;
  34.  
  35.  
  36. {$I FRCECASE.SRC }
  37.  
  38. {$I STRIPWHT.SRC }
  39.  
  40. {$I PARSTAIL.SRC }
  41.  
  42.  
  43. {>>>>MAKETEMP<<<<}
  44.  
  45. PROCEDURE MAKETEMP(FILENAME : STRING80; VAR TEMPNAME : STRING80);
  46.  
  47. VAR POINT : INTEGER;
  48.  
  49. BEGIN
  50.   POINT := POS('.',FILENAME);
  51.   IF POINT > 0 THEN DELETE(FILENAME,POINT,(LENGTH(FILENAME)-POINT)+1);
  52.   TEMPNAME := CONCAT(FILENAME,'.$$$')
  53. END;
  54.  
  55.  
  56. { CASER MAIN }
  57.  
  58. BEGIN
  59.   PARSE_TAIL(I,PARMS);      { Parse the command tail }
  60.   IF I < 2 THEN             { Missing parms error }
  61.     BEGIN
  62.       WRITELN('<<Error!>> CASE requires two command line parameters:');
  63.       WRITELN('           CASE UP B:FOOFILE.TXT or');
  64.       WRITELN('           CASE DOWN B:FOOFILE.TXT');
  65.       WRITELN('           Invoke CASE again with the proper parameters.')
  66.     END
  67.   ELSE
  68.     BEGIN
  69.       WORKNAME := PARMS[2];
  70.       ASSIGN(WORKFILE,WORKNAME);  { Attempt to open the file }
  71.       {$I-} RESET(WORKFILE); {$I+}
  72.       IF IORESULT <>0 THEN
  73.         BEGIN
  74.           WRITELN('<<Error!>> File ',PARMS[2],' does not exist.');
  75.           WRITELN('           Invoke CASE again with an existing filename.');
  76.           END
  77.       ELSE
  78.         BEGIN                 { See if UP/DOWN parm was entered }
  79.           CASE_TAG := PARMS[1];
  80.           CASE_TAG := FORCE_CASE(UPPER,CASE_TAG);
  81.           IF CASE_TAG = 'UP' THEN NEW_CASE := UPPER ELSE
  82.           IF CASE_TAG = 'DOWN' THEN NEW_CASE := LOWER ELSE
  83.             BEGIN
  84.               WRITELN
  85.               ('<<Error!>> The case parameter must be "UP" or "DOWN."');
  86.               WRITELN
  87.               ('           Invoke CASE again using either "UP" or "DOWN".');
  88.               HALT
  89.             END;
  90.           WRITE('Forcing case ');
  91.           IF NEW_CASE THEN WRITE('up ') ELSE WRITE('down ');
  92.           MAKETEMP(WORKNAME,TEMPNAME);  { Generate temporary filename }
  93.           ASSIGN(TEMPFILE,TEMPNAME);    { Open temporary file }
  94.           REWRITE(TEMPFILE);
  95.           WHILE NOT EOF(WORKFILE) DO
  96.             BEGIN
  97.               READLN(WORKFILE,WORKLINE);
  98.               WRITE('.');               { Dot shows it's working }
  99.               WORKLINE := FORCE_CASE(NEW_CASE,WORKLINE);
  100.               WRITELN(TEMPFILE,WORKLINE)
  101.             END;
  102.           CLOSE(TEMPFILE);              { Close the temporary file }
  103.           CLOSE(WORKFILE);              { Close original source file... }
  104.           ERASE(WORKFILE);              { ...and delete it. }
  105.           RENAME(TEMPFILE,WORKNAME);    { Temporary file becomes source }
  106.        END
  107.     END
  108. END.
  109. HQQWBC