home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / snobol4 / vsnobol4.arc / BITZER.SNO next >
Text File  |  1987-12-04  |  7KB  |  251 lines

  1. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2. *
  3. *    PGM: BITZER.SNO
  4. *    Version 2.0
  5. *
  6. *    Created by:  Eric Johnson, Madison, SD.
  7. *    Date:        May - June, 1987
  8. *
  9. *    Version 2.1
  10. *    Modifed by Catspaw, Inc. for improved efficiency.
  11. *    SORT function added for Vanilla SNOBOL4
  12. *
  13. *    Description:  BITZER creates an alphabetical index for files,
  14. *        giving each page number a word is found on.
  15. *        It first reads the file identified as INWORDS; this provides
  16. *        a list of keywords NOT to be indexed.
  17. *        The file identified as INFILE is indexed.
  18. *        In this file, the start of each page must be
  19. *        indicated thus:
  20. *
  21. *        A special character (@ # or *) should be in column 1,
  22. *        then "PAGE", one space, and the page designation.
  23. *        This can readily be altered by rewriting the pattern PAGE.DES.
  24. *
  25. *        The output, the index, in found in the file
  26. *        identified as OUTFILE.
  27. *
  28. *        BITZER adjusts output lines in which the listing of
  29. *        of page numbers is > 57 columns, and it removes the last
  30. *        comma.
  31. *
  32. *        The operation of this program is described in detail in 
  33. *        "A Computer Program for Word Processing," published in 
  34. *        RESEARCH IN WORD PROCESSING NEWSLETTER, Fall, 1987. 
  35. *
  36. *
  37. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  38.  
  39. *    Part 1: Initialization
  40. *
  41.         &ANCHOR = 0
  42.         &TRIM = 1
  43.  
  44. *    Define Constants and patterns
  45. *
  46.         NUMBERS = "0123456789"
  47.         LTRS = &UCASE  NUMBERS  "'-><"
  48.         SP = DUPL(" ",20)
  49.  
  50. *    Define Patterns
  51.         PAGE.DES = POS(0) ANY("@*#") "PAGE" SPAN(" ")
  52. +               SPAN(NUMBERS) . PGNO
  53.  
  54.         WPAT = POS(0) BREAK(LTRS) SPAN(LTRS) . WORD
  55.         WCHK = POS(0) BREAK(&UCASE)
  56.  
  57.         INDEX = TABLE(100,100)
  58.  
  59. *    Part 2: Function Definitions
  60. *
  61. *    Function to scroll a given number of lines.
  62. *
  63.     DEFINE('SCROLL(MAX)N')                :(SCROLL_END)
  64. SCROLL        SCREEN = LT(N,MAX)            :F(RETURN)
  65.         N = N + 1                :(SCROLL)
  66. SCROLL_END
  67.  
  68.  
  69. *    PRINT(COL1,COL2,L,BC)
  70. *
  71. *    Function to print a string COL2 in a column no longer than L
  72. *    characters, breaking words between the character in BC.
  73. *    COL1 is the first column of data.
  74. *
  75.     DEFINE('PRINT(COL1,COL2,L,BC)C,LINE')
  76.         PRINT_PAT = RTAB(1) . LINE LEN(1) . C    :(PRINT_END)
  77.  
  78. *    Function entry point
  79. PRINT        OUTPUT = LE(SIZE(COL1) + SIZE(COL2),L) COL1 COL2 :S(RETURN)
  80. *    Remove first L characters to LINE.
  81.         COL2 LEN(L) . LINE =
  82.  
  83. *    Isolate last character on line to C.
  84. PRINT_2        LINE PRINT_PAT                :F(RETURN)
  85.  
  86. *    If C is not BC, prepend it to S and get another char from LINE.
  87.         COL2 = DIFFER(C,BC) C COL2        :S(PRINT_2)
  88.  
  89. *    If C is BC, this is a good break point.
  90.         OUTPUT = COL1 LINE BC
  91.  
  92. *    Replace COL1 with blanks so future lines will pad properly
  93.         COL1 = DUPL(' ',SIZE(COL1))        :(PRINT)
  94. PRINT_END
  95.  
  96.  
  97. *    This function sorts the members of a table using a Shell sort method.
  98. *    The general idea is to try to move out-of-order elements large
  99. *    distances quickly.  A straight-line insertion sort is performed on
  100. *    a series of sub-lists of the master list.  See Comm. of the ACM,
  101. *    July, 1959 for Shell's original article, or Knuth, The Art of
  102. *    Computer Programming, Vol. 3.
  103. *
  104. *    A table is converted to a two column array, with the first column
  105. *    containing the table keys, and the second column containing the
  106. *    entry values.
  107. *
  108. *    Sorting is not particularly efficient in SNOBOL4.  For that reason,
  109. *    SNOBOL4+ contains a built-in assembly-language SORT function, which
  110. *    should be used for production work.
  111. *
  112. *    The second argument to the function is either a 1 or 2, to specify
  113. *    sorting on the keys or the entry values, respectively.  It defaults
  114. *    to 1 if omitted.
  115. *
  116. *    The third argument is a string specifying the comparison function
  117. *    to be applied to table elements.  It defaults to 'LGT', the lexical
  118. *    compare function, which is suitable for strings.  'GT' could be used
  119. *    if the entries are numeric.
  120. *
  121. *    The result returned is the array created from the argument table.
  122. *    The function fails if the table could not be converted to an array.
  123. *
  124. *    From STRING AND LIST PROCESSING IN SNOBOL4 by Ralph E. Griswold,
  125. *             by permission of the author.
  126. *    ----------------------------------------------------------------
  127. *
  128.     DEFINE("SORT(TABLE,C,P)I,N,M,J,G,K,T1,T2")
  129.         ALEN    =    BREAK(",") . N        :(SORT_END)
  130.  
  131. SORT        SORT    =    CONVERT(TABLE,"ARRAY")    :F(FRETURN)
  132.         C    =    IDENT(C) 1
  133.         P    =    IDENT(P) "LGT"
  134.         OPSYN("CMP",P)
  135.         PROTOTYPE(SORT)    ALEN
  136.         G    =    N
  137.  
  138. SORTG        G    =    GT(G,1) G / 2        :F(RETURN)
  139.         M    =    N - G
  140. SORTK        K    =    0
  141.         I    =    1
  142. SORTJ        J    =    I + G
  143.         CMP(SORT[I,C],SORT[J,C])        :F(SORTI)
  144.         T1    =    SORT[I,1]
  145.         T2    =    SORT[I,2]
  146.         SORT[I,1]    =    SORT[J,1]
  147.         SORT[I,2]    =    SORT[J,2]
  148.         SORT[J,1]    =    T1
  149.         SORT[J,2]    =    T2
  150.         K    =    K + 1
  151. SORTI        I    =    LT(I,M) I + 1        :S(SORTJ)
  152.         GT(K,0)                    :S(SORTK)F(SORTG)
  153. SORT_END
  154.  
  155. *
  156. *    Part 3: Open files.
  157. *
  158. START        SCREEN = "Enter file to be indexed: " CHAR(26)
  159.         INFILE = INPUT                :F(END)
  160.         INPUT(.IDX_FILE,1,,INFILE)        :F(START)
  161.  
  162. START_1        SCREEN = "Enter file of words to exclude from index,"
  163.         SCREEN = "or ENTER if no exclusion file: " CHAR(26)
  164.         INWORDS = INPUT                :F(END)
  165.         IDENT(INWORDS)                :S(START_2)
  166.         INPUT(.IN,2,,INWORDS)            :F(START_1)
  167.  
  168. START_2        SCREEN = "Enter output file name: " CHAR(26)
  169.         OUTFILE = INPUT                :F(END)
  170.         OUTPUT(.OUTPUT,3,,OUTFILE)        :F(START_2)
  171.         
  172.  
  173. *
  174. *    Part 4: Read in words not to be indexed if file provided.
  175. *
  176.         SCROLL(25)
  177.         SCREEN = SP "Bitzer is indexing the text."
  178.         SCREEN =
  179.         SCREEN = SP "Please do not interrupt."
  180.         SCROLL(10)
  181.  
  182. *    Record in INDEX table with "#" as special marker.
  183. *
  184.         IDENT(INWORDS)                :S(READ)
  185. GETWDS        WORDS = REPLACE(IN,&LCASE,&UCASE)    :F(READ)
  186. GETW         WORDS    WPAT  =            :F(GETWDS)
  187.         INDEX<WORD> = "#"            :(GETW)
  188. *
  189. *    Part 5:  Main Processing
  190. *
  191. READ        LINE = REPLACE(IDX_FILE,&LCASE,&UCASE)    :F(DO_SORT)
  192.  
  193. *    Check for page number
  194.         LINE PAGE.DES                :F(NEXTW)
  195.         TESTP = " " PGNO ","            :(READ)
  196.  
  197. *    Isolate word, see if want to keep it.
  198. NEXTW        LINE WPAT =                :F(READ)
  199.  
  200. *    Should be at least one letter somewhere in the word, else ignore.
  201.         WORD  WCHK                :F(NEXTW)
  202.  
  203. *    A pointer to the table entry is used, to avoid making multiple
  204. *    lookups in the table.  See if it is marked as "ignore."
  205.         WORD_PTR = .INDEX<WORD>
  206.         IDENT($WORD_PTR,"#")            :S(NEXTW)
  207.  
  208. *    Error if word longer than 18 characters
  209.         LE(SIZE(WORD),18)            :S(TESTPG)
  210.         SCREEN = 'Word over 18 letters: "'
  211. +              WORD    '"; it is ignored.'
  212.         SCREEN =                :(NEXTW)
  213.  
  214.  
  215. *    See if already have an entry on this page for this word.
  216. TESTPG        $WORD_PTR  TESTP            :S(NEXTW)
  217.         $WORD_PTR = $WORD_PTR TESTP        :(NEXTW)
  218.  
  219. *
  220. *    Part 6: Sort results
  221. *
  222. DO_SORT        SCROLL(25)
  223.         SCREEN = SP "Bitzer is alphabetizing the index."
  224.         SCREEN =
  225.         SCREEN = SP "Please do not interrupt."
  226.         SCROLL(10)
  227.         INDEX = SORT(INDEX)            :S(SORTED)
  228.         OUTPUT = 'THERE IS NOTHING IN TABLE!'    :(END)
  229. *
  230. *    Part 7: Print results
  231. *
  232. SORTED        OUTPUT = 'WORD                PAGE NUMBERS'
  233.         OUTPUT = ' '
  234.  
  235. *    Print in columns.  Break long lines if necessary.  Remove trailing
  236. *    comma or "#" from entry.
  237. *
  238. PRINTW        S = S + 1
  239.         INDEX<S,2> RTAB(1) . C2            :F(LAST)
  240.         IDENT(C2)                :S(PRINTW)
  241.         PRINT(RPAD(INDEX<S,1>,19),C2,57,",")    :(PRINTW)
  242.  
  243. LAST        SCROLL(25)
  244.         SCREEN = SP "Bitzer is finished."
  245.         SCREEN =
  246.         SCREEN = SP "An index of " INFILE  
  247.         SCREEN = DIFFER(INWORDS) SP "excluding the words in " INWORDS
  248.         SCREEN = SP "will be found in " OUTFILE
  249.         SCROLL(9)
  250. END
  251.