source: trunk/example/steel-bazooka.lisp

Last change on this file was 110, checked in by lisppaste, 19 years ago

For bmastenbrook: Steel Bazooka Common Lisp!

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.0 KB
Line 
1(defpackage :steel-bazooka (:use :cl) (:export :steel-whatever))
2(in-package :steel-bazooka)
3
4(defparameter *words* nil)
5
6(defun read-words ()
7  (loop for char = #\a then (code-char (1+ (char-code char)))
8       while (char<= char #\z)
9       do (push (cons char (make-array '(0) :adjustable t :fill-pointer 0 :element-type 'string)) *words*))
10  (with-open-file (f (merge-pathnames "words"
11                                      (make-pathname :directory (pathname-directory
12                                                                 (load-time-value *load-truename*)))) :direction :input)
13    (loop for line = (read-line f nil nil)
14         while line
15       if (> (length line) 2)
16       do (if (char<= #\a (elt line 0) #\z)
17              (vector-push-extend line (cdr (assoc (elt line 0) *words* :test #'eql)))))))
18
19(defun random-elt (seq)
20  (elt seq (random (length seq))))
21
22(defun steel-whatever (&key (letters "sb") (suffix " Common Lisp"))
23  (format nil "~:(~{~A~^ ~}~)~A"
24          (map 'list
25               (lambda (letter)
26                 (random-elt (cdr (assoc letter *words* :test #'eql))))
27               letters)
28          (if suffix suffix "")))
29
30(read-words)
Note: See TracBrowser for help on using the repository browser.