doc/illustrations.lisp

   1 ;;;; $Id: illustrations.lisp,v 1.6 2007/10/01 16:24:10 xach Exp $
   2
   3 (defpackage #:vecto-illustrations
   4   (:use #:cl #:vecto))
   5
   6 (in-package #:vecto-illustrations)
   7
   8 (defun x (point)
   9   (car point))
  10
  11 (defun y (point)
  12   (cdr point))
  13
  14 (defun annotated-path (&rest points)
  15   (with-graphics-state
  16     (set-rgb-stroke 0.5 0.5 0.5)
  17     (set-rgb-fill 0.5 0.5 0.5)
  18     (set-line-width 2)
  19     (dolist (point (remove-duplicates points :test 'equal))
  20       (centered-circle-path (x point) (y point) 3))
  21     (fill-path)
  22     (move-to (x (first points)) (y (first points)))
  23     (dolist (point (rest points))
  24       (line-to (x point) (y point)))
  25     (stroke)))
  26
  27
  28 (defun join-style (style file)
  29   (with-canvas (:width 160 :height 165)
  30     (set-rgb-fill 1 1 1)
  31     (clear-canvas)
  32     (set-rgb-stroke 0 0 0)
  33     (set-line-width 20)
  34     (move-to 20 20)
  35     (line-to 80 140)
  36     (line-to 140 20)
  37     (set-line-join style)
  38     (stroke)
  39     (annotated-path '(20 . 20)
  40                     '(80 . 140)
  41                     '(140 . 20))
  42     (save-png file)))
  43
  44
  45 (defun cap-style (style file)
  46   (with-canvas (:width 40 :height 100)
  47     (set-rgb-fill 1 1 1)
  48     (clear-canvas)
  49     (set-rgb-stroke 0 0 0)
  50     (set-line-width 20)
  51     (move-to 20 20)
  52     (line-to 20 80)
  53     (set-line-cap style)
  54     (stroke)
  55     (annotated-path '(20 . 20) '(20 . 80))
  56     (save-png file)))
  57
  58
  59
  60 (defun closed-subpaths (closep file)
  61   (with-canvas (:width 160 :height 160)
  62     (set-rgb-fill 1 1 1)
  63     (clear-canvas)
  64     (set-rgb-stroke 0 0 0)
  65     (set-line-width 20)
  66     (move-to 20 20)
  67     (line-to 20 140)
  68     (line-to 140 140)
  69     (line-to 140 20)
  70     (line-to 20 20)
  71     (when closep
  72       (close-subpath))
  73     (stroke)
  74     (annotated-path '(20 . 20)
  75                     '(20 . 140)
  76                     '(140 . 140)
  77                     '(140 . 20)
  78                     '(20 . 20))
  79     (save-png file)))
  80
  81 (defun dash-paths (array phase cap-style file)
  82   (with-canvas (:width 160 :height 40)
  83     (set-rgb-fill 1 1 1)
  84     (clear-canvas)
  85     (set-rgb-stroke 0 0 0)
  86     (set-line-width 20)
  87     (with-graphics-state
  88       (set-dash-pattern array phase)
  89       (set-line-cap cap-style)
  90       (move-to 20 20)
  91       (line-to 140 20)
  92       (stroke))
  93     (annotated-path '(20 . 20) '(140 . 20))
  94     (save-png file)))
  95
  96
  97 (defun simple-clipping-path (file &key clip-circle clip-rounded-rectangle)
  98   (with-canvas (:width 100 :height 100)
  99     (let ((x0 45)
 100           (y 45)
 101           (r 40))
 102       (set-rgb-fill 1 1 1)
 103       (clear-canvas)
 104       (with-graphics-state
 105         (set-rgb-fill 0.9 0.9 0.9)
 106         (rectangle 10 10 80 80)
 107         (fill-path))
 108       (with-graphics-state
 109         (when clip-circle
 110           (centered-circle-path x0 y r)
 111           (clip-path)
 112           (end-path-no-op))
 113         (when clip-rounded-rectangle
 114           (rounded-rectangle 45 25 50 50 10 10)
 115           (clip-path)
 116           (end-path-no-op))
 117         (set-rgb-fill 1 0 0)
 118         (set-rgb-stroke 1 1 0)
 119         (rectangle 10 10 80 80)
 120         (fill-path))
 121       (when clip-circle
 122         (with-graphics-state
 123           (set-rgb-stroke 0.5 0.5 0.5)
 124           (set-dash-pattern #(5) 0)
 125           (set-line-width 1)
 126           (centered-circle-path x0 y r)
 127           (stroke)))
 128       (when clip-rounded-rectangle
 129         (with-graphics-state
 130           (set-rgb-stroke 0.5 0.5 0.5)
 131           (set-dash-pattern #(5) 0)
 132           (set-line-width 1)
 133           (rounded-rectangle 45 25 50 50 10 10)
 134           (stroke)))
 135       (save-png file))))
 136
 137
 138 (defun make-illustrations ()
 139   (cap-style :butt "cap-style-butt.png")
 140   (cap-style :square "cap-style-square.png")
 141   (cap-style :round "cap-style-round.png")
 142   (join-style :miter "join-style-miter.png")
 143   (join-style :bevel "join-style-bevel.png")
 144   (join-style :round "join-style-round.png")
 145   (closed-subpaths nil "open-subpath.png")
 146   (closed-subpaths t "closed-subpath.png")
 147   (dash-paths #() 0 :butt "dash-pattern-none.png")
 148   (dash-paths #(30 30) 0 :butt "dash-pattern-a.png")
 149   (dash-paths #(30 30) 15 :butt "dash-pattern-b.png")
 150   (dash-paths #(10 20 10 40) 0 :butt "dash-pattern-c.png")
 151   (dash-paths #(10 20 10 40) 13 :butt "dash-pattern-d.png")
 152   (dash-paths #(30 30) 0 :round "dash-pattern-e.png")
 153   (simple-clipping-path "clip-unclipped.png")
 154   (simple-clipping-path "clip-to-circle.png" :clip-circle t)
 155   (simple-clipping-path "clip-to-rectangle.png" :clip-rounded-rectangle t)
 156   (simple-clipping-path "clip-to-both.png"
 157                         :clip-circle t
 158                         :clip-rounded-rectangle t))