home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / farb2.icn < prev    next >
Text File  |  2000-07-29  |  2KB  |  65 lines
  1. ############################################################################
  2. #
  3. #    File:     farb2.icn
  4. #
  5. #    Subject:  Program to generate Farberisms
  6. #
  7. #    Author:   Alan Beale
  8. #
  9. #    Date:     June 14, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #     Dave Farber, co-author of the original SNOBOL programming
  18. #  language, is noted for his creative use of the English language.
  19. #  Hence the terms ``farberisms'' and ``to farberate''.  This pro-
  20. #  gram produces a randomly selected farberism.
  21. #
  22. #  Notes: Not all of the farberisms contained in this program were
  23. #  uttered by the master himself; others have learned to emulate
  24. #  him.  A few of the farberisms may be objectionable to some per-
  25. #  sons.  ``I wouldn't marry her with a twenty-foot pole.''
  26. #
  27. ############################################################################
  28. #
  29. #     This program obtains its farberisms from the farber.sen file to
  30. #  allow additional farberisms to be added without recompilation or
  31. #  straining the limits of the Icon translator.  It builds an index file
  32. #  farber.idx to allow for efficient access to the sentences file.  The
  33. #  use of untranslated I/O for the index file is necessary for correct
  34. #  behavior on some systems (e.g., MVS).
  35. #
  36. ############################################################################
  37. #
  38. #  Links:  random
  39. #
  40. ############################################################################
  41.  
  42. link random
  43.  
  44. procedure main(argv)
  45.    local f, ix, n
  46.  
  47.    f := open("farber.sen", "r") | stop("*** cannot open \"farber.sen\"")
  48.    if not (ix := open("farber.idx", "ru")) then {
  49.       ix := open("farber.idx", "bcu")
  50.       n := 0;
  51.       repeat {
  52.          writes(ix, left(where(f), 10))
  53.          if not read(f) then break
  54.          n +:= 1
  55.       }
  56.       seek(ix, -10)
  57.       writes(ix, left(n, 10))
  58.    }
  59.    seek(ix, -10)
  60.    randomize()
  61.    seek(ix,10*(?numeric(reads(ix,10))-1))
  62.    seek(f,numeric(reads(ix,10)))
  63.    write(read(f))
  64. end
  65.