Colored and rotated text in LispWorks

random-text.lisp

(defun random-text (string &key (n 300) (color-filter nil))
  (flet ((one-of (list)
           (elt list (random (length list))))
         (filter-colors (colors string)
           (loop for color in colors
                 when (search string (symbol-name color) :test #'equalp)
                 collect color)))
    (let* ((s (make-instance 'capi:output-pane))
           (colors (color:get-all-color-names)))
      (capi:contain s :width 2000 :height 1400)
      (loop repeat n
            do (let ((font (gp:find-best-font
                            s
                            (gp:make-font-description
                             :family (one-of '("Times" "Helvetica" "Courier"))
                             :size   (one-of (mapcar (lambda (x)
                                                       (* x 8))
                                                     '(12 14 16 18 20 24 28 36 48)))
                             :weight (one-of '(:medium :normal :bold))
                             :slant  (one-of '(:roman :italic))))))
                 (gp:with-graphics-state (s :font font
                                            :foreground (if color-filter
                                                            (one-of
                                                             (filter-colors colors
                                                                            color-filter))
                                                          (one-of colors)))
                   (gp:with-graphics-rotation (s (random 360))
                     (gp:draw-string s
                                     string
                                     (+ 100 (random 2000))
                                     (+ 100 (random 1300))))))))))

(random-text "LispWorks")

; http://yfrog.com/z/nwc4ovwp