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 / MBUG / MBUG043.ARC / CMP-DOC.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  8KB  |  186 lines
  1. PROGRAM cmp_to_doc (input, dictionary, document, output);
  2.   { Convert Word+ dictionary to text file format. }
  3.  
  4.   { The format of a Word+ dictionary is as follows :-
  5.  
  6.       Word+_dictionary ::= non_data_part data_part final_part
  7.  
  8.       For reference only the non_data_part consists of 128 bytes apparently as follows :-
  9.         non_data_part ::= 3_unspecified_byte index 47_unspecified_byte
  10.           (128 bytes)
  11.         index ::= 26_index_reference
  12.         index_reference ::= logical_block_number logical_sector_offset byte_offset
  13.           (3 bytes)         (0 ..)               (0 .. 128)            (0 .. 128)
  14.  
  15.       data_part ::= [ compressed_word ]
  16.         (The words in the data part are contained in alphabetical order.)
  17.         compressed_word ::= zero_bit explicit_count [ character ] last_letter |
  18.           (n bytes)         zero_bit compressed_count letter [ character ] last_letter |
  19.                             one_bit compressed_count letter
  20.         explicit_count ::= 2_zero_bit 5_bit
  21.           (7 bits)
  22.           These values indicate how many of the initial letters of the previous
  23.             word to use for the new word, a value of 26 is not allowed.
  24.         compressed_count ::= zero_bit one_bit | one_bit zero_bit |  one_bit one_bit
  25.           (2 bits)
  26.           These values indicate,
  27.             'use the same first 3 letters as for the previous word',
  28.             'use the same first 4 letters as for the previous word', and
  29.             'use the same first 5 letters as for the previous word' respectively.
  30.         last_letter ::= one_bit 2_zero_bit letter
  31.         character ::= zero_bit 2_zero_bit letter
  32.         letter ::= 5_bit
  33.                    (0 .. 25)
  34.           These values represent the letters in the word 'A' .. 'Z'.
  35.  
  36.       final_part ::= 1Ah [ 00h ] [ 1Ah ]
  37.         The final part consists of an eof byte, the record is then padded
  38.           out with nulls, any subsiquent records consist of ^Z's. (^Z = eof = 1Ah = 26d)
  39.  
  40.       Re-phrasing all this in English, the data_part consists of a sequence of
  41.         words arranged in alphabetical order.  Each word occupies one or more
  42.         bytes.  The last byte of a word is denoted by having bit 7 set.  To
  43.         conserve space only those letters of a word which differ from those of
  44.         the previous word are specified.  Thus a count of how many of the
  45.         initial letters the word has in common with the previous word is
  46.         stored, this is the first entry for a word.  Normally this occupies the
  47.         last five bits of the first byte, however for values of 3, 4 or 5 it
  48.         only occupies the 5th and 6th bits of the first byte. Thus
  49.  
  50.                     letters in common | first byte
  51.                    -------------------+------------
  52.                             0         |  *000 0000
  53.                             1         |  *000 0001
  54.                             2         |  *000 0010
  55.                             3         |  *01- ----
  56.                             4         |  *10- ----
  57.                             5         |  *11- ----
  58.                             6         |  *000 0110
  59.                             7         |  *000 1000
  60.                             .         .      .
  61.                             .         .      .
  62.                            31         |  *001 1111
  63.  
  64.                    * - normaly 0, only 1 if this is the last byte of the word
  65.                          (due to lexical ordering this can only be if 3, 4 or
  66.                          5 letters are in common (see below)).
  67.  
  68.                    Note : 26 letters in common is not allowed as this value
  69.                      indicates the end of the file.
  70.  
  71.         The letters of a word are represented by a five bit code, A = 00000,
  72.         .., Z = 11001 (ie. 0 .. 25).  In the case of 3, 4 or 5 bytes in common
  73.         the first letter can be placed in the first byte, otherwise they will
  74.         occupy bits 0 - 4 of successive bytes, bits 5 and 6 being zero. }
  75.  
  76.   CONST
  77.     cr = ^M;
  78.     eof = ^Z;
  79.     buff_rec = 8;
  80.       { Size of dictionary buffer in records. }
  81.     buff_bytes = { buff_rec * $80 = } $400;
  82.     buff_bytes_minus_1 =  { buff_bytes - 1 = } $3FF;
  83.  
  84.   TYPE
  85.     str = string [80];
  86.  
  87.   VAR
  88.     dictionary : file;
  89.     document : text;
  90.     buffer : array [0 .. buff_bytes_minus_1] of byte;
  91.     buff_pt : 0 .. buff_bytes;
  92.     next_byte : byte;
  93.     word, first, last : str;
  94.       { word holds word of dictionary being extracted. }
  95.     count, processed, dummy : integer;
  96.       { Number of letters to keep from previous word, amount of data processed in kilobytes. }
  97.     words, copied : real;
  98.     compressed, new_word, end_of_file : boolean;
  99.  
  100.   FUNCTION bits (i, l, h : integer) : integer;
  101.     { Return bits l to h of i, right adjusted. }
  102.  
  103.     BEGIN
  104.       bits := ord ((i shr l) and not ((not 0) shl (h - l + 1)))
  105.     END;
  106.  
  107.   PROCEDURE upper_case (VAR s : str);
  108.  
  109.     VAR
  110.       i : integer;
  111.  
  112.     BEGIN
  113.       FOR i := 1 TO length (s) DO
  114.         s [i] := upcase (s [i])
  115.     END;
  116.  
  117.   BEGIN
  118.     writeln ('Convert Word+ dictionary to a document format file.');
  119.     write ('Enter first word within which to copy, eg. AAA : ');
  120.     readln (first);
  121.     write ('Enter last word within which to copy, eg. ZZZ : ');
  122.     readln (last);
  123.     upper_case (first);
  124.     upper_case (last);
  125.     writeln ('Extracting all words between ', first, ' and ', last, '.');
  126.     assign (dictionary, 'MAINDICT.CMP');
  127.     assign (document, 'MAINDICT.DOC');
  128.     reset (dictionary);
  129.     rewrite (document);
  130.     blockread (dictionary, buffer, 1);
  131.       { Ignore non-data part (1 record = 128 bytes). }
  132.     end_of_file := false;
  133.     processed := 0;
  134.     words := 0;
  135.     copied := 0;
  136.     word := '';
  137.     new_word := true;
  138.     WHILE not end_of_file DO
  139.       BEGIN
  140.         {$I-}
  141.         { Don't worry about over-read on last filling of buffer. }
  142.         blockread (dictionary, buffer, buff_rec);
  143.         dummy := ioresult;
  144.         {$I+}
  145.         buff_pt := 0;
  146.         WHILE (buff_pt < buff_bytes) and not end_of_file DO
  147.           BEGIN
  148.             next_byte := buffer [buff_pt];
  149.             buff_pt := buff_pt + 1;
  150.             IF new_word THEN
  151.               BEGIN
  152.                 end_of_file := next_byte = ord (eof);
  153.                 IF not end_of_file THEN
  154.                   BEGIN
  155.                     compressed := bits (next_byte, 5, 6) <> 0;
  156.                     IF compressed THEN
  157.                       count := bits (next_byte, 5, 6) + 2
  158.                     ELSE
  159.                       count := bits (next_byte, 0, 4);
  160.                     delete (word, count + 1, length (word) - count);
  161.                     IF compressed THEN
  162.                       word := word + chr (ord ('A') + bits (next_byte, 0, 4))
  163.                   END
  164.               END
  165.             ELSE
  166.               word := word + chr (ord ('A') + bits (next_byte, 0, 4));
  167.             new_word := bits (next_byte, 7, 7) = 1;
  168.             IF new_word THEN
  169.               BEGIN
  170.                 IF (first < word) and (word < last) THEN
  171.                   BEGIN
  172.                     writeln (document, word);
  173.                     copied := copied + 1
  174.                   END;
  175.                 words := words + 1
  176.               END
  177.         END;
  178.         IF not end_of_file THEN
  179.           processed := processed + 1;
  180.         write (processed : 3, 'k, ', words : 5 : 0, ' words processed, ', copied : 5 : 0, ' words copied.', cr)
  181.       END;
  182.     close (dictionary);
  183.     close (document);
  184.     writeln
  185.   END.
  186.