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 / GENERIC.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  2KB  |  84 lines
  1. PROGRAM GENERIC;
  2.  
  3.  
  4. LABEL 100;
  5.  
  6. CONST ITERATIONS = 25;
  7.  
  8. TYPE INPUT_FILE  = TEXT;
  9.      STRING80    = STRING[80];
  10.  
  11. VAR COUNTER      : INTEGER;
  12.     OK           : BOOLEAN;
  13.     LIMIT        : INTEGER;
  14.     FOO_FACTOR   : INTEGER;
  15.     BUFFER       : STRING80;
  16.     DO_FILE      : INPUT_FILE;
  17.  
  18.  
  19. PROCEDURE OPEN_A_FILE(VAR OK : BOOLEAN);
  20.  
  21. VAR I : INTEGER;
  22.  
  23. BEGIN
  24.   ASSIGN(DO_FILE,'MYTEXT.TXT');
  25.   {$I-} RESET(DO_FILE); {$I+}
  26.   I := IORESULT;
  27.   IF I = 0 THEN OK := TRUE ELSE OK := FALSE;
  28. END;
  29.  
  30.  
  31. FUNCTION CRUNCH_LINE(BUFFER : STRING80) : INTEGER;
  32.  
  33. VAR I      : INTEGER;
  34.     BUCKET : INTEGER;
  35.  
  36. BEGIN
  37.   CRUNCH_LINE := 0;
  38.   IF LENGTH(BUFFER) > 0 THEN
  39.     BEGIN
  40.       BUCKET := 0;
  41.       FOR I := 1 TO LENGTH(BUFFER) DO BUCKET := BUCKET +
  42.         ORD(BUFFER[I]);
  43.       BUCKET := BUCKET DIV LENGTH(BUFFER);
  44.       CRUNCH_LINE := BUCKET
  45.     END
  46. END;
  47.  
  48.  
  49. FUNCTION CRUNCH_FILE(VAR DO_FILE : INPUT_FILE) : INTEGER;
  50.  
  51. VAR PASSES : INTEGER;
  52.     TEMP   : INTEGER;
  53.  
  54. BEGIN
  55.   TEMP := 0;
  56.   FOR PASSES := 1 TO ITERATIONS DO
  57.     BEGIN
  58.       RESET(DO_FILE);
  59.       WHILE NOT EOF(DO_FILE) DO
  60.         BEGIN
  61.           READLN(DO_FILE,BUFFER);
  62.           TEMP := TEMP+CRUNCH_LINE(BUFFER);
  63.         END
  64.     END;
  65.   CRUNCH_FILE := TEMP DIV ITERATIONS
  66. END;
  67.  
  68.  
  69.  
  70. BEGIN     { Main Program }
  71.   OPEN_A_FILE(OK);
  72.   IF NOT OK THEN 
  73.     BEGIN
  74.       WRITELN('>>The file cannot be opened.');
  75.       GOTO 100
  76.     END;
  77.   FOO_FACTOR := CRUNCH_FILE(DO_FILE);
  78.   WRITELN('>>Foo Factor for Input File is ',FOO_FACTOR);
  79.   CLOSE(DO_FILE);
  80.   WRITELN('>>Processing completed.');
  81.   100:
  82. END.
  83. IF A_STRING[1] IN WHITESPACE THEN DELETE(A_STRING,1,1);
  84.   UNT