home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / scheme / flame < prev    next >
Encoding:
Text File  |  1992-10-14  |  8.7 KB  |  259 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; flame -- print a flame (ported from the Gnu-Emacs flame.el)
  4.  
  5. (define flame)
  6.  
  7. (let ((pos) (end-margin 55) (margin 65))
  8.  
  9. (set! flame (lambda n
  10.     (cond ((null? n)
  11.        (set! n '(1)))
  12.       ((or (not (integer? (car n))) (negative? (car n)))
  13.        (error 'flame "positive integer argument expected")))
  14.     (set! pos 0)
  15.     (fluid-let ((garbage-collect-notify? #f))
  16.       (do ((i (car n) (1- i))) ((zero? i))
  17.     (if (> pos end-margin)
  18.         (begin
  19.           (set! pos 0) (newline)))
  20.     (flame-print #t (flatten (flame-expand '(sentence))))
  21.     (display "  "))
  22.       (newline))
  23.     #v))
  24.  
  25. (define (flame-expand x)
  26.   (if (pair? x)
  27.       (map flame-expand ((eval (car x))))
  28.       x))
  29.  
  30. (define (flatten x)
  31.   (if (pair? x)
  32.       (apply append (map flatten x))
  33.       (list x)))
  34.  
  35. (define (capitalize w)
  36.   (display (char-upcase (string-ref w 0)))
  37.   (if (> (string-length w) 1)
  38.       (display (substring w 1 (string-length w)))))
  39.  
  40. (define (flame-print first x)
  41.   (if (not (null? x))
  42.       (begin
  43.     (let* ((w (symbol->string (car x))) (len (string-length w)))
  44.       ((if first capitalize display) w)
  45.       (set! pos (+ 1 pos len))
  46.       (if (not (null? (cdr x)))
  47.           (begin
  48.         (if (not (memq (cadr x) '(? \. \, s! ! s \'s -loving)))
  49.             (if (< pos margin)
  50.             (display " ")
  51.             (set! pos 0) (newline)))
  52.         (flame-print #f (cdr x))))))))
  53.  
  54. (define (choose class)
  55.   (list-ref class (modulo (random) (length class))))
  56.  
  57. (define (sentence) (choose sentences))
  58.  
  59. (define sentences
  60.   '((how can you say that (statement) ?)
  61.     (I can't believe how (adjective) you are.)
  62.     (only a (der-term) like you would say that (statement) \.)
  63.     ((statement) \, huh?) (so, (statement) ?)
  64.     ((statement) \, right?) (I mean, (sentence))
  65.     (don't you realise that (statement) ?)
  66.     (I firmly believe that (statement) \.)
  67.     (let me tell you something, you (der-term) \, (statement) \.)
  68.     (furthermore, you (der-term) \, (statement) \.)
  69.     (I couldn't care less about your (thing) \.)
  70.     (How can you be so (adjective) ?)
  71.     (you make me sick.)
  72.     (it's well known that (statement) \.)
  73.     ((statement) \.)
  74.     (it takes a (group-adj) (der-term) like you to say that (statement) \.)
  75.     (I don't want to hear about your (thing) \.)
  76.     (you're always totally wrong.)
  77.     (I've never heard anything as ridiculous as the idea that (statement) \.)
  78.     (you must be a real (der-term) to think that (statement) \.)
  79.     (you (adjective) (group-adj) (der-term) !)
  80.     (you're probably (group-adj) yourself.)
  81.     (you sound like a real (der-term) \.)
  82.     (why, (statement) !)
  83.     (I have many (group-adj) friends.)
  84.     (save the (thing) s!) (no nukes!) (ban (thing) s!)
  85.     (I'll bet you think that (thing) s are (adjective) \.)
  86.     (you know, (statement) \.)
  87.     (your (quality) reminds me of a (thing) \.)
  88.     (you have the (quality) of a (der-term) \.)
  89.     ((der-term) !)
  90.     ((adjective) (group-adj) (der-term) !)
  91.     (you're a typical (group-adj) person, totally (adjective) \.)
  92.     (man, (sentence))))
  93.  
  94. (define (quality) (choose qualities))
  95.  
  96. (define qualities
  97.   '((ignorance) (stupidity) (worthlessness)
  98.     (prejudice) (lack of intelligence) (lousiness)
  99.     (bad grammar) (lousy spelling)
  100.     (lack of common decency) (ugliness) (nastiness)
  101.     (subtlety) (dishonesty) ((adjective) (quality))))
  102.  
  103. (define (adjective) (choose adjectives))
  104.  
  105. (define adjectives
  106.   '((ignorant) (crass) (pathetic) (sick)
  107.     (bloated) (malignant) (perverted) (sadistic)
  108.     (stupid) (unpleasant) (lousy) (abusive) (bad)
  109.     (braindamaged) (selfish) (improper) (nasty)
  110.     (disgusting) (foul) (intolerable) (primitive)
  111.     (depressing) (dumb) (phoney)
  112.     ((adjective) and (adjective))
  113.     (as (adjective) as a (thing))))
  114.  
  115. (define (der-term) (choose der-terms))
  116.  
  117. (define der-terms
  118.   '(((adjective) (der-term)) (sexist) (fascist)
  119.     (weakling) (coward) (beast) (peasant) (racist)
  120.     (cretin) (fool) (jerk) (ignoramus) (idiot)
  121.     (wanker) (rat) (slimebag) (DAF driver)
  122.     (Neanderthal) (sadist) (drunk) (capitalist)
  123.     (wimp) (dogmatist) (wally) (maniac)
  124.     (whimpering scumbag) (pea brain) (arsehole)
  125.     (moron) (goof) (incompetant) (lunkhead) (Nazi)
  126.     (SysThug) ((der-term) (der-term))))
  127.  
  128. (define (thing) (choose things))
  129.  
  130. (define things
  131.   '(((adjective) (thing)) (computer)
  132.     (Honeywell DPS8) (whale) (operation)
  133.     (sexist joke) (ten-incher) (dog) (MicroVAX II)
  134.     (source license) (real-time clock)
  135.     (mental problem) (sexual fantasy)
  136.     (venereal disease) (Jewish grandmother)
  137.     (cardboard cut-out) (punk haircut) (surfboard)
  138.     (system call) (wood-burning stove)
  139.     (graphics editor) (right wing death squad)
  140.     (disease) (vegetable) (religion)
  141.     (cruise missile) (bug fix) (lawyer) (copyright)
  142.     (PAD)))
  143.  
  144. (define (group-adj) (choose group-adjs))
  145.  
  146. (define group-adjs
  147.   '((gay) (old) (lesbian) (young) (black)
  148.     (Polish) ((adjective)) (white)
  149.     (mentally retarded) (Nicaraguan) (homosexual)
  150.     (dead) (underpriviledged) (religious)
  151.     ((thing) -loving) (feminist) (foreign)
  152.     (intellectual) (crazy) (working) (unborn)
  153.     (Chinese) (short) ((adjective)) (poor) (rich)
  154.     (funny-looking) (Puerto Rican) (Mexican)
  155.     (Italian) (communist) (fascist) (Iranian)
  156.     (Moonie)))
  157.  
  158. (define (statement) (choose statements))
  159.  
  160. (define statements
  161.   '((your (thing) is great) ((thing) s are fun)
  162.     ((person) is a (der-term))
  163.     ((group-adj) people are (adjective))
  164.     (every (group-adj) person is a (der-term))
  165.     (most (group-adj) people have (thing) s)
  166.     (all (group-adj) dudes should get (thing) s)
  167.     ((person) is (group-adj)) (trees are (adjective))
  168.     (if you've seen one (thing) \, you've seen them all)
  169.     (you're (group-adj)) (you have a (thing))
  170.     (my (thing) is pretty good)
  171.     (the Martians are coming)
  172.     (the (paper) is always right)
  173.     (just because you read it in the (paper) that doesn't mean it's true)
  174.     ((person) was (group-adj))
  175.     ((person) \'s ghost is living in your (thing))
  176.     (you look like a (thing))
  177.     (the oceans are full of dirty fish)
  178.     (people are dying every day)
  179.     (a (group-adj) man ain't got nothing in the world these days)
  180.     (women are inherently superior to men)
  181.     (the system staff is fascist)
  182.     (there is life after death)
  183.     (the world is full of (der-term) s)
  184.     (you remind me of (person)) (technology is evil)
  185.     ((person) killed (person))
  186.     (the Russians are tapping your phone)
  187.     (the Earth is flat)
  188.     (it's OK to run down (group-adj) people)
  189.     (Multics is a really (adjective) operating system)
  190.     (the CIA killed (person))
  191.     (the sexual revolution is over)
  192.     (Lassie was (group-adj))
  193.     (the (group-adj) s have really got it all together)
  194.     (I was (person) in a previous life)
  195.     (breathing causes cancer)
  196.     (it's fun to be really (adjective))
  197.     ((quality) is pretty fun) (you're a (der-term))
  198.     (the (group-adj) culture is fascinating)
  199.     (when ya gotta go ya gotta go)
  200.     ((person) is (adjective))
  201.     ((person) \'s (quality) is (adjective))
  202.     (it's a wonderful day)
  203.     (everything is really a (thing))
  204.     (there's a (thing) in (person) \'s brain)
  205.     ((person) is a cool dude)
  206.     ((person) is just a figment of your imagination)
  207.     (the more (thing) s you have, the better)
  208.     (life is a (thing)) (life is (quality))
  209.     ((person) is (adjective))
  210.     ((group-adj) people are all (adjective) (der-term) s)
  211.     ((statement) \, and (statement))
  212.     ((statement) \, but (statement))
  213.     (I wish I had a (thing))
  214.     (you should have a (thing))
  215.     (you hope that (statement))
  216.     ((person) is secretly (group-adj))
  217.     (you wish you were (group-adj))
  218.     (you wish you were a (thing))
  219.     (I wish I were a (thing))
  220.     (you think that (statement))
  221.     ((statement) \, because (statement))
  222.     ((group-adj) people don't get married to (group-adj) people because (reason))
  223.     ((group-adj) people are all (adjective) because (reason))
  224.     ((group-adj) people are (adjective) \, and (reason))
  225.     (you must be a (adjective) (der-term) to think that (person) said (statement))
  226.     ((group-adj) people are inherently superior to (group-adj) people)
  227.     (God is Dead)))
  228.  
  229. (define (paper) (choose papers))
  230.  
  231. (define papers
  232.   '((Daily Mail) (Daily Express)
  233.     (Centre Bulletin) (Sun) (Daily Mirror)
  234.     (Daily Telegraph) (Beano) (Multics Manual)))
  235.  
  236. (define (person) (choose persons))
  237.  
  238. (define persons
  239.   '((Reagan) (Ken Thompson) (Dennis Ritchie)
  240.     (JFK) (the Pope) (Gadaffi) (Napoleon)
  241.     (Karl Marx) (Groucho) (Michael Jackson)
  242.     (Caesar) (Nietzsche) (Heidegger)
  243.     (Henry Kissinger) (Nixon) (Castro) (Thatcher)
  244.     (Attilla the Hun) (Alaric the Visigoth) (Hitler)))
  245.  
  246. (define (reason) (choose reasons))
  247.  
  248. (define reasons
  249.   '((they don't want their children to grow up to be too lazy to steal)
  250.     (they can't tell them apart from (group-adj) dudes)
  251.     (they're too (adjective))
  252.     ((person) wouldn't have done it)
  253.     (they can't spray paint that small)
  254.     (they don't have (thing) s) (they don't know how)
  255.     (they can't afford (thing) s)))
  256. )
  257.  
  258. (flame 15)
  259.