{$R-} {Range checking off} {$B+} {Boolean complete evaluation on} {$S+} {Stack checking on} {$I+} {I/O checking on} {$N-} {No numeric coprocessor} {$M 65500,16384,655360} {Turbo 3 default stack and heap} { FOGGY Program Version 4.5, compiled with TurboPascal Version 5.5, by John Lawler, University of Michigan. Last modified November 26, 1994. Origins of FOGGY: I first received FOGGY from a former student who sent it to me as a program in an internal IBM BASIC-like language that was making the rounds among the lower-echelon techies. It contained the phrases for the Software Engineering option (file FOGGY.DAT), the Helpfile for that option, and simple code to generate sentences. In essence, the skeleton of the current FOGGY. I rewrote it in MS-BASIC, the only BASIC program I have ever written. I found the phrases for a "Folklore Paper Construction Kit" in Bolinger's (198?) book _Language: The Loaded Weapon_. They were obviously compatible, so I rewrote FOGGY in Pascal and altered it to use other databases, in particular, FOLKY.DAT. Later, I got the phrases from Chomsky's writings from Tony Aristar, who had written a Lisp program to do the same thing as FOGGY. I took his phrases, added a few more, and put them into the program as another option, file CHOMSKY.DAT. I am responsible for the Help screen. Finally, I got the idea to mix them all up together, and did so, after eliminating duplicates (of which there are a lot) from the other databases. The file is MUSHY.DAT. Structure of FOGGY: The program is extremely stupid. Essentially, it works on the American Chinese Menu principle: "One from column A, one from column B,..." Everything is done with fixed phrases; there is no morphological parsing, and no syntactic processing worthy of the name. Each sentence is constructed by choosing at random (using the Randomize function in Turbo-Pascal Version 5.5, which is close enough for non-numeric work) from four lists of phrases (in order, the INTRO, the SUBJECT, the VERB, and the OBJECT. These phrases are loaded into the program as requested by the interface routines, which query users about their choices; then the sentences are generated on the fly and formatted. That's it. The syntax is trivial: Paragraph ---> [Paragraph S | S] S ---> INTRO SUBJECT VERB OBJECT The *.DAT files have the following structure, starting from Line 1: ----------- -------------- : INTRO phrases, -------------- : one to a line SUBJECT$ : boundary marker - must be literal and uppercase -------------- : SUBJECT phrases, -------------- : one to a line VERB$ : -------------- : VERB phrases, -------------- : one to a line OBJECT$ : -------------- : OBJECT phrases, -------------- : one to a line ENDFILE$ : ----------- FOGGY is set up to format and hyphenate. However, the hyphenation routine looks for discretionary hyphens, which are marked in the *.DAT files with backslashes (ASCII "\"). A typical section of FOGGY.DAT looks like this: ----------- the in\cor\por\a\tion of ad\di\tio\n\al mis\sion con\straints the in\d\e\pen\dent func\tion\al prin\ci\ple the in\ter\re\l\a\tion of sys\tem and/\or sub\sys\tem tech\no\l\o\gies the pro\duct as\sur\ance ar\ch\i\tec\ture VERB$ must ut\i\l\ize and be func\tion\al\ly in\ter\wo\ven with adds ex\pli\cit per\form\ance lim\its to ne\c\es\si\t\ates that ur\gent con\sid\er\a\tion be ap\plied to ----------- If you're interested in adding a database, just copy the appropriate code below and create your own FOGGY. And I'd appreciate it if you would send me a copy of the revised code and the new data file. } Uses Crt, {Unit found in TURBO.TPL} Printer; {Unit found in TURBO.TPL} type topictype = (folklore, software_engineering, chomsky, mixed_bag); {current choices} const topic_char_set : set of char = ['F', 'S', 'L', 'M']; topic : topictype = mixed_bag; {default} AUTO : boolean = false; { automatic mode } LINELENG = 70; { width of displayed screen line} MAXNUM = 100; { maximum number of any single kind of paradigm part} MAXLENG = 150; { maximum length of any paradigm part} SAVENAME = 'FOGGY.TXT'; {name of the file in which the text is saved} DARKPRINT = ''; {this is presently null -- if you want to send some printer codes, put them here.} type paradigm = (leadin, subject, verb, dbject); {4 kinds of paradigm parts - the last one should be "Object", except that's a Reserved Word in Turbo 5.5, so it's "Dbject" instead} chunk = string[MAXLENG]; {general string type} longstring = string[254]; {long string type} fogset = array [1..MAXNUM] of chunk; {one for each kind of paradigm part} associates = record numberof : integer; {how many of each kind} list : fogset; {the list of parts} used : array [1..MAXNUM] of integer; {parts used} end; {record associates} phrase = array [paradigm] of associates; {data set type} var this : phrase; {the data set -- data file read into array of records} thispart : paradigm; {index for loops over paradigm parts} OUTSTR : longstring; topicname, blanks, hunk, DATANAME, header, footer : chunk; print, save_file, fileopen, nu, firstln : boolean; outfile : text; {the file in which text is saved} i, j, top, TIMES, qq, xi, yi : integer; WHAT : char; procedure reversv (text: chunk); begin clreol; textbackground (white); textcolor (black); write (text); textbackground (black); textcolor (white); end; procedure overandout; begin gotoxy (1,yi+1); clreol; gotoxy (1,yi); clreol; write (' '); if (save_file or fileopen) then begin close (outfile); reversv (footer + 'Look in '+SAVENAME+'. *'); end else reversv (footer + ' it''s been real. * '); writeln; halt; end; procedure error (x : chunk); begin writeln (x); yi := wherey; write (^G); overandout; end; {fatal procedure error} function yesno (x : chunk) : boolean; const yesset : set of char = ['Y','y']; var what : char; begin yesno := false; if AUTO then exit; reversv (x); what := readkey; if what in yesset then yesno := true; end; {boolean procedure yesno} function upstring (x : chunk) : chunk; var y: chunk; j,i: integer; begin y := ''; j := length (x); for i := 1 to j do y := y + upcase (x[i]); upstring := y; end; procedure do_fog; begin topic := software_engineering; DATANAME := 'C:\Z\PROGRAM\FOGGY.DAT'; topicname := 'Software Engineering'; blanks := ' '; end; procedure do_folk; begin topic := folklore; DATANAME := 'C:\Z\PROGRAM\FOLKY.DAT'; topicname := 'Folklore'; blanks := ' '; end; procedure do_ling; begin topic := chomsky; DATANAME := 'C:\Z\PROGRAM\CHOMSKY.DAT'; topicname := 'Chomskyan Linguistics'; blanks := ' '; end; procedure do_mush; begin topic := mixed_bag; DATANAME := 'C:\Z\PROGRAM\MUSHY.DAT'; topicname := 'Mixed-up'; blanks := ' '; end; procedure choose_file; begin while not (WHAT in topic_char_set) do begin gotoxy (15,yi); reversv (' Choose a topic by letter (or [M] for "Mixed-Up"): '); gotoxy (15,yi+1); reversv (' [L]inguistics, [F]olklore, [S]oftware Engineering '^H); WHAT := upcase (readkey); case WHAT of 'S' : do_fog; 'L' : do_ling; 'F' : do_folk; 'M' : do_mush; end; {case} end; {while} gotoxy (1,yi); clreol; write (blanks+'Your topic is '+ topicname + '.'); gotoxy (1,yi+1); clreol; write (' '); print := yesno (' Do you want a printed copy? (Y/N) '^H); gotoxy (1, yi+1); clreol; write (' '); save_file := yesno (' Do you want the output saved in a file? (Y/N) '^H); end; function getemin : integer; type delimiter = array[paradigm] of string[15]; const mark : delimiter = ('SUBJECT$', 'VERB$', 'OBJECT$', 'ENDFILE$'); (*********************************************************************** *Mark is a typed constant showing the delimiters for each kind of par-* *adigm set. Change these assignments to restructure the data file. * ***********************************************************************) var f : text; maxi, ii : integer; {longest number of any kind} workstring : longstring; function process (x:longstring): chunk; {function to set high bits at hyphenation points, which are marked in the input file with a '\' at all points where a hyphen could go (like this: meth\o\d\o\l\o\g\ic\al); internal to function getemin} var jj, ji : integer; temp : chunk; done : boolean; procedure set_hi_bit; {internal to function process} begin delete (temp,jj,1); temp[jj-1] := chr (ord (temp[jj-1]) + 128); end; {internal procedure set_hi_bit} begin {internal function process proper} ji := length (x); done := false; if ji > 0 then begin temp := x; jj := 1; while not done do begin if temp[jj] = '\' then set_hi_bit; if jj >= length (temp) then done := true else jj := jj + 1; end; end; process := temp; end; {internal chunk function process} begin {function getemin proper} {initialize counters} for thispart := leadin to dbject do begin this[thispart].numberof := 0; for ii := 1 to maxnum do this[thispart].used[ii] := 0; end; {for} maxi := MAXNUM; {normal file i/o checking} assign (f, DATANAME); {$I-} reset (f); {$I+} if ioresult <> 0 then error (' No Data File. Terminating.'); {main loop} for thispart := leadin to dbject do with this[thispart] do begin {with (and for)} repeat begin {repeat} readln (f, workstring); {get one line in from file} if workstring <> mark[thispart] then begin {if it's a chunk of text and not a delimiter} numberof := numberof + 1; {count it} list[numberof] := process (workstring); {process it} end; {if} end; {repeat} until (eof (f)) {end of file stops the loop} or (workstring = mark[thispart]); {so does hitting a delimiter} if numberof < maxi then maxi := numberof; {set max} {i/o check} if (thispart <> dbject) and (eof (f)) then error (' Data File Damaged. Terminating.'); end; {with (and for)} close (f); getemin := maxi; {return maximum value} end; {integer function getemin} procedure open_save; var jj : integer; begin if not fileopen then begin assign (outfile, SAVENAME); {$I-} rewrite (outfile); {$I+} jj := ioresult; fileopen := true; end; end; procedure trademark; begin clrscr; writeln; writeln (' ZDDDDDDDDDDDDDDDDDDDDDDDD?'); write (' 3 '); reversv (' FOGGY (Version 4.5) '); writeln (' 3'); writeln (' @DDDDDDDDDDDDDDDDDDDDDDDDY'); writeln (' ZDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD?'); write (' 3 '); reversv (' Copyright (C) 1994 The Eclectic Company '); writeln (' 3'); writeln (' @DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDY'); writeln (' ZDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD?'); write (' 3 '); reversv (' This Program Distributed Free In The Public Interest '); writeln (' 3'); writeln (' @DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDY'); writeln; yi := wherey; end; {procedure trademark} function thatmany : integer; const quitset : set of char = ['Q','q']; var TEMP, WHERE : integer; begin if AUTO then begin thatmany := 5; exit; end; thatmany := 0; gotoxy (1,yi+1); clreol; write (' '); reversv (' Please enter number of sentences (Q = Quit) : '^H); what := readkey; if WHAT <> '' then begin if WHAT in quitset then overandout; val (WHAT, TEMP, WHERE); if WHERE = 0 then thatmany := TEMP; writeln; end; end; {integer function thatmany} procedure spitline; { General output procedure. Contains internal subroutines theend() and spit(). Side effect on global string variable OUTSTR: initial substring deleted after printing. } var OLDLN, l : integer; workstring : chunk; lastline : boolean; procedure spit (y: longstring; NEWLN:integer); { Procedure to format and print the line. Internal to procedure spitline. Contains internal function fill(). Resets the high bits. Sets the left margin. Adds discretionary hyphens. } const screenmargin = ' '; printmargin = ' '; var outs : chunk; index, jj : integer; function fill (x : chunk) : chunk; { Internal chunk function to fill in blanks to right-justify line. Looks for periods and commas preferentially. Returns filled line. Skips last characters. } var y : longstring; howmany, ii : integer; begin {function fill} howmany := LINELENG - length (x); if howmany > 0 then begin y := copy(x,1,length(x)); {replace each blank in string with '[!]'} ii := pos (' ',y); while ii > 0 do begin delete (y,ii,1); insert ('[!]',y,ii); ii := pos (' ',y); end; {and concatenate doubles} ii := pos ('][',y); while ii > 0 do begin delete (y,ii,2); ii := pos ('][',y); end; {now look for non-last periods as first fill sites:} ii := pos ('.',y); while (ii > 0) and (howmany > 0) do if ii < length (y) then begin delete (y,ii,2); insert ('@ ',y,ii); ii := pos ('.',y); howmany := howmany - 1; end else ii := 0; {if necessary, non-last commas as well:} ii := pos (', ' ,y); while (ii > 0) and (howmany > 0) do if ii < length (y) then begin delete (y,ii,2); insert ('# ',y,ii); ii := pos (', ',y); howmany := howmany - 1; end else ii := 0; {then alternate remaining blanks} while howmany > 0 do begin ii := pos ('[!]',y); if ii > 0 then if odd(howmany) then begin delete (y,ii,3); insert ('[ ]',y,ii); ii := pos ('[!]',y); howmany := howmany - 1; end else begin delete (y,ii,3); insert ('[ ]',y,ii); ii := pos ('[!]',y); end else {case where still needs fill but no odd blanks left} while howmany > 0 do begin ii := pos ('[ ]',y); insert (' ',y,ii+1); howmany := howmany - 1; end; end; {now put everything back:} ii := pos ('[',y); while ii > 0 do begin delete (y,ii,1); ii := pos ('[',y); end; ii := pos (']',y); while ii > 0 do begin delete (y,ii,1); ii := pos (']',y); end; ii := pos ('!',y); while ii > 0 do begin delete (y,ii,1); insert (' ',y,ii); ii := pos ('!',y); end; ii := pos ('@',y); while ii > 0 do begin delete (y,ii,1); insert ('.',y,ii); ii := pos ('@',y); end; ii := pos ('#',y); while ii > 0 do begin delete (y,ii,1); insert (',',y,ii); ii := pos ('#',y); end; fill := copy (y,1,length(y)); end else fill := x; end; {internal chunk function fill} begin {internal procedure spit proper} outs := copy (y,1,NEWLN); {make a working copy} if not firstln then while outs[1] = ' ' do delete (outs,1,1) else firstln := false; jj := length (outs); {reset all high bits except on the last character in the string:} for index := 1 to jj-1 do if ord(outs[index]) > 127 then outs[index] := chr (ord(outs[index])-128); {...but if the high-bit is set on the last character...} if ord(outs[jj]) > 127 then begin outs[jj] := chr (ord(outs[jj])-128); {reset it, of course, but...} outs := outs + '-'; {add a hyphen, too} end; {fill out all but last line:} if not lastline then outs := fill (outs); {write it on the screen:} writeln (screenmargin + outs); if print then {and on the printer on request:} begin writeln (lst, printmargin + outs); if lastline then writeln (lst); {space between paragraphs} end; if save_file then {and in the save file on request:} begin writeln (outfile, outs); if lastline then writeln (outfile); {space between paragraphs} end; end; {procedure spit} function theend (z : longstring) : integer; { Function to find the last line-end point in a string: (a space or a (real or discretionary) hyphen). Internal to procedure spitline. Returns integer to mark position, like pos(). } var x : chunk; ii : integer; label break; begin {internal integer function theend} if length (z) < LINELENG then {case of last line} begin theend := length (z); {return length so whole line gets spit} lastline := true; end else begin {normal case : length >= LINELENG } lastline := false; for ii := LINELENG downto 1 do {step it off} begin {for} if (z[ii] = '-') {if it's a hyphen...} or ((ord(z[ii]) > 128) {or a discretionary hyphen...} and (ii < LINELENG)) {except at the end of the string:} then goto break; {break out of the loop} if z[ii] = ' ' then {if it's a space...} begin ii := ii - 1; {decrement counter to avoid space} goto break; {break out of loop} end; end; {for} break: {and here's where they go:} while z[ii] = ' ' do ii := ii - 1; {skip any trailing spaces} theend := ii; {return counter} end; {normal case} end; {internal integer function theend} begin {procedure spitline proper} if length (OUTSTR) = 0 then error('Error! - empty OUTSTR passed to spitline') else {normal case} begin {find the right place to break:} l := theend (OUTSTR); {write out just the right amount of OUTSTR:} spit (OUTSTR, l); {and delete it:} delete (OUTSTR, 1,l); {shave any leading blanks left in OUTSTR:} while OUTSTR[1] = ' ' do delete (OUTSTR,1,1); end; end; {procedure spitline} procedure help; begin if topic = software_engineering then begin clrscr; writeln (' IMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM;'); writeln (' : FOGGY is an interactive productivity tool designed to :'); writeln (' : assist in the composition of monthly reports, project plans, :'); writeln (' : memos to management, and so forth. FOGGY generates as output :'); writeln (' : high-fog-index sentences suitable for befuddling even the :'); writeln (' : most determined seeker-after-content. If you need vast :'); writeln (' : amounts of FOGGY for really serious tush-covering, enter the :'); writeln (' : number of sentences needed at the prompt. For example, :'); writeln (' : entering "5" produces half a screen of heat-treated, battle- :'); writeln (' : hardened, industrial-strength slop, well suited to choking :'); writeln (' : hogs and assurance planners. :'); writeln (' LMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM9'); write (' : '); reversv (' REMEMBER: FOGGY can be a terrible weapon - never abuse it. '); writeln (' :'); writeln (' HMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM<'); writeln; yi := wherey; end else if topic = chomsky then begin clrscr; writeln (' IMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM;'); writeln (' : FOGGY is an interactive productivity tool designed to :'); writeln (' : assist in the composition of linguistic papers in the style :'); writeln (' : of the Great Master. It is based on actual selected phrases :'); writeln (' : taken from real books and articles written by Noam Chomsky. :'); writeln (' : Upon request, it assembles the phrases in the elegant styl- :'); writeln (' : istic patterns Prof. Chomsky is internationally noted for. :'); writeln (' GDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD6'); writeln (' : If you''re way behind on your LSA paper, only to discover the :'); writeln (' : evening before you have to give it that the crucial example :'); writeln (' : is ungrammatical, or the logic has fallen apart, or your ar- :'); writeln (' : guments don''t prove what they''re supposed to, don''t despair! :'); writeln (' : DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD :'); writeln (' : You, too, can remedy the situation, using the technological :'); writeln (' : powers of Artificial Stupidity and Tendentious Density (TM). :'); writeln (' : Simply specify the number of sentences needed at the prompt, :'); writeln (' : and FOGGY will generate screen after screen of industrial- :'); writeln (' : strength linguistic Truth and Wisdom. :'); writeln (' LMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM9'); write (' : '); reversv (' REMEMBER: FOGGY can be a terrible weapon - never abuse it. '); writeln (' :'); writeln (' HMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM<'); writeln; yi := wherey; end; end; {procedure help} procedure checkbatch; const {these are the command-line switches to use for batch use:} mush_set = ('ALLAUTOMUSHMIX'); ling_set = ('CHOMSKYSYNTAXLING'); folk_set = ('FOLKYFOLKLORE'); fog_set = ('FOGGYSOFTWARENGIN'); var x : chunk; begin print := false; save_file := false; fileopen := false; if paramcount > 0 then begin WHAT := 'X'; topicname := 'Mixed-Up'; blanks := ' '; x := upstring (paramstr(1)); AUTO := true; if pos (x, mush_set) <> 0 then do_mush else if pos (x, ling_set) <> 0 then do_ling else if pos (x, folk_set) <> 0 then do_folk else if pos (x, fog_set) <> 0 then do_fog else AUTO := false; end; {if} end; {checkbatch} begin {program proper} repeat checkbatch; if not AUTO then begin trademark; choose_file; end; top := getemin; repeat header := ' High-Fog-Index Sentence'; footer := ' * Thanks -'; repeat TIMES := thatmany; if TIMES = 0 then help; until TIMES > 0; if TIMES > 1 then begin header := header + 's'; footer := footer + '-'; end; header := header +' * '; if print then write (lst, DARKPRINT+^J^J^J^J); if save_file then open_save; randomize; clrscr; writeln; write (' '); str (TIMES, hunk); header := ' * ' + hunk + header; reversv (header); writeln; writeln; OUTSTR := ' '; {indent first line} firstln := true; for i := 1 to TIMES do {outer loop (no. of sentences)} for thispart := leadin to dbject do {inner loop for each sentence} with this[thispart] do begin {with (and both for loops)} {pick a number, any number:} nu := false; while not nu do begin j := random(numberof) + 1; {check for repeats:} nu := true; if i > 1 then for qq := 1 to i-1 do if used[qq] = j then nu := false; end; {while not nu} {log it:} used[i] := j; {sentence space:} if thispart = leadin then OUTSTR := OUTSTR + ' '; {add the appropriate paradigm part to the output string:} OUTSTR := OUTSTR + ' ' + list[j]; {check to see if it's long enough to spit out:} while length(OUTSTR) > LINELENG do spitline; end; {with (and both for loops)} {now write out the last line.} if length (OUTSTR) > 0 then spitline; writeln; yi := wherey; writeln; if print then write (lst,^L); {check if more is wanted:} if not AUTO then begin write (' '); reversv (' Would you like '); xi := wherex; end; until (not yesno('another batch? (Y/N) '^H)); {if not, change the subject:} gotoxy (xi, yi+1); clreol; until (not yesno ('a different topic? (Y/N) '^H)); {if not, then say goodbye:} overandout; end.