diff options
Diffstat (limited to 'lisp/flame.el')
| -rw-r--r-- | lisp/flame.el | 306 |
1 files changed, 306 insertions, 0 deletions
diff --git a/lisp/flame.el b/lisp/flame.el new file mode 100644 index 00000000000..0f6d57852eb --- /dev/null +++ b/lisp/flame.el @@ -0,0 +1,306 @@ +;;; "Flame" program. This has a chequered past. +;;; +;;; The original was on a Motorola 286 running Vanilla V.1, +;;; about 2 years ago. It was couched in terms of a yacc (I think) +;;; script. I pulled the data out of it and rewrote it as a piece +;;; of PL/1 on Multics. Now I've moved it into an emacs-lisp +;;; form. If the original author cares to contact me, I'd +;;; be very happy to credit you! +;;; +;;; Ian G. Batten, Batten@uk.ac.bham.multics +;;; + +(random t) + +(defvar sentence + '((how can you say that (statement) \?) + (I can\'t believe how (adjective) you are\.) + (only a (der-term) like you would say that (statement) \.) + ((statement) \, huh\?) (so\, (statement) \?) + ((statement) \, right\?) (I mean\, (sentence)) + (don\'t you realise that (statement) \?) + (I firmly believe that (statement) \.) + (let me tell you something\, you (der-term) \, (statement) \.) + (furthermore\, you (der-term) \, (statement) \.) + (I couldn\'t care less about your (thing) \.) + (How can you be so (adjective) \?) + (you make me sick\.) + (it\'s well known that (statement) \.) + ((statement) \.) + (it takes a (group-adj) (der-term) like you to say that (statement) \.) + (I don\'t want to hear about your (thing) \.) + (you\'re always totally wrong\.) + (I\'ve never heard anything as ridiculous as the idea that (statement) \.) + (you must be a real (der-term) to think that (statement) \.) + (you (adjective) (group-adj) (der-term) \!) + (you\'re probably (group-adj) yourself\.) + (you sound like a real (der-term) \.) + (why\, (statement) \!) + (I have many (group-adj) friends\.) + (save the (thing) s\!) (no nukes\!) (ban (thing) s\!) + (I\'ll bet you think that (thing) s are (adjective) \.) + (you know\, (statement) \.) + (your (quality) reminds me of a (thing) \.) + (you have the (quality) of a (der-term) \.) + ((der-term) \!) + ((adjective) (group-adj) (der-term) \!) + (you\'re a typical (group-adj) person\, totally (adjective) \.) + (man\, (sentence)))) + +(defvar sentence-loop (nconc sentence sentence)) + + +(defvar quality + '((ignorance) (stupidity) (worthlessness) + (prejudice) (lack of intelligence) (lousiness) + (bad grammar) (lousy spelling) + (lack of common decency) (ugliness) (nastiness) + (subtlety) (dishonesty) ((adjective) (quality)))) + + +(defvar quality-loop (nconc quality quality)) + +(defvar adjective + '((ignorant) (crass) (pathetic) (sick) + (bloated) (malignant) (perverted) (sadistic) + (stupid) (unpleasant) (lousy) (abusive) (bad) + (braindamaged) (selfish) (improper) (nasty) + (disgusting) (foul) (intolerable) (primitive) + (depressing) (dumb) (phoney) + ((adjective) and (adjective)) + (as (adjective) as a (thing)))) + +(defvar adjective-loop (nconc adjective adjective)) + +(defvar der-term + '(((adjective) (der-term)) (sexist) (fascist) + (weakling) (coward) (beast) (peasant) (racist) + (cretin) (fool) (jerk) (ignoramus) (idiot) + (wanker) (rat) (slimebag) (DAF driver) + (Neanderthal) (sadist) (drunk) (capitalist) + (wimp) (dogmatist) (wally) (maniac) + (whimpering scumbag) (pea brain) (arsehole) + (moron) (goof) (incompetant) (lunkhead) (Nazi) + (SysThug) ((der-term) (der-term)))) + +(defvar der-term-loop (nconc der-term der-term)) + + +(defvar thing + '(((adjective) (thing)) (computer) + (Honeywell dps8) (whale) (operation) + (sexist joke) (ten-incher) (dog) (MicroVAX II) + (source license) (real-time clock) + (mental problem) (sexual fantasy) + (venereal disease) (Jewish grandmother) + (cardboard cut-out) (punk haircut) (surfboard) + (system call) (wood-burning stove) + (graphics editor) (right wing death squad) + (disease) (vegetable) (religion) + (cruise missile) (bug fix) (lawyer) (copyright) + (PAD))) + +(defvar thing-loop (nconc thing thing)) + + +(defvar group-adj + '((gay) (old) (lesbian) (young) (black) + (Polish) ((adjective)) (white) + (mentally retarded) (Nicaraguan) (homosexual) + (dead) (underpriviledged) (religious) + ((thing) \-loving) (feminist) (foreign) + (intellectual) (crazy) (working) (unborn) + (Chinese) (short) ((adjective)) (poor) (rich) + (funny-looking) (Puerto Rican) (Mexican) + (Italian) (communist) (fascist) (Iranian) + (Moonie))) + +(defvar group-adj-loop (nconc group-adj group-adj)) + +(defvar statement + '((your (thing) is great) ((thing) s are fun) + ((person) is a (der-term)) + ((group-adj) people are (adjective)) + (every (group-adj) person is a (der-term)) + (most (group-adj) people have (thing) s) + (all (group-adj) dudes should get (thing) s) + ((person) is (group-adj)) (trees are (adjective)) + (if you\'ve seen one (thing) \, you\'ve seen them all) + (you\'re (group-adj)) (you have a (thing)) + (my (thing) is pretty good) + (the Martians are coming) + (the (paper) is always right) + (just because you read it in the (paper) that doesn\'t mean it\'s true) + ((person) was (group-adj)) + ((person) \'s ghost is living in your (thing)) + (you look like a (thing)) + (the oceans are full of dirty fish) + (people are dying every day) + (a (group-adj) man ain\'t got nothing in the world these days) + (women are inherently superior to men) + (the system staff is fascist) + (there is life after death) + (the world is full of (der-term) s) + (you remind me of (person)) (technology is evil) + ((person) killed (person)) + (the Russians are tapping your phone) + (the Earth is flat) + (it\'s OK to run down (group-adj) people) + (Multics is a really (adjective) operating system) + (the CIA killed (person)) + (the sexual revolution is over) + (Lassie was (group-adj)) + (the (group-adj) s have really got it all together) + (I was (person) in a previous life) + (breathing causes cancer) + (it\'s fun to be really (adjective)) + ((quality) is pretty fun) (you\'re a (der-term)) + (the (group-adj) culture is fascinating) + (when ya gotta go ya gotta go) + ((person) is (adjective)) + ((person) \'s (quality) is (adjective)) + (it\'s a wonderful day) + (everything is really a (thing)) + (there\'s a (thing) in (person) \'s brain) + ((person) is a cool dude) + ((person) is just a figment of your imagination) + (the more (thing) s you have, the better) + (life is a (thing)) (life is (quality)) + ((person) is (adjective)) + ((group-adj) people are all (adjective) (der-term) s) + ((statement) \, and (statement)) + ((statement) \, but (statement)) + (I wish I had a (thing)) + (you should have a (thing)) + (you hope that (statement)) + ((person) is secretly (group-adj)) + (you wish you were (group-adj)) + (you wish you were a (thing)) + (I wish I were a (thing)) + (you think that (statement)) + ((statement) \, because (statement)) + ((group-adj) people don\'t get married to (group-adj) people because (reason)) + ((group-adj) people are all (adjective) because (reason)) + ((group-adj) people are (adjective) \, and (reason)) + (you must be a (adjective) (der-term) to think that (person) said (statement)) + ((group-adj) people are inherently superior to (group-adj) people) + (God is Dead))) + +(defvar statement-loop (nconc statement statement)) + + +(defvar paper + '((Daily Mail) (Daily Express) + (Centre Bulletin) (Sun) (Daily Mirror) + (Daily Telegraph) (Beano) (Multics Manual))) + +(defvar paper-loop (nconc paper paper)) + + +(defvar person + '((Reagan) (Ken Thompson) (Dennis Ritchie) + (JFK) (the Pope) (Gadaffi) (Napoleon) + (Karl Marx) (Groucho) (Michael Jackson) + (Caesar) (Nietzsche) (Heidegger) + (Henry Kissinger) (Nixon) (Castro) (Thatcher) + (Attilla the Hun) (Alaric the Visigoth) (Hitler))) + +(defvar person-loop (nconc person person)) + +(defvar reason + '((they don\'t want their children to grow up to be too lazy to steal) + (they can\'t tell them apart from (group-adj) dudes) + (they\'re too (adjective)) + ((person) wouldn\'t have done it) + (they can\'t spray paint that small) + (they don\'t have (thing) s) (they don\'t know how) + (they can\'t afford (thing) s))) + +(defvar reason-loop (nconc reason reason)) + +(defmacro define-element (name) + (let ((loop-to-use (intern (concat name "-loop")))) + (` (defun (, (intern name)) nil + (let ((step-forward (% (random) 10))) + (if (< step-forward 0) (setq step-forward (- step-forward))) + (prog1 + (nth step-forward (, loop-to-use)) + (setq (, loop-to-use) (nthcdr (1+ step-forward) (, loop-to-use))))))))) + +(define-element "sentence") +(define-element "quality") +(define-element "adjective") +(define-element "der-term") +(define-element "group-adj") +(define-element "statement") +(define-element "thing") +(define-element "paper") +(define-element "person") +(define-element "reason") + +(defun *flame nil + (flame-expand '(sentence))) + +(defun flame-expand (object) + (cond ((atom object) + object) + (t (mapcar 'flame-expand (funcall (car object)))))) + +(defun flatten (list) + (cond ((atom list) + (list list)) + (t (apply 'append (mapcar 'flatten list))))) + +(defun flame (arg) + "Generate ARG (default 1) sentences of half-crazed gibberish." + (interactive "p") + (let ((w (selected-window))) + (pop-to-buffer (get-buffer-create "*Flame*")) + (goto-char (point-max)) + (insert ?\n) + (flame2 arg) + (select-window w))) + +(defun flame2 (arg) + (let ((start (point))) + (flame1 arg) + (fill-region-as-paragraph start (point) t))) + +(defun flame1 (arg) + (cond ((zerop arg) t) + (t (insert (concat (sentence-ify (string-ify (append-suffixes-hack (flatten (*flame))))))) + (flame1 (1- arg))))) + +(defun sentence-ify (string) + (concat (upcase (substring string 0 1)) + (substring string 1 (length string)) + " ")) + +(defun string-ify (list) + (mapconcat + '(lambda (x) + (format "%s" x)) + list + " ")) + +(defun append-suffixes-hack (list) + (cond ((null list) + nil) + ((memq (nth 1 list) + '(\? \. \, s\! \! s \'s \-loving)) + (cons (intern (format "%s%s" (nth 0 list) (nth 1 list))) + (append-suffixes-hack (nthcdr 2 list)))) + (t (cons (nth 0 list) + (append-suffixes-hack (nthcdr 1 list)))))) + +(defun psychoanalyze-flamer () + "Mr. Angry goes to the analyst." + (interactive) + (doctor) ; start the psychotherapy + (message "") + (switch-to-buffer "*doctor*") + (sit-for 0) + (while (not (input-pending-p)) + (flame2 (if (= (% (random) 2) 0) 2 1)) + (sit-for 0) + (doctor-ret-or-read 1))) |