Here's something I threw together in a matter of a few minutes. It's not polished or cute but it does something I thought was amusing, and it shows how to draw something. Unfortunately, the code uses an unreleased library, Vectometry, for a lot of things, but I hope it's interesting as an example of a quick off-the-cuff drawing program. Once the program worked, I didn't go back and clean anything up or factor anything out, I'm just posting it as-is.
The general idea is simple enough. I saw a "BABY ON BOARD!" sign
somewhere and said to myself, "Hey, that's Futura
Bold Extra Black Condensed. I
should draw one of those with Vecto." Here's the result:
Here's the Lisp code ("bob" is "baby on board"):
;;;; bob.lisp (defpackage #:bob (:use #:cl #:vectometry)) (in-package #:bob) (defvar *font* (zpb-ttf:open-font-loader "font.ttf")) (defun words-bounding-box (size words) (let* ((em (zpb-ttf:units/em *font*)) (scale (/ size em))) (let ((height (* size (length words))) (box (string-bounding-box (first words) size *font*))) (dolist (string (rest words)) (setf box (combine box (string-bounding-box string size *font*)))) (box (xmin box) (ymin box) (xmax box) height)))) (defclass diamond () ((north :initarg :north :accessor north) (south :initarg :south :accessor south) (east :initarg :east :accessor east) (west :initarg :west :accessor west))) (defmethod bounding-box ((diamond diamond)) (box (x (west diamond)) (y (south diamond)) (x (east diamond)) (y (north diamond)))) (defun enclosing-diamond (box) (let* ((center (centerpoint box)) (length (+ (/ (width box) 2) (/ (height box) 2))) (v (point 0 length)) (h (point length 0))) (make-instance 'diamond :north (add center v) :south (sub center v) :east (add center h) :west (sub center h)))) (defun edge-length (diamond) (distance (north diamond) (east diamond))) (defmethod centerpoint ((diamond diamond)) (midpoint (north diamond) (south diamond))) (defun sign (size words file) (let* ((box (words-bounding-box size words)) (min (add (ypoint (* size 1/6)) (neg (minpoint box)))) (center (centerpoint box)) (k1 (* size 1/8)) (k2 (* size 1/5))) (setf box (displace box (neg center))) (let* ((diamond (enclosing-diamond (expand box k2))) (edge (edge-length diamond))) (with-box-canvas (expand (bounding-box diamond) k2) (with-graphics-state (rotate-degrees 45) (let* ((halfedge (/ edge 2)) (b1 (box (- halfedge) (- halfedge) halfedge halfedge))) (rectangle (expand b1 k1)) (set-fill-color (hsv-color 60 1 1)) (fill-path) (rounded-rectangle b1 k2 k2) (set-line-width k1) (stroke))) (set-fill-color *black*) (set-font *font* size) (let ((p (add (minpoint box) (xpoint (/ (width box) 2))))) (dolist (word (reverse words)) (draw-centered-string (add min p) word) (setf p (add p (point 0 size))))) (save-png file))))) ;; * (sign 48 '("CTHULHU" "ON" "BOARD!") "/tmp/cthulhu.png") ;; #P"/tmp/cthulhu.png"