259 lines
8.7 KiB
Scheme
259 lines
8.7 KiB
Scheme
;;; -*-Scheme-*-
|
|
;;;
|
|
;;; flame -- print a flame (ported from the Gnu-Emacs flame.el)
|
|
|
|
(define flame)
|
|
|
|
(let ((pos) (end-margin 55) (margin 65))
|
|
|
|
(set! flame (lambda n
|
|
(cond ((null? n)
|
|
(set! n '(1)))
|
|
((or (not (integer? (car n))) (negative? (car n)))
|
|
(error 'flame "positive integer argument expected")))
|
|
(set! pos 0)
|
|
(fluid-let ((garbage-collect-notify? #f))
|
|
(do ((i (car n) (1- i))) ((zero? i))
|
|
(if (> pos end-margin)
|
|
(begin
|
|
(set! pos 0) (newline)))
|
|
(flame-print #t (flatten (flame-expand '(sentence))))
|
|
(display " "))
|
|
(newline))
|
|
#v))
|
|
|
|
(define (flame-expand x)
|
|
(if (pair? x)
|
|
(map flame-expand ((eval (car x))))
|
|
x))
|
|
|
|
(define (flatten x)
|
|
(if (pair? x)
|
|
(apply append (map flatten x))
|
|
(list x)))
|
|
|
|
(define (capitalize w)
|
|
(display (char-upcase (string-ref w 0)))
|
|
(if (> (string-length w) 1)
|
|
(display (substring w 1 (string-length w)))))
|
|
|
|
(define (flame-print first x)
|
|
(if (not (null? x))
|
|
(begin
|
|
(let* ((w (symbol->string (car x))) (len (string-length w)))
|
|
((if first capitalize display) w)
|
|
(set! pos (+ 1 pos len))
|
|
(if (not (null? (cdr x)))
|
|
(begin
|
|
(if (not (memq (cadr x) '(? \. \, s! ! s \'s -loving)))
|
|
(if (< pos margin)
|
|
(display " ")
|
|
(set! pos 0) (newline)))
|
|
(flame-print #f (cdr x))))))))
|
|
|
|
(define (choose class)
|
|
(list-ref class (modulo (random) (length class))))
|
|
|
|
(define (sentence) (choose sentences))
|
|
|
|
(define sentences
|
|
'((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))))
|
|
|
|
(define (quality) (choose qualities))
|
|
|
|
(define qualities
|
|
'((ignorance) (stupidity) (worthlessness)
|
|
(prejudice) (lack of intelligence) (lousiness)
|
|
(bad grammar) (lousy spelling)
|
|
(lack of common decency) (ugliness) (nastiness)
|
|
(subtlety) (dishonesty) ((adjective) (quality))))
|
|
|
|
(define (adjective) (choose adjectives))
|
|
|
|
(define adjectives
|
|
'((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))))
|
|
|
|
(define (der-term) (choose der-terms))
|
|
|
|
(define der-terms
|
|
'(((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))))
|
|
|
|
(define (thing) (choose things))
|
|
|
|
(define things
|
|
'(((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)))
|
|
|
|
(define (group-adj) (choose group-adjs))
|
|
|
|
(define group-adjs
|
|
'((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)))
|
|
|
|
(define (statement) (choose statements))
|
|
|
|
(define statements
|
|
'((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)))
|
|
|
|
(define (paper) (choose papers))
|
|
|
|
(define papers
|
|
'((Daily Mail) (Daily Express)
|
|
(Centre Bulletin) (Sun) (Daily Mirror)
|
|
(Daily Telegraph) (Beano) (Multics Manual)))
|
|
|
|
(define (person) (choose persons))
|
|
|
|
(define persons
|
|
'((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)))
|
|
|
|
(define (reason) (choose reasons))
|
|
|
|
(define reasons
|
|
'((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)))
|
|
)
|
|
|
|
(flame 15)
|