|
|
1.1 root 1: ;;; "Flame" program. This has a chequered past.
2: ;;;
3: ;;; The original was on a Motorola 286 running Vanilla V.1,
4: ;;; about 2 years ago. It was couched in terms of a yacc (I think)
5: ;;; script. I pulled the data out of it and rewrote it as a piece
6: ;;; of PL/1 on Multics. Now I've moved it into an emacs-lisp
7: ;;; form. If the original author cares to contact me, I'd
8: ;;; be very happy to credit you!
9: ;;;
10: ;;; Ian G. Batten, [email protected]
11: ;;;
12:
13: (random t)
14:
15: (defvar sentence
16: '((how can you say that (statement) \?)
17: (I can\'t believe how (adjective) you are\.)
18: (only a (der-term) like you would say that (statement) \.)
19: ((statement) \, huh\?) (so\, (statement) \?)
20: ((statement) \, right\?) (I mean\, (sentence))
21: (don\'t you realise that (statement) \?)
22: (I firmly believe that (statement) \.)
23: (let me tell you something\, you (der-term) \, (statement) \.)
24: (furthermore\, you (der-term) \, (statement) \.)
25: (I couldn\'t care less about your (thing) \.)
26: (How can you be so (adjective) \?)
27: (you make me sick\.)
28: (it\'s well known that (statement) \.)
29: ((statement) \.)
30: (it takes a (group-adj) (der-term) like you to say that (statement) \.)
31: (I don\'t want to hear about your (thing) \.)
32: (you\'re always totally wrong\.)
33: (I\'ve never heard anything as ridiculous as the idea that (statement) \.)
34: (you must be a real (der-term) to think that (statement) \.)
35: (you (adjective) (group-adj) (der-term) \!)
36: (you\'re probably (group-adj) yourself\.)
37: (you sound like a real (der-term) \.)
38: (why\, (statement) \!)
39: (I have many (group-adj) friends\.)
40: (save the (thing) s\!) (no nukes\!) (ban (thing) s\!)
41: (I\'ll bet you think that (thing) s are (adjective) \.)
42: (you know\, (statement) \.)
43: (your (quality) reminds me of a (thing) \.)
44: (you have the (quality) of a (der-term) \.)
45: ((der-term) \!)
46: ((adjective) (group-adj) (der-term) \!)
47: (you\'re a typical (group-adj) person\, totally (adjective) \.)
48: (man\, (sentence))))
49:
50: (defvar sentence-loop (nconc sentence sentence))
51:
52:
53: (defvar quality
54: '((ignorance) (stupidity) (worthlessness)
55: (prejudice) (lack of intelligence) (lousiness)
56: (bad grammar) (lousy spelling)
57: (lack of common decency) (ugliness) (nastiness)
58: (subtlety) (dishonesty) ((adjective) (quality))))
59:
60:
61: (defvar quality-loop (nconc quality quality))
62:
63: (defvar adjective
64: '((ignorant) (crass) (pathetic) (sick)
65: (bloated) (malignant) (perverted) (sadistic)
66: (stupid) (unpleasant) (lousy) (abusive) (bad)
67: (braindamaged) (selfish) (improper) (nasty)
68: (disgusting) (foul) (intolerable) (primitive)
69: (depressing) (dumb) (phoney)
70: ((adjective) and (adjective))
71: (as (adjective) as a (thing))))
72:
73: (defvar adjective-loop (nconc adjective adjective))
74:
75: (defvar der-term
76: '(((adjective) (der-term)) (sexist) (fascist)
77: (weakling) (coward) (beast) (peasant) (racist)
78: (cretin) (fool) (jerk) (ignoramus) (idiot)
79: (wanker) (rat) (slimebag) (DAF driver)
80: (Neanderthal) (sadist) (drunk) (capitalist)
81: (wimp) (dogmatist) (wally) (maniac)
82: (whimpering scumbag) (pea brain) (arsehole)
83: (moron) (goof) (incompetant) (lunkhead) (Nazi)
84: (SysThug) ((der-term) (der-term))))
85:
86: (defvar der-term-loop (nconc der-term der-term))
87:
88:
89: (defvar thing
90: '(((adjective) (thing)) (computer)
91: (Honeywell dps8) (whale) (operation)
92: (sexist joke) (ten-incher) (dog) (MicroVAX II)
93: (source license) (real-time clock)
94: (mental problem) (sexual fantasy)
95: (venereal disease) (Jewish grandmother)
96: (cardboard cut-out) (punk haircut) (surfboard)
97: (system call) (wood-burning stove)
98: (graphics editor) (right wing death squad)
99: (disease) (vegetable) (religion)
100: (cruise missile) (bug fix) (lawyer) (copyright)
101: (PAD)))
102:
103: (defvar thing-loop (nconc thing thing))
104:
105:
106: (defvar group-adj
107: '((gay) (old) (lesbian) (young) (black)
108: (Polish) ((adjective)) (white)
109: (mentally retarded) (Nicaraguan) (homosexual)
110: (dead) (underpriviledged) (religious)
111: ((thing) \-loving) (feminist) (foreign)
112: (intellectual) (crazy) (working) (unborn)
113: (Chinese) (short) ((adjective)) (poor) (rich)
114: (funny-looking) (Puerto Rican) (Mexican)
115: (Italian) (communist) (fascist) (Iranian)
116: (Moonie)))
117:
118: (defvar group-adj-loop (nconc group-adj group-adj))
119:
120: (defvar statement
121: '((your (thing) is great) ((thing) s are fun)
122: ((person) is a (der-term))
123: ((group-adj) people are (adjective))
124: (every (group-adj) person is a (der-term))
125: (most (group-adj) people have (thing) s)
126: (all (group-adj) dudes should get (thing) s)
127: ((person) is (group-adj)) (trees are (adjective))
128: (if you\'ve seen one (thing) \, you\'ve seen them all)
129: (you\'re (group-adj)) (you have a (thing))
130: (my (thing) is pretty good)
131: (the Martians are coming)
132: (the (paper) is always right)
133: (just because you read it in the (paper) that doesn\'t mean it\'s true)
134: ((person) was (group-adj))
135: ((person) \'s ghost is living in your (thing))
136: (you look like a (thing))
137: (the oceans are full of dirty fish)
138: (people are dying every day)
139: (a (group-adj) man ain\'t got nothing in the world these days)
140: (women are inherently superior to men)
141: (the system staff is fascist)
142: (there is life after death)
143: (the world is full of (der-term) s)
144: (you remind me of (person)) (technology is evil)
145: ((person) killed (person))
146: (the Russians are tapping your phone)
147: (the Earth is flat)
148: (it\'s OK to run down (group-adj) people)
149: (Multics is a really (adjective) operating system)
150: (the CIA killed (person))
151: (the sexual revolution is over)
152: (Lassie was (group-adj))
153: (the (group-adj) s have really got it all together)
154: (I was (person) in a previous life)
155: (breathing causes cancer)
156: (it\'s fun to be really (adjective))
157: ((quality) is pretty fun) (you\'re a (der-term))
158: (the (group-adj) culture is fascinating)
159: (when ya gotta go ya gotta go)
160: ((person) is (adjective))
161: ((person) \'s (quality) is (adjective))
162: (it\'s a wonderful day)
163: (everything is really a (thing))
164: (there\'s a (thing) in (person) \'s brain)
165: ((person) is a cool dude)
166: ((person) is just a figment of your imagination)
167: (the more (thing) s you have, the better)
168: (life is a (thing)) (life is (quality))
169: ((person) is (adjective))
170: ((group-adj) people are all (adjective) (der-term) s)
171: ((statement) \, and (statement))
172: ((statement) \, but (statement))
173: (I wish I had a (thing))
174: (you should have a (thing))
175: (you hope that (statement))
176: ((person) is secretly (group-adj))
177: (you wish you were (group-adj))
178: (you wish you were a (thing))
179: (I wish I were a (thing))
180: (you think that (statement))
181: ((statement) \, because (statement))
182: ((group-adj) people don\'t get married to (group-adj) people because (reason))
183: ((group-adj) people are all (adjective) because (reason))
184: ((group-adj) people are (adjective) \, and (reason))
185: (you must be a (adjective) (der-term) to think that (person) said (statement))
186: ((group-adj) people are inherently superior to (group-adj) people)
187: (God is Dead)))
188:
189: (defvar statement-loop (nconc statement statement))
190:
191:
192: (defvar paper
193: '((Daily Mail) (Daily Express)
194: (Centre Bulletin) (Sun) (Daily Mirror)
195: (Daily Telegraph) (Beano) (Multics Manual)))
196:
197: (defvar paper-loop (nconc paper paper))
198:
199:
200: (defvar person
201: '((Reagan) (Ken Thompson) (Dennis Ritchie)
202: (JFK) (the Pope) (Gadaffi) (Napoleon)
203: (Karl Marx) (Groucho) (Michael Jackson)
204: (Caesar) (Nietzsche) (Heidegger)
205: (Henry Kissinger) (Nixon) (Castro) (Thatcher)
206: (Attilla the Hun) (Alaric the Visigoth) (Hitler)))
207:
208: (defvar person-loop (nconc person person))
209:
210: (defvar reason
211: '((they don\'t want their children to grow up to be too lazy to steal)
212: (they can\'t tell them apart from (group-adj) dudes)
213: (they\'re too (adjective))
214: ((person) wouldn\'t have done it)
215: (they can\'t spray paint that small)
216: (they don\'t have (thing) s) (they don\'t know how)
217: (they can\'t afford (thing) s)))
218:
219: (defvar reason-loop (nconc reason reason))
220:
221: (defmacro define-element (name)
222: (let ((loop-to-use (intern (concat name "-loop"))))
223: (` (defun (, (intern name)) nil
224: (let ((step-forward (% (random) 10)))
225: (if (< step-forward 0) (setq step-forward (- step-forward)))
226: (prog1
227: (nth step-forward (, loop-to-use))
228: (setq (, loop-to-use) (nthcdr (1+ step-forward) (, loop-to-use)))))))))
229:
230: (define-element "sentence")
231: (define-element "quality")
232: (define-element "adjective")
233: (define-element "der-term")
234: (define-element "group-adj")
235: (define-element "statement")
236: (define-element "thing")
237: (define-element "paper")
238: (define-element "person")
239: (define-element "reason")
240:
241: (defun *flame nil
242: (flame-expand '(sentence)))
243:
244: (defun flame-expand (object)
245: (cond ((atom object)
246: object)
247: (t (mapcar 'flame-expand (funcall (car object))))))
248:
249: (defun flatten (list)
250: (cond ((atom list)
251: (list list))
252: (t (apply 'append (mapcar 'flatten list)))))
253:
254: (defun flame (arg)
255: "Generate ARG (default 1) sentences of half-crazed gibberish."
256: (interactive "p")
257: (let ((w (selected-window)))
258: (pop-to-buffer (get-buffer-create "*Flame*"))
259: (goto-char (point-max))
260: (insert ?\n)
261: (flame2 arg)
262: (select-window w)))
263:
264: (defun flame2 (arg)
265: (let ((start (point)))
266: (flame1 arg)
267: (fill-region-as-paragraph start (point) t)))
268:
269: (defun flame1 (arg)
270: (cond ((zerop arg) t)
271: (t (insert (concat (sentence-ify (string-ify (append-suffixes-hack (flatten (*flame)))))))
272: (flame1 (1- arg)))))
273:
274: (defun sentence-ify (string)
275: (concat (upcase (substring string 0 1))
276: (substring string 1 (length string))
277: " "))
278:
279: (defun string-ify (list)
280: (mapconcat
281: '(lambda (x)
282: (format "%s" x))
283: list
284: " "))
285:
286: (defun append-suffixes-hack (list)
287: (cond ((null list)
288: nil)
289: ((memq (nth 1 list)
290: '(\? \. \, s\! \! s \'s \-loving))
291: (cons (intern (format "%s%s" (nth 0 list) (nth 1 list)))
292: (append-suffixes-hack (nthcdr 2 list))))
293: (t (cons (nth 0 list)
294: (append-suffixes-hack (nthcdr 1 list))))))
295:
296: (defun psychoanalyze-flamer ()
297: "Mr. Angry goes to the analyst."
298: (interactive)
299: (doctor) ; start the psychotherapy
300: (message "")
301: (switch-to-buffer "*doctor*")
302: (sit-for 0)
303: (while (not (input-pending-p))
304: (flame2 (if (= (% (random) 2) 0) 2 1))
305: (sit-for 0)
306: (doctor-ret-or-read 1)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.