[bknr-cvs] r2219 - in branches/trunk-reorg/thirdparty: . vecto-1.0.2 vecto-1.0.2/doc

bknr at bknr.net bknr at bknr.net
Fri Oct 5 06:02:37 UTC 2007


Author: hhubner
Date: 2007-10-05 02:02:33 -0400 (Fri, 05 Oct 2007)
New Revision: 2219

Added:
   branches/trunk-reorg/thirdparty/vecto-1.0.2/
   branches/trunk-reorg/thirdparty/vecto-1.0.2/LICENSE
   branches/trunk-reorg/thirdparty/vecto-1.0.2/clipping-paths.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/color.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/copy.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/background.gif
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-butt.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-round.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-square.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-both.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-circle.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-rectangle.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-unclipped.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/closed-subpath.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-a.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-b.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-c.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-d.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-e.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-none.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/examples.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/feedlike-icon.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/illustrations.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/index.html
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-bevel.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-miter.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-round.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/lambda-example.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/open-subpath.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/star-clipping.png
   branches/trunk-reorg/thirdparty/vecto-1.0.2/drawing.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/graphics-state.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/package.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/paths.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/test.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/text.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/transform-matrix.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/user-drawing.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/user-shortcuts.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/utils.lisp
   branches/trunk-reorg/thirdparty/vecto-1.0.2/vecto.asd
Log:
update vecto (now really)

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/LICENSE
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/LICENSE	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/LICENSE	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,25 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/clipping-paths.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/clipping-paths.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/clipping-paths.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,120 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: clipping-paths.lisp,v 1.2 2007/10/01 16:25:48 xach Exp $
+
+(in-package #:vecto)
+
+;;; Clipping paths are represented as a grayscale channel against
+;;; which drawing operations are masked; it's intersected with the
+;;; alpha channel. They are part of the graphics state that are saved
+;;; and restored by WITH-GRAPHICS-STATE. However, there's no reason to
+;;; pay a channel copying penalty if the clipping path is not
+;;; modified, or pay a data creation/drawing penalty if the clipping
+;;; path is empty.
+;;;
+;;; This is implemented by making WRITABLE-CLIPPING-DATA the method to
+;;; obtain the data of a clipping path; it will create data for an
+;;; empty clipping path, and copy data for a clipping path in a
+;;; temporary graphics state. If WRITABLE-CLIPPING-DATA is never
+;;; called, no mask will be created, and drawing operations won't
+;;; bother consulting the clipping path.
+;;;
+;;; TODO: Store a bounding box with a clipping path, so drawing can be
+;;; limited to the clipping path area when possible.
+
+(defclass clipping-path ()
+  ((height
+    :initarg :height
+    :accessor height)
+   (width
+    :initarg :width
+    :accessor width)
+   (data
+    :initarg :data
+    :accessor data)
+   (scratch
+    :initarg :scratch
+    :accessor scratch
+    :documentation "A temporary channel used to store the new clipping
+    path to intersect with the old one.")))
+
+(defclass empty-clipping-path (clipping-path) ())
+
+(defclass proxy-clipping-path (clipping-path) ())
+
+(defmethod print-object ((clipping-path clipping-path) stream)
+  (print-unreadable-object (clipping-path stream :type t :identity t)
+    (format stream "~Dx~D" (width clipping-path) (height clipping-path))))
+
+(defmethod copy ((clipping-path clipping-path))
+  (make-instance 'proxy-clipping-path
+                 :data (data clipping-path)
+                 :scratch (scratch clipping-path)
+                 :height (height clipping-path)
+                 :width (width clipping-path)))
+
+(defmethod copy ((clipping-path empty-clipping-path))
+  (make-instance 'empty-clipping-path
+                 :height (height clipping-path)
+                 :width (width clipping-path)))
+
+(defgeneric emptyp (object)
+  (:method (object)
+    nil)
+  (:method ((object empty-clipping-path))
+    t))
+
+(defun make-clipping-channel (width height initial-element)
+  (make-array (* width height)
+              :element-type '(unsigned-byte 8)
+              :initial-element initial-element))
+
+(defgeneric clipping-data (object)
+  (:method ((clipping-path clipping-path))
+    (data clipping-path))
+  (:method ((clipping-path empty-clipping-path))
+    nil))
+
+(defgeneric writable-clipping-data (object)
+  (:method ((clipping-path clipping-path))
+    (data clipping-path))
+  (:method ((clipping-path empty-clipping-path))
+    (let* ((width (width clipping-path))
+           (height (height clipping-path))
+           (data (make-clipping-channel width height #xFF))
+           (scratch (make-clipping-channel width height #x00)))
+      (change-class clipping-path 'clipping-path
+                    :data data
+                    :scratch scratch)
+      data))
+  (:method ((clipping-path proxy-clipping-path))
+    (let ((data (copy-seq (data clipping-path))))
+      (change-class clipping-path 'clipping-path :data data)
+      data)))
+
+(defun make-clipping-path (width height)
+  (make-instance 'empty-clipping-path :width width :height height))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/color.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/color.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/color.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,54 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: color.lisp,v 1.3 2007/09/20 17:42:03 xach Exp $
+
+(in-package #:vecto)
+
+(defclass color () ())
+
+(defclass rgba-color (color)
+  ((red
+    :initarg :red
+    :accessor red)
+   (green
+    :initarg :green
+    :accessor green)
+   (blue
+    :initarg :blue
+    :accessor blue)
+   (alpha
+    :initarg :alpha
+    :accessor alpha))
+  (:default-initargs
+   :red 0.0 :green 0.0 :blue 0.0 :alpha 1.0))
+
+(defmethod copy ((color rgba-color))
+  (make-instance 'rgba-color
+                 :red (red color)
+                 :green (green color)
+                 :blue (blue color)
+                 :alpha (alpha color)))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/copy.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/copy.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/copy.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,36 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: copy.lisp,v 1.2 2007/09/20 18:00:37 xach Exp $
+
+(in-package #:vecto)
+
+(defgeneric copy (object)
+  (:documentation
+   "Copy an object in a way suitable for pushing to the graphics state
+  stack. That is, if it's an immutable object, simply return the
+  object; otherwise, create a new object with the immutable state
+  copied."))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/background.gif
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/background.gif
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-butt.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-butt.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-round.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-round.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-square.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/cap-style-square.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-both.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-both.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-circle.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-circle.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-rectangle.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-to-rectangle.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-unclipped.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/clip-unclipped.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/closed-subpath.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/closed-subpath.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-a.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-a.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-b.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-b.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-c.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-c.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-d.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-d.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-e.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-e.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-none.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/dash-pattern-none.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/examples.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/examples.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/examples.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,97 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: examples.lisp,v 1.4 2007/10/01 19:57:15 xach Exp $
+
+(defpackage #:vecto-examples
+  (:use #:cl #:vecto))
+
+(in-package #:vecto-examples)
+
+(defun radiant-lambda (file)
+  (with-canvas (:width 90 :height 90)
+    (let ((font (get-font "times.ttf"))
+          (step (/ pi 7)))
+      (set-font font 40)
+      (translate 45 45)
+      (draw-centered-string 0 -10 #(#x3BB))
+      (set-rgb-stroke 1 0 0)
+      (centered-circle-path 0 0 35)
+      (stroke)
+      (set-rgba-stroke 0 0 1.0 0.5)
+      (set-line-width 4)
+      (dotimes (i 14)
+        (with-graphics-state
+          (rotate (* i step))
+          (move-to 30 0)
+          (line-to 40 0)
+          (stroke)))
+      (save-png file))))
+
+(defun feedlike-icon (file)
+  (with-canvas (:width 100 :height 100)
+    (set-rgb-fill 1.0 0.65 0.3)
+    (rounded-rectangle 0 0 100 100 10 10)
+    (fill-path)
+    (set-rgb-fill 1.0 1.0 1.0)
+    (centered-circle-path 20 20 10)
+    (fill-path)
+    (flet ((quarter-circle (x y radius)
+             (let ((kappa (* +kappa+ radius)))
+               (move-to (+ x radius) y)
+               (curve-to (+ x radius) (+ y kappa)
+                         (+ x kappa) (+ y radius)
+                         x (+ y radius)))))
+      (set-rgb-stroke 1.0 1.0 1.0)
+      (set-line-width 15)
+      (quarter-circle 20 20 30)
+      (stroke)
+      (quarter-circle 20 20 60)
+      (stroke))
+    (save-png file)))
+
+(defun star-clipping (file)
+  (with-canvas (:width 200 :height 200)
+    (let ((size 100)
+          (angle 0)
+          (step (* 2 (/ (* pi 2) 5))))
+      (translate size size)
+      (move-to 0 size)
+      (dotimes (i 5)
+        (setf angle (+ angle step))
+        (line-to (* (sin angle) size)
+                 (* (cos angle) size)))
+      (even-odd-clip-path)
+      (end-path-no-op)
+      (flet ((circle (distance)
+               (set-rgba-fill distance 0 0
+                              (- 1.0 distance))
+               (centered-circle-path 0 0 (* size distance))
+               (fill-path)))
+        (loop for i downfrom 1.0 by 0.05
+              repeat 20 do
+              (circle i)))
+      (save-png file))))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/feedlike-icon.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/feedlike-icon.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/illustrations.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/illustrations.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/illustrations.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,158 @@
+;;;; $Id: illustrations.lisp,v 1.6 2007/10/01 16:24:10 xach Exp $
+
+(defpackage #:vecto-illustrations
+  (:use #:cl #:vecto))
+
+(in-package #:vecto-illustrations)
+
+(defun x (point)
+  (car point))
+
+(defun y (point)
+  (cdr point))
+
+(defun annotated-path (&rest points)
+  (with-graphics-state
+    (set-rgb-stroke 0.5 0.5 0.5)
+    (set-rgb-fill 0.5 0.5 0.5)
+    (set-line-width 2)
+    (dolist (point (remove-duplicates points :test 'equal))
+      (centered-circle-path (x point) (y point) 3))
+    (fill-path)
+    (move-to (x (first points)) (y (first points)))
+    (dolist (point (rest points))
+      (line-to (x point) (y point)))
+    (stroke)))
+
+
+(defun join-style (style file)
+  (with-canvas (:width 160 :height 165)
+    (set-rgb-fill 1 1 1)
+    (clear-canvas)
+    (set-rgb-stroke 0 0 0)
+    (set-line-width 20)
+    (move-to 20 20)
+    (line-to 80 140)
+    (line-to 140 20)
+    (set-line-join style)
+    (stroke)
+    (annotated-path '(20 . 20)
+                    '(80 . 140)
+                    '(140 . 20))
+    (save-png file)))
+
+
+(defun cap-style (style file)
+  (with-canvas (:width 40 :height 100)
+    (set-rgb-fill 1 1 1)
+    (clear-canvas)
+    (set-rgb-stroke 0 0 0)
+    (set-line-width 20)
+    (move-to 20 20)
+    (line-to 20 80)
+    (set-line-cap style)
+    (stroke)
+    (annotated-path '(20 . 20) '(20 . 80))
+    (save-png file)))
+
+
+
+(defun closed-subpaths (closep file)
+  (with-canvas (:width 160 :height 160)
+    (set-rgb-fill 1 1 1)
+    (clear-canvas)
+    (set-rgb-stroke 0 0 0)
+    (set-line-width 20)
+    (move-to 20 20)
+    (line-to 20 140)
+    (line-to 140 140)
+    (line-to 140 20)
+    (line-to 20 20)
+    (when closep
+      (close-subpath))
+    (stroke)
+    (annotated-path '(20 . 20)
+                    '(20 . 140)
+                    '(140 . 140)
+                    '(140 . 20)
+                    '(20 . 20))
+    (save-png file)))
+
+(defun dash-paths (array phase cap-style file)
+  (with-canvas (:width 160 :height 40)
+    (set-rgb-fill 1 1 1)
+    (clear-canvas)
+    (set-rgb-stroke 0 0 0)
+    (set-line-width 20)
+    (with-graphics-state
+      (set-dash-pattern array phase)
+      (set-line-cap cap-style)
+      (move-to 20 20)
+      (line-to 140 20)
+      (stroke))
+    (annotated-path '(20 . 20) '(140 . 20))
+    (save-png file)))
+  
+
+(defun simple-clipping-path (file &key clip-circle clip-rounded-rectangle)
+  (with-canvas (:width 100 :height 100)
+    (let ((x0 45)
+          (y 45)
+          (r 40))
+      (set-rgb-fill 1 1 1)
+      (clear-canvas)
+      (with-graphics-state
+        (set-rgb-fill 0.9 0.9 0.9)
+        (rectangle 10 10 80 80)
+        (fill-path))
+      (with-graphics-state
+        (when clip-circle
+          (centered-circle-path x0 y r)
+          (clip-path)
+          (end-path-no-op))
+        (when clip-rounded-rectangle
+          (rounded-rectangle 45 25 50 50 10 10) 
+          (clip-path)
+          (end-path-no-op))
+        (set-rgb-fill 1 0 0)
+        (set-rgb-stroke 1 1 0)
+        (rectangle 10 10 80 80)
+        (fill-path))
+      (when clip-circle
+        (with-graphics-state
+          (set-rgb-stroke 0.5 0.5 0.5)
+          (set-dash-pattern #(5) 0)
+          (set-line-width 1)
+          (centered-circle-path x0 y r)
+          (stroke)))
+      (when clip-rounded-rectangle
+        (with-graphics-state
+          (set-rgb-stroke 0.5 0.5 0.5)
+          (set-dash-pattern #(5) 0)
+          (set-line-width 1)
+          (rounded-rectangle 45 25 50 50 10 10) 
+          (stroke)))
+      (save-png file))))
+  
+
+(defun make-illustrations ()
+  (cap-style :butt "cap-style-butt.png")
+  (cap-style :square "cap-style-square.png")
+  (cap-style :round "cap-style-round.png")
+  (join-style :miter "join-style-miter.png")
+  (join-style :bevel "join-style-bevel.png")
+  (join-style :round "join-style-round.png")
+  (closed-subpaths nil "open-subpath.png")
+  (closed-subpaths t "closed-subpath.png")
+  (dash-paths #() 0 :butt "dash-pattern-none.png")
+  (dash-paths #(30 30) 0 :butt "dash-pattern-a.png")
+  (dash-paths #(30 30) 15 :butt "dash-pattern-b.png")
+  (dash-paths #(10 20 10 40) 0 :butt "dash-pattern-c.png")
+  (dash-paths #(10 20 10 40) 13 :butt "dash-pattern-d.png")
+  (dash-paths #(30 30) 0 :round "dash-pattern-e.png")
+  (simple-clipping-path "clip-unclipped.png")
+  (simple-clipping-path "clip-to-circle.png" :clip-circle t)
+  (simple-clipping-path "clip-to-rectangle.png" :clip-rounded-rectangle t)
+  (simple-clipping-path "clip-to-both.png"
+                        :clip-circle t
+                        :clip-rounded-rectangle t))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/index.html
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/index.html	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/index.html	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,855 @@
+<html>
+<head>
+<title>Vecto - Simple Vector Drawing with Common Lisp</title>
+<style type="text/css">
+  a, a:visited { text-decoration: none }
+  a[href]:hover { text-decoration: underline }
+  pre { background: #DDD; padding: 0.25em }
+  p.download { color: red }
+  .transparent { background-image: url(background.gif) }
+</style>
+</head>
+
+<body>
+
+<h2>Vecto - Simple Vector Drawing with Common Lisp</h2>
+
+<blockquote class='abstract'>
+<h3>Abstract</h3>
+
+<p>Vecto is a simplified interface to the
+powerful <a href="http://projects.tuxee.net/cl-vectors/">CL-VECTORS</a>
+vector rasterization library. It presents a function-oriented
+interface similar to <a href="http://www.cliki.net/CL-PDF">CL-PDF</a>,
+but the results can be saved to a PNG instead of a PDF file. Since
+Vecto and all supporting libraries are written completely in Common
+Lisp, without depending on external non-Lisp libraries, it should work
+in any Common Lisp environment. Vecto is available under a BSD-like
+license. The current version is 1.0.2, released on October 1st,
+2007.
+
+<p>Vecto is used by <a href="http://wigflip.com/easystreet/">Easystreet</a>.
+
+<p>The canonical location for Vecto
+is <a href="http://www.xach.com/lisp/vecto/">http://www.xach.com/lisp/vecto/</a>.
+
+<p class='download'>Download shortcut:</p>
+
+<p><a href="http://www.xach.com/lisp/vecto.tgz">http://www.xach.com/lisp/vecto.tgz</a>
+
+</blockquote>
+
+<h3>Contents</h3>
+
+<ol>
+<li> <a href='#sect-overview-and-limitations'>Overview and Limitations</a>
+<li> <a href='#sect-examples'>Examples</a>
+<li> <a href='#sect-dictionary'>Dictionary</a>
+
+<ul>
+  <li> <a href='#sect-canvases'>Canvases</a>
+    <ul>
+      <li> <a href='#with-canvas'><tt>with-canvas</tt></a>
+      <li> <a href='#clear-canvas'><tt>clear-canvas</tt></a>
+      <li> <a href='#save-png'><tt>save-png</tt></a>
+      <li> <a href='#save-png-stream'><tt>save-png-stream</tt></a>
+    </ul>
+
+  <li> <a href='#sect-graphics-state'>Graphics State</a>
+    <ul>
+      <li> <a href='#with-graphics-state'><tt>with-graphics-state</tt></a>
+      <li> <a href='#set-rgba-fill'><tt>set-rgba-fill</tt></a>
+      <li> <a href='#set-rgba-fill'><tt>set-rgb-fill</tt></a>
+      <li> <a href='#set-rgba-stroke'><tt>set-rgba-stroke</tt></a>
+      <li> <a href='#set-rgba-stroke'><tt>set-rgb-stroke</tt></a>
+      <li> <a href='#set-line-cap'><tt>set-line-cap</tt></a>
+      <li> <a href='#set-line-join'><tt>set-line-join</tt></a>
+      <li> <a href='#set-line-width'><tt>set-line-width</tt></a>
+      <li> <a href='#set-dash-pattern'><tt>set-dash-pattern</tt></a>
+      <li> <a href='#translate'><tt>translate</tt></a>
+      <li> <a href='#rotate'><tt>rotate</tt></a>
+      <li> <a href='#scale'><tt>scale</tt></a>
+      <li> <a href='#skew'><tt>skew</tt></a>
+      <li> <a href='#clip-path'><tt>clip-path</tt></a>
+      <li> <a href='#even-odd-clip-path'><tt>even-odd-clip-path</tt></a>
+    </ul>
+
+  <li> <a href='#sect-paths'>Paths</a>
+    <ul>
+      <li> <a href='#move-to'><tt>move-to</tt></a>
+      <li> <a href='#line-to'><tt>line-to</tt></a>
+      <li> <a href='#curve-to'><tt>curve-to</tt></a>
+      <li> <a href='#quadratic-to'><tt>quadratic-to</tt></a>
+      <li> <a href='#close-subpath'><tt>close-subpath</tt></a>
+      <li> <a href='#rectangle'><tt>rectangle</tt></a>
+      <li> <a href='#centered-ellipse-path'><tt>centered-ellipse-path</tt></a>
+      <li> <a href='#centered-circle-path'><tt>centered-circle-path</tt></a>
+    </ul>
+
+  <li> <a href='#sect-painting'>Painting</a>
+    <ul>
+      <li> <a href='#fill-path'><tt>fill-path</tt></a>
+      <li> <a href='#even-odd-fill'><tt>even-odd-fill</tt></a>
+      <li> <a href='#stroke'><tt>stroke</tt></a>
+      <li> <a href='#fill-and-stroke'><tt>fill-and-stroke</tt></a>
+      <li> <a href='#even-odd-fill-and-stroke'><tt>even-odd-fill-and-stroke</tt></a>
+      <li> <a href='#end-path-no-op'><tt>end-path-no-op</tt></a>
+    </ul>
+
+  <li> <a href='#sect-text'>Text</a>
+    <ul>
+      <li> <a href='#get-font'><tt>get-font</tt></a>
+      <li> <a href='#set-font'><tt>set-font</tt></a>
+      <li> <a href='#draw-string'><tt>draw-string</tt></a>
+      <li> <a href='#draw-centered-string'><tt>draw-centered-string</tt></a>
+      <li> <a href='#string-bounding-box'><tt>string-bounding-box</tt></a>
+    </ul>
+
+  <li> <a href='#sect-miscellaneous'>Miscellaneous</a>
+    <ul>
+      <li> <a href='#const-kappa'><tt>+kappa+</tt></a>
+    </ul>
+
+</ul>
+
+<li> <a href='#sect-references'>References</a>
+<li> <a href='#sect-feedback'>Feedback</a>
+
+</ol>
+
+<a name='sect-overview-and-limitations'><h3>Overview and Limitations</h3></a>
+
+<p>Vecto is a library that provides a simple interface to the
+the <a href="http://projects.tuxee.net/cl-vectors/">CL-VECTORS</a>
+vector drawing library. It supports drawing on a canvas and saving the
+results to a PNG file. 
+
+<p>Vecto depends on the following libraries:
+
+<ul>
+<li> <a href="http://projects.tuxee.net/cl-vectors/">CL-VECTORS</a>
+<li> <a href="http://www.xach.com/lisp/zpb-ttf/">ZPB-TTF</a>
+<li> <a href="http://www.cliki.net/salza">Salza</a>
+<li> <a href="http://www.cliki.net/salza-png">Salza-PNG</a>
+</ul>
+
+<p>The easiest way to install Vecto and all its dependencies is
+with <a href="http://www.cliki.net/asdf-install">ASDF-Install</a>.
+
+<p>Vecto's function interface is similar to the
+PDF vector description and painting interface: you create images by
+describing vector paths, then using stroke or fill operations to paint
+to the canvas.
+
+<p>Vecto's color system uses red, green, blue, and alpha color
+components for drawing. The results can be be saved to a PNG with an
+alpha channel.
+
+<p>Vecto's coordinate system starts at the lower-left corner of the
+image, and increases rightwards along the X axis and upwards along the
+Y axis.
+
+<p>All measurements are in pixels.
+
+<p>PDF is a feature-rich system. Vecto supports a small subset of
+PDF-style operations. In particular, it does not support:
+
+<ul>
+<li> sampled images
+<li> pattern, gradient, or functional fill
+<li> complex layout of text
+<li> PostScript fonts
+<li> non-RGB color spaces
+</ul>
+
+<p>Other limitations:
+
+<ul>
+<li> No output formats other than 8-bit, truecolor-alpha PNGs
+<li> No access to underlying pixel data
+</ul>
+
+<p>Related libraries:
+
+<ul>
+  <li> <a href="http://common-lisp.net/project/imago/">Imago</a>
+    
+  <li> <a href="http://cyrusharmon.org/projects?project=ch-image">ch-image</a>
+
+  <li> <a href="http://ygingras.net/poly-pen">Poly-pen</a>
+</ul>
+
+
+<a name='sect-examples'><h3>Examples</h3></a>
+
+<p>All examples are available in <tt>doc/examples.lisp</tt> in the Vecto
+distribution. That file starts with:
+
+<pre>
+(defpackage #:vecto-examples
+  (:use #:cl #:vecto))
+
+(in-package #:vecto-examples)
+</pre>
+
+
+<pre>
+<img border=0 align=right src='lambda-example.png'
+>(defun radiant-lambda (file)
+  (<a href='#with-canvas'>with-canvas</a> (:width 90 :height 90)
+    (let ((font (<a href='#get-font'>get-font</a> "times.ttf"))
+          (step (/ pi 7)))
+      (<a href='#set-font'>set-font</a> font 40)
+      (<a href='#translate'>translate</a> 45 45)
+      (<a href='#draw-centered-string'>draw-centered-string</a> 0 -10 #(#x3BB))
+      (<a href='#set-rgb-stroke'>set-rgb-stroke</a> 1 0 0)
+      (<a href='#centered-circle-path'>centered-circle-path</a> 0 0 35)
+      (<a href='#stroke'>stroke</a>)
+      (<a href='#set-rgba-stroke'>set-rgba-stroke</a> 0 0 1.0 0.5)
+      (<a href='#set-line-width'>set-line-width</a> 4)
+      (dotimes (i 14)
+        (<a href='#with-graphics-state'>with-graphics-state</a>
+          (<a href='#rotate'>rotate</a> (* i step))
+          (<a href='#move-to'>move-to</a> 30 0)
+          (<a href='#line-to'>line-to</a> 40 0)
+          (stroke)))
+      (<a href='#save-png'>save-png</a> file))))
+</pre>
+
+<pre>
+<img align=right src='feedlike-icon.png'
+>(defun feedlike-icon (file)
+  (with-canvas (:width 100 :height 100)
+    (set-rgb-fill 1.0 0.65 0.3)
+    (<a href='#rounded-rectangle'>rounded-rectangle</a> 0 0 100 100 10 10)
+    (<a href='#fill-path'>fill-path</a>)
+    (set-rgb-fill 1.0 1.0 1.0)
+    (centered-circle-path 20 20 10)
+    (fill-path)
+    (flet ((quarter-circle (x y radius)
+             (let ((kappa (* <a href='#const-kappa'>+kappa+</a> radius)))
+               (move-to (+ x radius) y)
+               (curve-to (+ x radius) (+ y kappa)
+                         (+ x kappa) (+ y radius)
+                         x (+ y radius)))))
+      (set-rgb-stroke 1.0 1.0 1.0)
+      (set-line-width 15)
+      (quarter-circle 20 20 30)
+      (stroke)
+      (quarter-circle 20 20 60)
+      (stroke))
+    (save-png file)))
+</pre>
+
+<pre><div style='float: right' class='transparent'><img src='star-clipping.png'
+></div>(defun star-clipping (file)
+  (with-canvas (:width 200 :height 200)
+    (let ((size 100)
+          (angle 0)
+          (step (* 2 (/ (* pi 2) 5))))
+      (translate size size)
+      (move-to 0 size)
+      (dotimes (i 5)
+        (setf angle (+ angle step))
+        (line-to (* (sin angle) size)
+                 (* (cos angle) size)))
+      (<a href='#even-odd-clip-path'><tt>even-odd-clip-path</tt></a>)
+      (<a href='#end-path-no-op'><tt>end-path-no-op</tt></a>)
+      (flet ((circle (distance)
+               (<a href='#set-rgba-fill'><tt>set-rgba-fill</tt></a> distance 0 0
+                              (- 1.0 distance))
+               (centered-circle-path 0 0 (* size distance))
+               (fill-path)))
+        (loop for i downfrom 1.0 by 0.05
+              repeat 20 do
+              (circle i)))
+      (save-png file))))
+</pre>
+
+<a name='sect-dictionary'><h3>Dictionary</h3></a>
+
+<p>The following symbols are exported from the <tt>VECTO</tt> package.
+
+<a name='sect-canvases'><h4>Canvases</h4></a>
+
+<p><a name='with-canvas'>[Macro]</a><br>
+<b>with-canvas</b> (<tt>&key</tt> <i>width</i> <i>height</i>)
+<tt>&body</tt> <i>body</i>
+
+<blockquote>
+Evaluates <i>body</i> with a canvas established with the specified
+dimensions as the target for drawing commands. The canvas is initially
+completely clear (all pixels have 0 alpha).
+</blockquote>
+
+
+<p><a name='clear-canvas'>[Function]</a><br>
+<b>clear-canvas</b> => |
+
+<blockquote>
+Completely fills the canvas with the current fill color. Any marks on
+the canvas are cleared.
+</blockquote>
+
+
+<p><a name='save-png'>[Function]</a><br>
+<b>save-png</b> <i>file</i> => <i>truename</i>
+
+<blockquote>
+Writes the contents of the canvas as the PNG <i>file</i>, and returns
+the truename of <i>file</i>.
+</blockquote>
+
+
+<p><a name='save-png-stream'>[Function]</a><br>
+<b>save-png-stream</b> <i>stream</i> => |
+
+<blockquote>
+Writes the contents of the canvas as a PNG to <i>stream</i>, which
+must accept <tt>(unsigned-byte 8)</tt> data.
+</blockquote>
+
+
+<a name='sect-graphics-state'><h4>Graphics State</h4></a>
+
+<p>The graphics state stores several parameters used for graphic
+operations.
+
+<p><a name='with-graphics-state'>[Macro]</a><br>
+<b>with-graphics-state</b> <tt>&body</tt> <i>body</i> 
+
+<blockquote>
+Evaluates the forms of <i>body</i> with a copy of the current graphics
+state. Any modifications to the state are undone at the end of the
+form.
+</blockquote>
+
+
+<p><a name='set-rgba-fill'>[Functions]</a><br>
+<b>set-rgba-fill</b> <i>r</i> <i>g</i> <i>b</i> <i>alpha</i> => |<br>
+<b>set-rgb-fill</b> <i>r</i> <i>g</i> <i>b</i> => |
+
+<blockquote>
+Sets the fill color. <i>r</i>, <i>g</i>, <i>b</i>, and <i>alpha</i>
+should be in the range of 0.0 to 1.0.
+
+<p><tt>set-rgb-fill</tt> is the same as <tt>set-rgba-fill</tt> with an
+implicit alpha value of 1.0.
+
+<p>The fill color is used
+for <a
+href='#clear-canvas'><tt>CLEAR-CANVAS</tt></a>, <a
+href='#fill-path'><tt>FILL-PATH</tt></a>, <a
+href='#even-odd-fill'><tt>EVEN-ODD-FILL</tt></a>, <a
+href='#fill-and-stroke'><tt>FILL-AND-STROKE</tt></a>, <a
+href='#even-odd-fill-and-stroke'><tt>EVEN-ODD-FILL-AND-STROKE</tt></a>,
+and <a href='#draw-string'><tt>DRAW-STRING</tt></a>.
+
+</blockquote>
+
+<p><a name='set-rgba-stroke'>[Functions]</a><br>
+<b>set-rgba-stroke</b> <i>r</i> <i>g</i> <i>b</i> <i>alpha</i> => |<br>
+<b>set-rgb-stroke</b> <i>r</i> <i>g</i> <i>b</i> => |
+
+<blockquote>
+Sets the stroke color. <i>r</i>, <i>g</i>, <i>b</i>, and <i>alpha</i>
+should be in the range of 0.0 to 1.0.
+
+<p><tt>set-rgb-stroke</tt> is the same as <tt>set-rgba-stroke</tt>
+with an implicit alpha value of 1.0.
+
+<p>The stroke color is used for <a href='#stroke'><tt>STROKE</tt></a>,
+<a href='#fill-and-stroke'><tt>FILL-AND-STROKE</tt></a>,
+and <a href='#even-odd-fill-and-stroke'><tt>EVEN-ODD-FILL-AND-STROKE</tt></a>.
+</blockquote>
+
+
+<p><a name='set-line-cap'>[Function]</a><br>
+<b>set-line-cap</b> <i>style</i> => |
+
+<blockquote>
+Sets the line cap style to <i>style</i>, which must be one
+of <tt>:BUTT</tt>, <tt>:SQUARE</tt>, or <tt>:ROUND</tt>. The initial
+value is <tt>:BUTT</tt>.
+
+<p><table cellspacing=5 id="line-cap">
+<tr>
+ <td align=center><img src="cap-style-butt.png"></td>
+ <td align=center><img src="cap-style-square.png"></td>
+ <td align=center><img src="cap-style-round.png"></td>
+</tr>
+<tr>
+ <td align=center><tt>:BUTT</tt></td>
+ <td align=center><tt>:SQUARE</tt></td>
+ <td align=center><tt>:ROUND</tt></td>
+</tr>
+</table>
+
+</blockquote>
+
+
+<p><a name='set-line-join'>[Function]</a><br>
+<b>set-line-join</b> <i>style</i> => |
+
+<blockquote>
+Sets the line join style to <i>style</i>, which must be one
+of <tt>:MITER</tt>, <tt>:BEVEL</tt>, or <tt>:ROUND</tt>. The initial
+value is <tt>:MITER</tt>.
+
+<p><table cellspacing=5 id="line-join">
+<tr>
+ <td align=center><img src="join-style-miter.png"></td>
+ <td align=center><img src="join-style-bevel.png"></td>
+ <td align=center><img src="join-style-round.png"></td>
+</tr>
+<tr>
+ <td align=center><tt>:MITER</tt></td>
+ <td align=center><tt>:BEVEL</tt></td>
+ <td align=center><tt>:ROUND</tt></td>
+</tr>
+</table>
+
+</blockquote>
+
+
+<p><a name='set-line-width'>[Function]</a><br>
+<b>set-line-width</b> <i>width</i> => |
+
+<blockquote>
+Sets the line width for strokes to <i>width</i>.
+</blockquote>
+
+
+
+<p><a name='set-dash-pattern'>[Function]</a><br>
+<b>set-dash-pattern</b> <i>dash-vector</i> <i>phase</i> => |
+
+<blockquote>
+Sets the dash pattern according to <i>dash-vector</i> and <i>phase</i>.
+
+<p><i>dash-vector</i> should be a vector of numbers denoting on and
+off patterns for a stroke. An empty <i>dash-vector</i> is the same as
+having no dash pattern at all.
+
+<p><i>phase</i> is how far along the dash pattern to proceed before
+applying the pattern to the current stroke.
+
+<p>
+<table>
+  <tr>
+    <th>Appearance</th>
+    <th>Dash Vector and Phase</th>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-none.png"></td>
+    <td align=left><tt>#() 0</tt></td>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-a.png"></td>
+    <td align=left><tt>#(30 30) 0</tt></td>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-b.png"></td>
+    <td align=left><tt>#(30 30) 15</tt></td>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-c.png"></td>
+    <td align=left><tt>#(10 20 10 40) 0</tt></td>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-d.png"></td>
+    <td align=left><tt>#(10 20 10 40) 13</tt></td>
+  </tr>
+  <tr>
+    <td align=center><img src="dash-pattern-e.png"></td>
+    <td align=left><tt>#(30 30) 0</tt>, <tt>:ROUND</tt> line caps</td>
+  </tr>
+</table>
+</blockquote>
+
+
+<p><a name='translate'>[Function]</a><br>
+<b>translate</b> <i>x</i> <i>y</i> => |
+
+<blockquote>
+Offsets the coordinate system by <i>x</i> units horizontally
+and <i>y</i> units vertically.
+</blockquote>
+
+
+<p><a name='rotate'>[Function]</a><br>
+<b>rotate</b> <i>radians</i> => |
+
+<blockquote>
+Rotates the coordinate system by <i>radians</i>.
+</blockquote>
+
+
+<p><a name='scale'>[Function]</a><br>
+<b>scale</b> <i>sx</i> <i>sy</i> => |
+
+<blockquote>
+Scales the coordinate system by <i>sx</i> horizontally
+and <i>sy</i> vertically.
+</blockquote>
+
+
+<p><a name='skew'>[Function]</a><br>
+<b>skew</b> <i>ax</i> <i>ay</i> => |
+
+<blockquote>
+Skews the X axis of the coordinate system by <i>ax</i> radians and the
+Y axis by <i>ay</i> radians.
+</blockquote>
+
+
+<p><a name='clip-path'>[Function]</a><br>
+<b>clip-path</b> => |
+
+<blockquote>
+Defines a clipping path based on the current path. It is not applied
+immediately, but is created after after the painting is done in the
+next call to one
+of <a
+href='#fill-path'><tt>FILL-PATH</tt></a>, <a
+href='#even-odd-fill'><tt>EVEN-ODD-FILL</tt></a>, <a
+href='#fill-and-stroke'><tt>FILL-AND-STROKE</tt></a>, <a
+href='#even-odd-fill-and-stroke'><tt>EVEN-ODD-FILL-AND-STROKE</tt></a>,
+or <a href='#end-path-no-op'><tt>END-PATH-NO-OP</tt></a>.
+
+<p>The clipping path initially covers the entire canvas; no clipping
+is done. Subsequent calls to <tt>CLIP-PATH</tt> set the clipping path
+to the intersection of the established clipping path and the new
+clipping path, and all drawing will be done within the outline of the
+clipping path.
+
+<p>The outline of the clipping path is defined with the nonzero
+winding rule, as with <a href='#fill-path'><tt>FILL-PATH</tt></a>.
+
+<p>There is no way to enlarge the clipping path. However, the clipping
+path is part of the graphics state, so changes may be localized by
+using <a href='#with-graphics-state'><tt>WITH-GRAPHICS-STATE</tt></a>.
+
+
+<p><table>
+<tr>
+ <td><img src="clip-unclipped.png"></td>
+ <td>A filled red rectangle, not clipped</td>
+</tr>
+<tr>
+ <td><img src="clip-to-circle.png"></td>
+ <td>The same rectangle drawn with a circle clipping path in effect</td>
+</tr>
+<tr>
+ <td><img src="clip-to-rectangle.png"></td>
+ <td>Clipped to a rounded rectangle clipping path</td>
+</tr>
+<tr>
+ <td><img src="clip-to-both.png"></td>
+ <td>Clipped to the intersection of the circle and rounded rectangle clipping paths</td>
+</tr>
+</table>
+
+
+
+</blockquote>
+
+
+<p><a name='even-odd-clip-path'>[Function]</a><br>
+<b>even-odd-clip-path</b> => |
+
+<blockquote>
+Like <a href='#clip-path'><tt>CLIP-PATH</tt></a>, but uses the
+even/odd fill rule to determine the outline of the clipping path.
+</blockquote>
+
+
+<a name='sect-paths'><h4>Paths</h4></a>
+
+<p>Paths are used to create lines for stroking or outlines for
+filling. Paths consist of straight lines and curves. Paths consist of
+one or more subpaths.
+
+<p><a name='move-to'>[Function]</a><br>
+<b>move-to</b> <i>x</i> <i>y</i> => |
+
+<blockquote>
+Starts a new subpath at (<i>x</i>,<i>y</i>). <tt>move-to</tt> must be the
+first step of constructing a subpath.
+</blockquote>
+
+
+<p><a name='line-to'>[Function]</a><br>
+<b>line-to</b> <i>x</i> <i>y</i> => |
+
+<blockquote>
+Appends a straight line ending at (<i>x</i>,<i>y</i>) to the
+current subpath.
+</blockquote>
+
+
+<p><a name='curve-to'>[Function]</a><br>
+<b>curve-to</b>
+<i>cx1</i> <i>cy1</i>
+<i>cx2</i> <i>cy2</i>
+<i>x</i> <i>y</i> => |
+
+<blockquote>
+Appends a
+cubic <a href="http://en.wikipedia.org/wiki/B%C3%A9zier_curve">Bézier
+curve</a> ending at (<i>x</i>,<i>y</i>) and with control
+points (<i>cx1</i>,<i>cy1</i>) and (<i>cx2</i>,<i>cy2</i>) to the current
+subpath.
+</blockquote>
+
+
+<p><a name='quadratic-to'>[Function]</a><br>
+<b>quadratic-to</b>
+<i>cx</i> <i>cy</i>
+<i>x</i> <i>y</i> => |
+
+<blockquote>
+Appends a quadratic Bézier curve ending at (<i>x</i>,<i>y</i>)
+and with the control point (<i>cx</i>,<i>cy</i>) to the current
+subpath.
+</blockquote>
+
+
+<p><a name='close-subpath'>[Function]</a><br>
+<b>close-subpath</b> => |
+
+<blockquote>
+Closes the current subpath. If the current point is not the same as the
+starting point for the subpath, appends a straight line from the
+current point to the starting point of the current subpath.
+
+<p>Subpaths with start and end points that coincidentally overlap are
+not the same as closed subpaths. The distinction is important when
+stroking:
+
+<p><table cellpadding=5>
+ <tr>
+   <td align=center><img src="open-subpath.png"></td>
+   <td align=center><img src="closed-subpath.png"></td>
+ </tr>
+ <tr>
+   <td align=center>Open subpath</td>
+   <td align=center>Closed subpath</td>
+ </tr>
+</table>
+
+<p>If the subpath is not closed, the start and points of the subpath
+  will be drawn with the current line cap style. If the path is
+  closed, the start and endpoints will be treated as joined and drawn
+  with the line join style.
+</blockquote>
+
+
+<p><a name='rectangle'>[Function]</a><br>
+<b>rectangle</b> <i>x</i> <i>y</i> <i>width</i> <i>height</i>
+
+<blockquote>
+Creates a rectangular subpath with the given <i>width</i>
+and <i>height</i> that has its lower-left corner at
+(<i>x</i>,<i>y</i>). It is effectively the same as:
+
+<pre>
+(move-to x y)
+(line-to (+ x width) y)
+(line-to (+ x width) (+ y height))
+(line-to x (+ y height))
+(close-subpath)
+</pre>
+</blockquote>
+
+<p><a name='centered-ellipse-path'>[Function]</a><br>
+<b>centered-ellipse-path</b> 
+<i>x</i> <i>y</i>
+<i>rx</i> <i>ry</i>
+
+<blockquote>
+Adds a closed subpath that outlines an ellipse centered at
+(<i>x</i>,<i>y</i>) with an X radius of <i>rx</i> and a Y radius
+of <i>ry</i>.
+</blockquote>
+
+<p><a name='centered-circle-path'>[Function]</a><br>
+<b>centered-circle-path</b> <i>x</i> <i>y</i> <i>radius</i> => |
+
+<blockquote>
+Adds a closed subpath that outlines a circle centered at
+(<i>x</i>,<i>y</i>) with a radius of <i>radius</i>. It is effectively
+the same as:
+
+<pre>
+(centered-ellipse-path x y radius radius)
+</pre>
+</blockquote>
+
+
+
+<a name='sect-painting'><h4>Painting</h4></a>
+
+<p>After a path is defined, filling, stroking, or both will use the
+path to apply color to the canvas. After a path has been filled or
+stroked, it is no longer active; it effectively disappears.
+
+
+<p><a name='fill-path'>[Function]</a><br>
+<b>fill-path</b> => |
+
+<blockquote>
+Fills the current path with the fill color. If the path has not been
+explicitly closed
+with <a href='#close-subpath'><tt>CLOSE-SUBPATH</tt></a>, it is
+implicitly closed before filling.  The non-zero winding rule is used
+to determine what areas are considered inside the path.
+</blockquote>
+
+
+<p><a name='even-odd-fill'>[Function]</a><br>
+<b>even-odd-fill</b> => |
+
+<blockquote>
+The same as <a href='#fill-path'><tt>FILL-PATH</tt></a>, but uses the
+even/odd rule to determine what areas are considered inside the path.
+</blockquote>
+
+
+<p><a name='stroke'>[Function]</a><br>
+<b>stroke</b> => |
+
+<blockquote>
+Strokes the current path. The line width, stroke color, line join
+style, line cap style, and dash pattern and phase determine how the
+stroked path will appear on the canvas.
+</blockquote>
+
+
+<p><a name='fill-and-stroke'>[Function]</a><br>
+<b>fill-and-stroke</b> => |
+
+<blockquote>
+Fills the current path, then strokes it.
+</blockquote>
+
+
+<p><a name='even-odd-fill-and-stroke'>[Function]</a><br>
+<b>even-odd-fill-and-stroke</b> => |
+
+<blockquote>
+Fills the current path using the even/odd rule, then strokes it.
+</blockquote>
+
+
+<p><a name='end-path-no-op'>[Function]</a><br>
+<b>end-path-no-op</b> => |
+
+<blockquote>
+Ends the current path without painting anything. If a clipping path
+has been specified with <a href='#clip-path'><tt>CLIP-PATH</tt></a>
+or <a href='#even-odd-clip-path'><tt>EVEN-ODD-CLIP-PATH</tt></a>, it
+will be created by <tt>end-path-no-op</tt>.
+</blockquote>
+
+
+
+<a name='sect-text'><h4>Text</h4></a>
+
+<p>Vecto can draw text to a canvas. It loads glyph shapes from
+  TrueType font files
+  with <a href="http://www.xach.com/lisp/zpb-ttf/">ZPB-TTF</a>. 
+
+<p><a name='get-font'>[Function]</a><br>
+<b>get-font</b> <i>font-file</i> => <i>font-loader</i>
+
+<blockquote>
+Creates and returns a ZPB-TTF font loader object
+from <i>font-file</i>. Any font loader created this way will
+automatically be closed at the end of its
+enclosing <a href='#with-canvas'><tt>WITH-CANVAS</tt></a> form.
+</blockquote>
+
+
+<p><a name='set-font'>[Function]</a><br>
+<b>set-font</b> <i>font-loader</i> <i>size</i> => |
+
+<blockquote>
+Sets the active font to the font associated
+with <i>font-loader</i>, scaled to <i>size</i> units per line.
+
+<p>The first argument can be any ZPB-TTF font loader; it need not be
+created via <a href='#get-font'><tt>GET-FONT</tt></a>. However, only
+font loaders created via <tt>GET-FONT</tt> will be automatically
+closed at the end of <a href='#with-canvas'><tt>WITH-CANVAS</tt></a>.
+</blockquote>
+
+
+<p><a name='draw-string'>[Function]</a><br>
+<b>draw-string</b> <i>x</i> <i>y</i> <i>string</i> => |
+
+<blockquote>
+Draws <i>string</i> on the canvas with the active font. The glyph
+origin of the first character in the string is positioned at <i>x</i>
+and the baseline of the string is positioned at <i>y</i>. The text is
+filled with the current <a href='#set-rgba-fill'>fill color</a>.
+
+<p>The string may be a specialized vector of characters (a true CL
+string) or a vector containing characters, Unicode code-points, or both. For
+example, <tt>#(#\L #\a #\m #\b #\d #\a #\= #x3BB)</tt> is a valid
+argument for <tt>DRAW-STRING</tt>.
+</blockquote>
+
+
+<p><a name='draw-centered-string'>[Function]</a><br>
+<b>draw-centered-string</b> <i>x</i> <i>y</i> <i>string</i> => |
+
+<blockquote>
+Draws <i>string</i> on the canvas with the active font. The horizontal
+center of the string is positioned at <i>x</i> and the baseline of the
+string is positioned at <i>y</i>.
+</blockquote>
+
+
+<p><a name='string-bounding-box'>[Function]</a><br>
+<b>string-bounding-box</b> <i>string</i> <i>size</i> <i>loader</i> 
+=> <i>#(xmin ymin xmax ymax)</i>
+
+<blockquote>
+Calculates the bounding box of <i>string</i> for <i>font-loader</i>
+at <i>size</i>.
+</blockquote>
+
+
+<a name='sect-miscellaneous'><h3>Miscellaneous</h3></a>
+
+<p><a name='const-kappa'>[Constant]</a><br>
+<b>+kappa+</b> => 0.5522847498307936d0.
+
+<blockquote>
+This constant is useful to draw portions of a circle.
+</blockquote>              
+
+
+<a name='sect-references'><h2>References</h2></a>
+
+<ul>
+  <li> Adobe Systems Inc., <a href="http://www.adobe.com/devnet/pdf/pdf_reference.html">PDF Reference, Sixth Edition, Version 1.7</a>
+  <li> Lawrence Kesteloot, <a href="http://www.teamten.com/lawrence/graphics/premultiplication/">Alpha Premultiplication</a>
+  <li> Dr. Thomas Sederberg, <a href="http://www.tsplines.com/resources/class_notes/Bezier_curves.pdf">Bézier curves</a>
+  <li> Alvy Ray Smith, <a href="http://alvyray.com/Memos/MemosMicrosoft.htm#ImageCompositing">Image Compositing Fundamentals</a>
+  <li> G. Adam Stanislav, <a href="http://www.whizkidtech.redprince.net/bezier/circle/">Drawing a circle with Bézier curves</a>
+  <li> Wikipedia, <a href="http://en.wikipedia.org/wiki/B%C3%A9zier_curve">Bézier curve</a>
+
+</ul>
+
+
+<a name='sect-feedback'><h2>Feedback</h2></a>
+
+<p>If you have any questions, comments, bug reports, or other feedback
+regarding Vecto, please email <a href="mailto:xach at xach.com">Zach
+Beane</a>.
+
+<p><hr>
+<tt>$Id: index.html,v 1.27 2007/10/01 20:03:18 xach Exp $</tt>
+

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-bevel.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-bevel.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-miter.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-miter.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-round.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/join-style-round.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/lambda-example.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/lambda-example.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/open-subpath.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/open-subpath.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/star-clipping.png
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/vecto-1.0.2/doc/star-clipping.png
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/drawing.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/drawing.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/drawing.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,279 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: drawing.lisp,v 1.17 2007/10/01 19:05:13 xach Exp $
+
+(in-package #:vecto)
+
+(deftype octet ()
+  '(unsigned-byte 8))
+
+(deftype vector-index ()
+  `(mod ,array-dimension-limit))
+
+(deftype octet-vector ()
+  '(simple-array (unsigned-byte 8) (*)))
+
+(defun nonzero-winding-alpha (alpha)
+  (min 255 (abs alpha)))
+
+(defun even-odd-alpha (alpha)
+  (let ((value (mod alpha 512)))
+    (min 255 (if (< value 256) value (- 512 value)))))
+
+;; ( (t) = (a) * (b) + 0x80, ( ( ( (t)>>8 ) + (t) )>>8 ) )
+
+(defun imult (a b)
+  (let ((temp (+ (* a b) #x80)))
+    (logand #xFF (ash (+ (ash temp -8) temp) -8))))
+
+(defun lerp (p q a)
+  (logand #xFF (+ p (imult a (- q p)))))
+
+(defun prelerp (p q a)
+  (logand #xFF (- (+ p q) (imult a p))))
+
+(defun draw-function (data width height r.fg g.fg b.fg a.fg alpha-fun)
+  "From http://www.teamten.com/lawrence/graphics/premultiplication/"
+  (declare (ignore height))
+  (let ((r.fg (float-octet r.fg))
+        (g.fg (float-octet g.fg))
+        (b.fg (float-octet b.fg))
+        (a.fg (float-octet a.fg)))
+    (lambda (x y alpha)
+      (setf alpha (funcall alpha-fun alpha))
+      (when (plusp alpha)
+        (let* ((i (* +png-channels+ (+ x (* y width))))
+               (r.bg (aref data (+ i 0)))
+               (g.bg (aref data (+ i 1)))
+               (b.bg (aref data (+ i 2)))
+               (a.bg (aref data (+ i 3)))
+               (a.fg (imult alpha a.fg))
+               (gamma (prelerp a.fg a.bg a.bg)))
+          (flet ((blend (fg bg)
+                   (let ((value (lerp (imult bg a.bg) fg a.fg)))
+                     (float-octet (/ value gamma)))))
+            (unless (zerop gamma)
+              (setf (aref data (+ i 0)) (blend r.fg r.bg)
+                    (aref data (+ i 1)) (blend g.fg g.bg)
+                    (aref data (+ i 2)) (blend b.fg b.bg)))
+            (setf (aref data (+ i 3)) gamma)))))))
+
+(defun draw-function/clipped (data clip-data
+                              width height
+                              r.fg g.fg b.fg a.fg
+                              alpha-fun)
+  "Like DRAW-FUNCTION, but uses uses the clipping channel."
+  (declare (ignore height))
+  (let ((r.fg (float-octet r.fg))
+        (g.fg (float-octet g.fg))
+        (b.fg (float-octet b.fg))
+        (a.fg (float-octet a.fg)))
+    (lambda (x y alpha)
+      (let* ((clip-index (+ x (* y width)))
+             (clip (aref clip-data clip-index)))
+        (setf alpha (imult clip (funcall alpha-fun alpha)))
+        (when (plusp alpha)
+          (let* ((i (* clip-index +png-channels+))
+                 (r.bg (aref data (+ i 0)))
+                 (g.bg (aref data (+ i 1)))
+                 (b.bg (aref data (+ i 2)))
+                 (a.bg (aref data (+ i 3)))
+                 (a.fg (imult alpha a.fg))
+                 (gamma (prelerp a.fg a.bg a.bg)))
+            (flet ((blend (fg bg)
+                     (let ((value (lerp (imult bg a.bg) fg a.fg)))
+                       (float-octet (/ value gamma)))))
+              (unless (zerop gamma)
+                (setf (aref data (+ i 0)) (blend r.fg r.bg)
+                      (aref data (+ i 1)) (blend g.fg g.bg)
+                      (aref data (+ i 2)) (blend b.fg b.bg)))
+              (setf (aref data (+ i 3)) gamma))))))))
+
+(defun make-draw-function (data clipping-path
+                           width height
+                           r g b a
+                           alpha-fun)
+  (if (emptyp clipping-path)
+      (draw-function data width height r g b a alpha-fun)
+      (draw-function/clipped data (clipping-data clipping-path)
+                             width height
+                             r g b a
+                             alpha-fun)))
+
+(defun intersect-clipping-paths (data temp)
+  (declare (type (simple-array (unsigned-byte 8) (*)) data temp))
+  (map-into data #'imult temp data))
+
+(defun draw-clipping-path-function (data width height alpha-fun)
+  (declare (ignore height)
+           (type (simple-array (unsigned-byte 8) (*)) data))
+  (lambda (x y alpha)
+    (let ((i (+ x (* width y))))
+      (let ((alpha (funcall alpha-fun alpha)))
+        (setf (aref data i) alpha)))))
+
+(defun draw-paths (&key width height paths
+                   transform-function
+                   draw-function)
+  "Use DRAW-FUNCTION as a callback for the cells sweep function
+for the set of paths PATHS."
+  (let ((state (aa:make-state))
+        (paths (mapcar (lambda (path)
+                         ;; FIXME: previous versions lacked
+                         ;; paths:path-clone, and this broke fill &
+                         ;; stroke because transform-path damages the
+                         ;; paths. It would be nicer if transform-path
+                         ;; wasn't destructive, since I didn't expect
+                         ;; it to be.
+                         (transform-path (paths:path-clone path)
+                                         transform-function))
+                       paths)))
+    (vectors:update-state state paths)
+    (aa:cells-sweep/rectangle state 0 0 width height draw-function)))
+
+;;; FIXME: this was added for drawing text paths, but the text
+;;; rendering mode could be changed in the future, making it a little
+;;; silly to have a fixed draw-function.
+
+(defun draw-paths/state (paths state)
+  (draw-paths :paths paths
+              :width (width state)
+              :height (height state)
+              :transform-function (transform-function state)
+              :draw-function (fill-draw-function state)))
+
+(defun fill-image (image-data red green blue alpha)
+  "Completely fill IMAGE with the given colors."
+  (let ((r (float-octet red))
+        (g (float-octet green))
+        (b (float-octet blue))
+        (a (float-octet alpha)))
+    (do ((h 0 (+ h 4))
+         (i 1 (+ i 4))
+         (j 2 (+ j 4))
+         (k 3 (+ k 4)))
+        ((<= (length image-data) k))
+      (setf (aref image-data h) r
+            (aref image-data i) g
+            (aref image-data j) b
+            (aref image-data k) a))))
+
+(defun state-draw-function (state color fill-style)
+  "Create a draw function for the graphics state STATE."
+  (make-draw-function (image-data state)
+                      (clipping-path state)
+                      (width state)
+                      (height state)
+                      (red color)
+                      (green color)
+                      (blue color)
+                      (alpha color)
+                      (ecase fill-style
+                        (:even-odd #'even-odd-alpha)
+                        (:nonzero-winding #'nonzero-winding-alpha))))
+
+(defun stroke-draw-function (state)
+  (state-draw-function state (stroke-color state) :nonzero-winding))
+
+(defun fill-draw-function (state)
+  (state-draw-function state (fill-color state) :nonzero-winding))
+
+(defun even-odd-fill-draw-function (state)
+  (state-draw-function state (fill-color state) :even-odd))
+
+(defun tolerance-scale (state)
+  (let ((matrix (transform-matrix state)))
+    (abs (/ 1.0 (min (transform-matrix-x-scale matrix)
+                     (transform-matrix-y-scale matrix))))))
+         
+
+(defun draw-stroked-paths (state)
+  "Create a set of paths representing a stroking of the current
+paths of STATE, and draw them to the image."
+  (let ((paths (dash-paths (paths state)
+                           (dash-vector state)
+                           (dash-phase state)))
+        (paths:*bezier-distance-tolerance*
+         (* paths:*bezier-distance-tolerance* (tolerance-scale state))))
+    (setf paths (stroke-paths paths
+                              :line-width (line-width state)
+                              :join-style (join-style state)
+                              :cap-style (cap-style state)))
+    (draw-paths :paths paths
+                :width (width state)
+                :height (height state)
+                :transform-function (transform-function state)
+                :draw-function (stroke-draw-function state))))
+
+(defun close-paths (paths)
+  (dolist (path paths)
+    (setf (paths::path-type path) :closed-polyline)))
+
+(defun draw-filled-paths (state)
+  "Fill the paths of STATE into the image."
+  (close-paths (paths state))
+  (draw-paths :paths (paths state)
+              :width (width state)
+              :height (height state)
+              :transform-function (transform-function state)
+              :draw-function (fill-draw-function state)))
+
+(defun draw-even-odd-filled-paths (state)
+  "Fill the paths of STATE into the image."
+  (close-paths (paths state))
+  (draw-paths :paths (paths state)
+              :width (width state)
+              :height (height state)
+              :transform-function (transform-function state)
+              :draw-function (even-odd-fill-draw-function state)))
+
+(defun draw-clipping-path (state alpha-fun)
+  (let ((data (writable-clipping-data (clipping-path state)))
+        (scratch (scratch (clipping-path state)))
+        (width (width state))
+        (height (height state)))
+    (declare (type octet-vector data scratch))
+    (fill scratch 0)
+    (draw-paths :paths (paths state)
+                :width (width state)
+                :height (height state)
+                :transform-function (transform-function state)
+                :draw-function (draw-clipping-path-function scratch
+                                                            width
+                                                            height
+                                                            alpha-fun))
+    (intersect-clipping-paths data scratch)))
+
+(defun make-clipping-path-function (state type)
+  (ecase type
+    (:nonzero-winding
+     (lambda ()
+       (draw-clipping-path state #'nonzero-winding-alpha)))
+    (:even-odd
+     (lambda ()
+       (draw-clipping-path state #'even-odd-alpha)))))
+

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/graphics-state.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/graphics-state.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/graphics-state.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,204 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: graphics-state.lisp,v 1.15 2007/10/01 02:24:44 xach Exp $
+
+(in-package #:vecto)
+
+(defconstant +png-channels+ 4)
+(defconstant +png-color-type+ :truecolor-alpha)
+
+(defclass graphics-state ()
+  ((paths
+    :initarg :paths
+    :accessor paths)
+   (path
+    :initarg :path
+    :accessor path)
+   (height
+    :initarg :height
+    :accessor height)
+   (width
+    :initarg :width
+    :accessor width)
+   (image
+    :initarg :image
+    :accessor image)
+   (stroke-color
+    :initarg :stroke-color
+    :accessor stroke-color)
+   (line-width
+    :initarg :line-width
+    :accessor line-width)
+   (dash-vector
+    :initarg :dash-vector
+    :accessor dash-vector)
+   (dash-phase
+    :initarg :dash-phase
+    :accessor dash-phase)
+   (fill-color
+    :initarg :fill-color
+    :accessor fill-color)
+   (join-style
+    :initarg :join-style
+    :accessor join-style)
+   (cap-style
+    :initarg :cap-style
+    :accessor cap-style)
+   (transform-matrix
+    :initarg :transform-matrix
+    :accessor transform-matrix)
+   (clipping-path
+    :initarg :clipping-path
+    :accessor clipping-path)
+   (after-paint-fun
+    :initarg :after-paint-fun
+    :accessor after-paint-fun)
+   (font-loaders
+    :initarg :font-loaders
+    :accessor font-loaders)
+   (font
+    :initarg :font
+    :accessor font))
+  (:default-initargs
+   :paths nil
+   :path nil
+   :stroke-color (make-instance 'rgba-color)
+   :line-width 1.0
+   :dash-vector nil
+   :dash-phase 0
+   :fill-color (make-instance 'rgba-color)
+   :join-style :miter
+   :cap-style :butt
+   :transform-matrix (scaling-matrix 1.0 -1.0)
+   :after-paint-fun (constantly nil)
+   :font-loaders (make-hash-table :test 'equal)
+   :font nil))
+
+(defgeneric image-data (state)
+  (:method (state)
+    (png::image-data (image state))))
+
+(defgeneric transform-function (state)
+  (:documentation "Return a function that takes x, y coordinates
+and returns them transformed by STATE's current transformation
+matrix as multiple values.")
+  (:method (state)
+    (make-transform-function (transform-matrix state))))
+
+
+(defgeneric call-after-painting (state fun)
+  (:documentation
+   "Call FUN after painting, and reset the post-painting fun to a no-op.")
+  (:method (state fun)
+    (setf (after-paint-fun state)
+          (lambda ()
+            (funcall fun)
+            (setf (after-paint-fun state) (constantly nil))))))
+
+(defgeneric after-painting (state)
+  (:documentation "Invoke the post-painting function.")
+  (:method (state)
+    (funcall (after-paint-fun state))))
+
+
+(defgeneric apply-matrix (state matrix)
+  (:documentation "Replace the current transform matrix of STATE
+with the result of premultiplying it with MATRIX.")
+  (:method (state matrix)
+    (let ((old (transform-matrix state)))
+      (setf (transform-matrix state) (mult matrix old)))))
+
+(defgeneric clear-paths (state)
+  (:documentation "Clear out any paths in STATE.")
+  (:method (state)
+    (setf (paths state) nil
+          (path state) nil
+          (after-paint-fun state) (constantly nil))))
+
+
+(defun make-image-data (width height bpp)
+  "Make an octet vector suitable for use as the image data vector of a
+backing image."
+  (make-array (* width height bpp)
+              :element-type '(unsigned-byte 8)
+              :initial-element #x00))
+
+(defun state-image (state width height)
+  "Set the backing image of the graphics state to an image of the
+specified dimensions."
+  (setf (image state)
+        (make-instance 'png:png
+                       :width width
+                       :height height
+                       :color-type +png-color-type+
+                       :image-data (make-image-data width height
+                                                    +png-channels+))
+        (width state) width
+        (height state) height
+        (clipping-path state) (make-clipping-path width height))
+  (apply-matrix state (translation-matrix 0 (- height))))
+  
+
+(defun find-font-loader (state file)
+  (let* ((cache (font-loaders state))
+         (key (namestring (truename file))))
+    (or (gethash key cache)
+        (setf (gethash key cache) (zpb-ttf:open-font-loader file)))))
+
+(defgeneric close-font-loaders (state)
+  (:documentation "Close any font loaders that were obtained with GET-FONT.")
+  (:method (state)
+    (maphash (lambda (filename loader)
+               (declare (ignore filename))
+               (ignore-errors (zpb-ttf:close-font-loader loader)))
+             (font-loaders state))))
+
+(defgeneric clear-state (state)
+  (:documentation "Clean up any state in STATE.")
+  (:method ((state graphics-state))
+    (close-font-loaders state)))
+
+
+(defmethod copy ((state graphics-state))
+  (make-instance 'graphics-state
+                 :paths (paths state)
+                 :path (path state)
+                 :height (height state)
+                 :width (width state)
+                 :image (image state)
+                 :stroke-color (copy (stroke-color state))
+                 :line-width (line-width state)
+                 :dash-vector (copy-seq (dash-vector state))
+                 :dash-phase (dash-phase state)
+                 :fill-color (copy (fill-color state))
+                 :join-style (join-style state)
+                 :cap-style (cap-style state)
+                 :transform-matrix (copy-seq (transform-matrix state))
+                 :clipping-path (copy (clipping-path state))
+                 :after-paint-fun (after-paint-fun state)
+                 :font-loaders (font-loaders state)
+                 :font (font state)))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/package.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/package.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,87 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: package.lisp,v 1.17 2007/10/01 14:13:11 xach Exp $
+
+(cl:defpackage #:vecto
+  (:use #:cl)
+  (:import-from #:zpb-ttf
+                #:open-font-loader
+                #:xmin
+                #:xmax
+                #:ymin
+                #:ymax
+                #:bounding-box)
+  (:export
+   ;; canvas operations
+   #:with-canvas
+   #:clear-canvas
+   #:save-png
+   #:save-png-stream
+   ;; path construction
+   #:move-to
+   #:line-to
+   #:curve-to
+   #:quadratic-to
+   #:close-subpath
+   ;; Clipping
+   #:end-path-no-op
+   #:clip-path
+   #:even-odd-clip-path
+   ;; path construction one-offs
+   #:rectangle
+   #:rounded-rectangle
+   #:centered-ellipse-path
+   #:centered-circle-path
+   #:+kappa+
+   ;; painting
+   #:fill-path
+   #:even-odd-fill
+   #:stroke
+   #:fill-and-stroke
+   #:even-odd-fill-and-stroke
+   ;; graphics state
+   #:with-graphics-state
+   #:set-line-cap
+   #:set-line-join
+   #:set-line-width
+   #:set-dash-pattern
+   #:set-rgba-stroke
+   #:set-rgb-stroke
+   #:set-rgba-fill
+   #:set-rgb-fill
+   ;; graphics state coordinate transforms
+   #:translate
+   #:rotate
+   #:rotate-degrees
+   #:skew
+   #:scale
+   ;; text
+   #:get-font
+   #:set-font
+   #:draw-string
+   #:string-bounding-box
+   #:draw-centered-string))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/paths.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/paths.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/paths.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,137 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: paths.lisp,v 1.2 2007/09/28 18:11:35 xach Exp $
+
+(in-package #:vecto)
+
+;;; Applying a transform function to a path
+
+(defgeneric transformablep (interpolation)
+  (:method (interpolation)
+    nil)
+  (:method ((interpolation paths::bezier))
+    t)
+  (:method ((interpolation (eql :straight-line)))
+    t))
+
+(defun transform-point (point fun)
+  (multiple-value-call #'paths:make-point
+    (funcall fun (paths:point-x point) (paths:point-y point))))
+
+(defgeneric transform-interpolation (interpolation fun)
+  (:method (interpolation fun)
+    (declare (ignore fun))
+    (error "Unhandled interpolation ~A" interpolation))
+  (:method ((interpolation symbol) fun)
+    (declare (ignore fun))
+    interpolation)
+  (:method ((interpolation paths::bezier) fun)
+    (let ((control-points (slot-value interpolation
+                                      'paths::control-points)))
+      (dotimes (i (length control-points) interpolation)
+        (setf (aref control-points i)
+              (transform-point (aref control-points i) fun))))))
+
+(defun empty-path-p (path)
+  (zerop (length (paths::path-knots path))))
+  
+
+(defun transform-path (path fun)
+  (when (empty-path-p path)
+    (return-from transform-path path))
+  (let ((new-path (paths:create-path (paths::path-type path)))
+        (iterator (paths:path-iterator-segmented path
+                                                 (complement #'transformablep))))
+    (loop
+     (multiple-value-bind (interpolation knot endp)
+         (paths:path-iterator-next iterator)
+       (paths:path-extend new-path
+                          (transform-interpolation interpolation fun)
+                          (transform-point knot fun))
+       (when endp
+         (return new-path))))))
+
+(defun transform-paths (paths fun)
+  (mapcar (lambda (path) (transform-path path fun)) paths))
+
+
+;;; Applying a dash pattern
+
+(defun apply-dash-phase (dash-vector phase)
+  "cl-vectors and PDF have different semantics for dashes. Given
+a PDF-style dash vector and phase value, return a
+cl-vectors-style dash vector and TOGGLE-P value."
+  (let ((sum (reduce #'+ dash-vector)))
+    (when (or (zerop phase)
+              (= phase sum))
+      ;; Don't bother doing anything for an empty phase
+      (return-from apply-dash-phase (values dash-vector 0))))
+  (let ((index 0)
+        (invertp t))
+    (flet ((next-value ()
+             (cond ((< index (length dash-vector))
+                    (setf invertp (not invertp)))
+                   (t
+                    (setf invertp nil
+                          index 0)))
+             (prog1
+                 (aref dash-vector index)
+               (incf index)))
+           (join (&rest args)
+             (apply 'concatenate 'vector
+                    (mapcar (lambda (thing)
+                              (if (vectorp thing)
+                                  thing
+                                  (vector thing)))
+                            args))))
+      (loop
+       (let ((step (next-value)))
+         (decf phase step)
+         (when (not (plusp phase))
+           (let ((result (join (- phase)
+                               (subseq dash-vector index)
+                               dash-vector)))
+             (when invertp
+               (setf result (join 0 result)))
+             (return (values result
+                             (- (length result) (length dash-vector)))))))))))
+
+
+
+(defun dash-paths (paths dash-vector dash-phase)
+  (if dash-vector
+      (multiple-value-bind (sizes cycle-index)
+              (apply-dash-phase dash-vector dash-phase)
+        (paths:dash-path paths sizes :cycle-index cycle-index))
+      paths))
+
+(defun stroke-paths (paths &key line-width join-style cap-style)
+  (mapcan (lambda (path)
+            (paths:stroke-path path line-width
+                               :joint join-style
+                               :caps cap-style))
+          paths))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/test.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/test.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/test.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,306 @@
+
+(in-package #:vecto)
+
+(defun test (output-file)
+  (with-canvas (:width 100 :height 100)
+    (set-line-width 5.0)
+    ;; red stroke
+    (set-rgb-stroke 1 0 0)
+    (move-to 10 10)
+    (line-to 90 90)
+    (stroke)
+    ;; green stroke
+    (set-rgb-stroke 0 1 0)
+    (move-to 10 90)
+    (line-to 90 10)
+    (stroke)
+    ;; blue+alpha transform stroke
+    (set-rgba-stroke 0 0 1 0.5)
+    (flet ((elbow (radians)
+	     (with-graphics-state
+	       (translate 50 50)
+	       (rotate radians)
+	       (scale 0.25 0.25)
+	       (move-to 0 0)
+	       (curve-to 0 100
+			 0 100
+			 100 100)
+	       (set-line-width 10.0)
+	       (stroke))))
+      (let* ((rotations 25)
+	     (step (/ (* pi 2) rotations)))
+	(dotimes (i rotations)
+	  (elbow (* i step)))))
+    (save-png output-file)))
+
+
+(defun test-rotate (output-file)
+  (with-canvas (:width 100 :height 100)
+    (translate 50 50)
+    (move-to 0 0)
+    (line-to 0 10)
+    (rotate (- (/ pi 4)))
+    (set-line-width 15)
+    (stroke)
+    (save-png output-file)))
+
+(defun test-skew (output-file)
+  (with-canvas (:width 100 :height 100)
+    (move-to 0 0)
+    (line-to 0 75)
+    (skew (- (/ pi 4)) (- (/ pi 4)))
+    (set-line-width 15)
+    (stroke)
+    (save-png output-file)))
+
+(defun hole-test (file)
+  (with-canvas (:width 100 :height 100)
+    (translate 10 10)
+    (scale 50 50)
+    (set-line-width 0.1)
+    (move-to 0 0)
+    (line-to 0 1)
+    (line-to 1 1)
+    (line-to 1 0)
+    (line-to 0 0)
+    (move-to 0.1 0.8)
+    (line-to 0.1 0.1)
+    (line-to 0.8 0.1)
+    (line-to 0.8 0.8)
+    (line-to 0.1 0.8)
+    (fill-path)
+    (save-png file)))
+
+(defun rectangle-test (file)
+  (with-canvas (:width 100 :height 100)
+    (rectangle 10 10 50 50)
+    (fill-path)
+    (save-png file)))
+
+(defun rectangle-fill-test (file)
+  (with-canvas (:width 5 :height 5)
+    (set-rgba-fill 1 0 0 0.5)
+    (rectangle 0 0 5 5)
+    (fill-path)
+    (save-png file)))
+
+(defun circle-test (string file)
+  (with-canvas (:width 250 :height 180)
+    (set-rgb-fill 1 1 1)
+    (set-line-width 1)
+    (translate 10 10)
+    (centered-circle-path 0 0 5)
+    (fill-and-stroke)
+    (translate 15 15)
+    (centered-circle-path 0 0 8)
+    (fill-and-stroke)
+    (translate 20 24)
+    (centered-circle-path 0 0 11)
+    (fill-and-stroke)
+    (centered-ellipse-path 75 60 100 40)
+    (fill-and-stroke)
+    (let ((font (get-font "/home/xach/.fonts/vagron.ttf")))
+      (set-font font 25)
+      (translate -5 50)
+      (let ((bbox (string-bounding-box string font)))
+        (set-line-width 1)
+        (set-rgba-fill 1 0 0 0.5)
+        (rectangle (xmin bbox) (ymin bbox)
+                   (- (xmax bbox) (xmin bbox))
+                   (- (ymax bbox) (ymin bbox)))
+        (fill-path))
+      (set-rgb-fill 0 1 0)
+      (draw-string string))
+    (save-png file)))
+
+(defun center-test (string file)
+  (with-canvas (:width 200 :height 100)
+    (let ((font (get-font #p"times.ttf")))
+      (set-font font 36)
+      (draw-centered-string 100 25 string)
+      (set-rgba-fill 1 0 0 0.5)
+      (set-rgb-stroke 0 0 0)
+      (centered-circle-path 100 25 5)
+      (stroke)
+      (save-png file))))
+
+(defun twittertext (string size font file)
+  (zpb-ttf:with-font-loader (loader font)
+    (let ((bbox (string-bounding-box string size loader)))
+      (with-canvas (:width (- (ceiling (xmax bbox)) (floor (xmin bbox)))
+                           :height (- (ceiling (ymax bbox)) (floor (ymin bbox))))
+        (set-font loader size)
+        (set-rgba-fill 1 1 1 0.1)
+        (clear-canvas)
+        (set-rgb-fill 0 0 0)
+        (translate (- (xmin bbox)) (- (ymin bbox)))
+        (draw-string 0 0 string)
+        (save-png file)))))
+
+(defun arc-to (center-x center-y radius start extent)
+  ;; An arc of extent zero will generate an error at bezarc (divide by zero).
+  ;; This case may be given by two aligned points in a polyline.
+  ;; Better do nothing.
+  (unless (zerop extent)
+    (if (<= (abs extent) (/ pi 2.0))
+        (multiple-value-bind (x1 y1 x2 y2 x3 y3)
+            (bezarc center-x center-y radius start extent)
+          (curve-to x1 y1 x2 y2 x3 y3))
+        (let ((half-extent (/ extent 2.0)))
+          (arc-to center-x center-y radius start half-extent)
+          (arc-to center-x center-y radius (+ start half-extent) half-extent)))))
+
+(defun bezarc (center-x center-y radius start extent)
+  ;; start and extent should be in radians.
+  ;; Returns first-control-point-x first-control-point-y
+  ;;         second-control-point-x second-control-point-y
+  ;;         end-point-x end-point-y
+  (let* ((end (+ start extent))
+         (s-start (sin start)) (c-start (cos start))
+         (s-end (sin end)) (c-end (cos end))
+         (ang/2 (/ extent 2.0))
+         (kappa (* (/ 4.0 3.0)
+                   (/ (- 1 (cos ang/2))
+                      (sin ang/2))))
+	 (x1 (- c-start (* kappa s-start)))
+	 (y1 (+ s-start (* kappa c-start)))
+	 (x2 (+ c-end   (* kappa s-end)))
+	 (y2 (- s-end   (* kappa c-end))))
+    (values (+ (* x1 radius) center-x)(+ (* y1 radius) center-y)
+	    (+ (* x2 radius) center-x)(+ (* y2 radius) center-y)
+	    (+ (* c-end radius) center-x)(+ (* s-end radius) center-y))))
+
+(defun degrees (degrees)
+  (* (/ pi 180) degrees))
+
+(defun arc-test (file)
+  (with-canvas (:width 100 :height 100)
+    (rotate-degrees 15)
+    (translate 0 10)
+    (set-line-width 10)
+    (move-to 75 0)
+    (arc-to 0 0 75 0 (degrees 15))
+    (stroke)
+    (save-png file)))
+
+
+(defun rect-test (file)
+  (with-canvas (:width 5 :height 5)
+    (set-rgba-fill 1 0 0 0.5)
+    (rectangle 0 0 5 5)
+    (fill-path)
+    (save-png file)))
+
+(defun text-test (&key string size font file)
+  (with-canvas (:width 200 :height 200)
+    (let ((loader (get-font font)))
+      (set-rgb-fill 0.8 0.8 0.9)
+      (clear-canvas)
+      (set-font loader size)
+      (set-rgb-fill 0.0 0.0 0.3)
+      (scale 0.5 0.5)
+      (rotate (* 15 (/ pi 180)))
+      (draw-string 10 10 string)
+      (save-png file))))
+
+
+(defun dash-test (file)
+  (with-canvas (:width 200 :height 200)
+    (rectangle 10 10 125 125)
+    (set-rgba-fill 0.3 0.5 0.9 0.5)
+    (set-line-width 4)
+    (set-dash-pattern #(10 10) 5)
+    (fill-and-stroke)
+    (save-png file)))
+
+(defun sign-test (string font file &key
+                  (font-size 72)
+                  (outer-border 2)
+                  (stripe-width 5)
+                  (inner-border 2)
+                  (corner-radius 10))
+  (zpb-ttf:with-font-loader (loader font)
+    (let* ((bbox (string-bounding-box string font-size loader))
+           (text-height (ceiling (- (ymax bbox) (ymin bbox))))
+           (text-width (ceiling (- (xmax bbox) (xmin bbox))))
+           (stripe/2 (/ stripe-width 2.0))
+           (b1 (+ outer-border stripe/2))
+           (b2 (+ inner-border stripe/2))
+           (x0 0)
+           (x1 (+ x0 b1))
+           (x2 (+ x1 b2))
+           (y0 0)
+           (y1 (+ y0 b1))
+           (y2 (+ y1 b2))
+           (width (truncate (+ text-width (* 2 (+ b1 b2)))))
+           (width1 (- width (* b1 2)))
+           (height (truncate (+ text-height (* 2 (+ b1 b2)))))
+           (height1 (- height (* b1 2))))
+      (with-canvas (:width width :height height)
+        (set-rgb-fill 0.0 0.43 0.33)
+        (set-rgb-stroke 0.95 0.95 0.95)
+        ;; Stripe shadow + stripe
+        (set-line-width stripe-width)
+        (with-graphics-state
+          (translate 2 -2)
+          (set-rgba-stroke 0.0 0.0 0.0 0.3)
+          (rounded-rectangle x1 y1
+                             width1 height1
+                             corner-radius corner-radius)
+          (fill-and-stroke))
+        (rounded-rectangle x1 y1
+                           width1 height1
+                           corner-radius corner-radius)
+        (set-dash-pattern #(10 20) 0)
+        (stroke)
+        ;; Text shadow & text
+        (set-font loader font-size)
+        (translate (- (xmin bbox)) (- (ymin bbox)))
+        (with-graphics-state
+          (translate 1 -1)
+          (set-rgba-fill 0.0 0.0 0.0 1.0)
+          (draw-string x2 y2 string))
+        (set-rgb-fill 0.95 0.95 0.95)
+        (draw-string x2 y2 string)
+        (save-png file)))))
+
+
+           
+
+      
+
+
+
+
+
+(defun fill-test (file)
+  (with-canvas (:width 100 :height 100)
+    (set-rgb-stroke 1 0 0)
+    (set-rgb-fill 0 1 0)
+    (move-to 0 0)
+    (line-to 50 50)
+    (line-to 100 10)
+    (fill-and-stroke)
+    (save-png file)))
+
+(defun circle-test (file)
+  (with-canvas (:width 1000 :height 1000)
+    (scale 5 10)
+    (set-line-width 3)
+    (centered-circle-path 50 50 45)
+    (set-rgb-fill 1 1 0)
+    (fill-and-stroke)
+    (save-png file)))
+
+
+(defun pdf-circle (file)
+  (pdf:with-document ()
+    (pdf:with-page ()
+      (pdf:rotate 15)
+      (pdf:scale 10 5)
+      (pdf:set-line-width 3)
+      (pdf:circle 50 50 45)
+      (pdf:stroke))
+    (pdf:write-document file)))
+
+

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/text.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/text.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/text.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,135 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: text.lisp,v 1.8 2007/09/21 17:39:36 xach Exp $
+
+(in-package #:vecto)
+
+(defclass font ()
+  ((loader
+    :initarg :loader
+    :accessor loader)
+   (transform-matrix
+    :initarg :transform-matrix
+    :accessor transform-matrix)
+   (size
+    :initarg :size
+    :accessor size)))
+
+(defun glyph-path-point (point)
+  (paths:make-point (zpb-ttf:x point)
+                    (zpb-ttf:y point)))
+
+(defun glyph-paths (glyph)
+  (let* ((paths '())
+         (path nil))
+    (zpb-ttf:do-contours (contour glyph (nreverse paths))
+      (when (plusp (length contour))
+        (let ((first-point (aref contour 0)))
+          (setf path (paths:create-path :polygon))
+          (push path paths)
+          (paths:path-reset path (glyph-path-point first-point))
+          (zpb-ttf:do-contour-segments* (control end)
+              contour
+            (if control
+                (paths:path-extend path (paths:make-bezier-curve
+                                         (list (glyph-path-point control)))
+                                   (glyph-path-point end))
+                (paths:path-extend path (paths:make-straight-line)
+                                   (glyph-path-point end)))))))))
+
+(defun string-glyphs (string loader)
+  "Return STRING converted to a list of ZPB-TTF glyph objects from FONT."
+  (map 'list (lambda (char) (zpb-ttf:find-glyph char loader)) string))
+
+(defun string-paths (x y string font)
+  "Return the paths of STRING, transformed by the font scale of FONT."
+  (let ((glyphs (string-glyphs string (loader font)))
+        (loader (loader font))
+        (matrix (mult (transform-matrix font) (translation-matrix x y)))
+        (paths '()))
+    (loop for (glyph . rest) on glyphs do
+          (let ((glyph-paths (glyph-paths glyph))
+                (fun (make-transform-function matrix)))
+            (dolist (path glyph-paths)
+              (push (transform-path path fun) paths))
+            (when rest
+              (let* ((next (first rest))
+                     (offset (+ (zpb-ttf:advance-width glyph)
+                                (zpb-ttf:kerning-offset glyph next loader))))
+                (setf matrix (nmult (translation-matrix offset 0)
+                                    matrix))))))
+    paths))
+
+(defun nmerge-bounding-boxes (b1 b2)
+  "Create a minimal bounding box that covers both B1 and B2 and
+destructively update B1 with its values. Returns the new box."
+  (setf (xmin b1) (min (xmin b1) (xmin b2))
+        (ymin b1) (min (ymin b1) (ymin b2))
+        (xmax b1) (max (xmax b1) (xmax b2))
+        (ymax b1) (max (ymax b1) (ymax b2)))
+  b1)
+
+(defun advance-bounding-box (bbox offset)
+  "Return a bounding box advanced OFFSET units horizontally."
+  (vector (+ (xmin bbox) offset)
+          (ymin bbox)
+          (+ (xmax bbox) offset)
+          (ymax bbox)))
+
+(defun empty-bounding-box ()
+  (vector most-positive-fixnum most-positive-fixnum
+          most-negative-fixnum most-negative-fixnum))
+
+(defun ntransform-bounding-box (bbox fun)
+  "Return BBOX transformed by FUN; destructively modifies BBOX
+with the new values."
+  (setf (values (xmin bbox) (ymin bbox))
+        (funcall fun (xmin bbox) (ymin bbox))
+        (values (xmax bbox) (ymax bbox))
+        (funcall fun (xmax bbox) (ymax bbox)))
+  bbox)
+                 
+(defun loader-font-scale (size loader)
+  "Return the horizontal and vertical scaling needed to draw the
+glyphs of LOADER at SIZE units."
+  (float (/ size (zpb-ttf:units/em loader))))
+
+(defun string-bounding-box (string size loader)
+  (let* ((bbox (empty-bounding-box))
+         (scale (loader-font-scale size loader))
+         (fun (make-transform-function (scaling-matrix scale scale)))
+         (glyphs (string-glyphs string loader))
+         (offset 0))
+    (loop for (glyph . rest) on glyphs do
+          (let ((glyph-box (advance-bounding-box (bounding-box glyph) offset)))
+            (setf bbox (nmerge-bounding-boxes bbox glyph-box))
+            (incf offset (zpb-ttf:advance-width glyph))
+            (when rest
+              (let* ((next-glyph (first rest))
+                     (kerning (zpb-ttf:kerning-offset glyph next-glyph loader)))
+                (incf offset kerning)))))
+    (ntransform-bounding-box bbox fun)))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/transform-matrix.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/transform-matrix.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/transform-matrix.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,135 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: transform-matrix.lisp,v 1.6 2007/09/28 20:35:08 xach Exp $
+
+(in-package #:vecto)
+
+(defstruct (transform-matrix (:type vector))
+ (x-scale 1.0)
+ (y-skew 0.0)
+ (x-skew 0.0)
+ (y-scale 1.0)
+ (x-offset 0.0)
+ (y-offset 0.0))
+
+(defmacro matrix-bind (lambda-list vector &body body)
+  (when (/= (length lambda-list) 6)
+    (error "Bad lambda-list for MATRIX-BIND: 6 arguments required"))
+  (let ((vec (gensym)))
+  `(let ((,vec ,vector))
+     (let (,@(loop for i from 0 below 6
+                  for var in lambda-list
+                  collect (list var `(aref ,vec ,i))))
+       , at body))))
+
+(defun matrix (a b c d e f)
+  (vector a b c d e f))
+
+(defun make-transform-function (transform-matrix)
+  (matrix-bind (a b c d e f)
+      transform-matrix
+    (lambda (x y)
+      (values (+ (* a x) (* c y) e)
+              (+ (* b x) (* d y) f)))))
+
+(defun transform-coordinates (x y transform-matrix)
+  (matrix-bind (a b c d e f)
+      transform-matrix
+    (values (+ (* a x) (* c y) e)
+            (+ (* b x) (* d y) f))))
+
+
+;;; Multiplication:
+;;;
+;;;   a b 0     a*b*0
+;;;   c d 0  x  c*d*0
+;;;   e f 1     e*f*1
+
+(defun mult (m1 m2)
+  (matrix-bind (a b c d e f)
+      m1
+    (matrix-bind (a* b* c* d* e* f*)
+        m2
+      (matrix (+ (* a a*)
+                 (* b c*))
+              (+ (* a b*)
+                 (* b d*))
+              (+ (* c a*)
+                 (* d c*))
+              (+ (* c b*)
+                 (* d d*))
+              (+ (* e a*)
+                 (* f c*)
+                 e*)
+              (+ (* e b*)
+                 (* f d*)
+                 f*)))))
+
+(defun nmult (m1 m2)
+  "Destructive MULT; M2 is modified to hold the result of multiplication."
+  (matrix-bind (a b c d e f)
+      m1
+    (matrix-bind (a* b* c* d* e* f*)
+        m2
+      (setf (aref m2 0)
+            (+ (* a a*)
+               (* b c*))
+            (aref m2 1)
+            (+ (* a b*)
+               (* b d*))
+            (aref m2 2)
+            (+ (* c a*)
+               (* d c*))
+            (aref m2 3)
+            (+ (* c b*)
+               (* d d*))
+            (aref m2 4)
+            (+ (* e a*)
+               (* f c*)
+               e*)
+            (aref m2 5)
+            (+ (* e b*)
+               (* f d*)
+               f*))
+      m2)))
+
+(defun translation-matrix (tx ty)
+  (matrix 1 0 0 1 tx ty))
+
+(defun scaling-matrix (sx sy)
+  (matrix sx 0 0 sy 0 0))
+
+(defun rotation-matrix (theta)
+  (let ((cos (cos theta))
+        (sin (sin theta)))
+    (matrix cos sin (- sin) cos 0 0)))
+
+(defun skewing-matrix (alpha beta)
+  (matrix 1 (tan alpha) (tan beta) 1 0 0))
+
+(defun identity-matrix ()
+  (matrix 1.0 0.0 0.0 1.0 0.0 0.0))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/user-drawing.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/user-drawing.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/user-drawing.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,271 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: user-drawing.lisp,v 1.21 2007/10/01 14:12:55 xach Exp $
+
+(in-package #:vecto)
+
+(defvar *graphics-state*)
+(setf (documentation '*graphics-state* 'variable)
+      "The currently active graphics state. Bound for the
+      duration of WITH-GRAPICS-STATE.")
+
+;;; Low-level path construction
+
+(defun %move-to (state x y)
+  (let ((path (paths:create-path :open-polyline)))
+    (push (setf (path state) path) (paths state))
+    (paths:path-reset path (paths:make-point x y))))
+
+(defun %line-to (state x y)
+  (paths:path-extend (path state) (paths:make-straight-line)
+                     (paths:make-point x y)))
+
+(defun %curve-to (state cx1 cy1 cx2 cy2 x y)
+  "Draw a cubic Bezier curve from the current point to (x,y)
+through two control points."
+  (let ((control-point-1 (paths:make-point cx1 cy1))
+        (control-point-2 (paths:make-point cx2 cy2))
+        (end-point (paths:make-point x y)))
+    (paths:path-extend (path state)
+                       (paths:make-bezier-curve (list control-point-1
+                                                      control-point-2))
+                       end-point)))
+
+(defun %quadratic-to (state cx cy x y)
+  "Draw a quadratic Bezier curve from the current point to (x,y)
+through one control point."
+  (paths:path-extend (path state)
+                     (paths:make-bezier-curve (list (paths:make-point cx cy)))
+                     (paths:make-point x y)))
+
+(defun %close-subpath (state)
+  (setf (paths::path-type (path state)) :closed-polyline))
+
+;;; Clipping path
+
+(defun %end-path-no-op (state)
+  (after-painting state))
+
+(defun %clip-path (state)
+  (call-after-painting state
+                       (make-clipping-path-function state :nonzero-winding)))
+
+(defun %even-odd-clip-path (state)
+  (call-after-painting state
+                       (make-clipping-path-function state :even-odd)))
+
+;;; Text
+
+(defun %get-font (state file)
+  (find-font-loader state file))
+
+(defun %set-font (state loader size)
+  (let* ((scale (loader-font-scale size loader))
+         (matrix (scaling-matrix scale scale)))
+    (setf (font state)
+          (make-instance 'font
+                         :loader loader
+                         :transform-matrix matrix
+                         :size size))))
+
+(defun %draw-string (state x y string)
+  (let ((font (font state)))
+    (unless font
+      (error "No font currently set"))
+    (let ((paths (string-paths x y string font)))
+      (draw-paths/state paths state))))
+
+(defun %draw-centered-string (state x y string)
+  (let* ((font (font state))
+         (bbox (string-bounding-box string (size font) (loader font)))
+         (width/2 (/ (- (xmax bbox) (xmin bbox)) 2.0)))
+    (draw-string (- x width/2) y string)))
+
+
+;;; Low-level transforms
+
+(defun %translate (state tx ty)
+  (apply-matrix state (translation-matrix tx ty)))
+
+(defun %scale (state sx sy)
+  (apply-matrix state (scaling-matrix sx sy)))
+
+(defun %skew (state x y)
+  (apply-matrix state (skewing-matrix x y)))
+
+(defun %rotate (state radians)
+  (apply-matrix state (rotation-matrix radians)))
+
+;;; User-level commands
+
+(defun move-to (x y)
+  (%move-to *graphics-state* x y))
+
+(defun line-to (x y)
+  (%line-to *graphics-state* x y))
+
+(defun curve-to (cx1 cy1 cx2 cy2 x y)
+  (%curve-to *graphics-state* cx1 cy1 cx2 cy2 x y))
+
+(defun quadratic-to (cx cy x y)
+  (%quadratic-to *graphics-state* cx cy x y))
+
+(defun close-subpath ()
+  (%close-subpath *graphics-state*))
+
+(defun end-path-no-op ()
+  (%end-path-no-op *graphics-state*)
+  (clear-paths *graphics-state*))
+
+(defun clip-path ()
+  (%clip-path *graphics-state*))
+
+(defun even-odd-clip-path ()
+  (%even-odd-clip-path *graphics-state*))
+
+(defun get-font (file)
+  (%get-font *graphics-state* file))
+
+(defun set-font (font size)
+  (%set-font *graphics-state* font size))
+
+(defun draw-string (x y string)
+  (%draw-string *graphics-state* x y string))
+
+(defun draw-centered-string (x y string)
+  (%draw-centered-string *graphics-state* x y string))
+
+(defun set-dash-pattern (vector phase)
+  (if (zerop (length vector))
+      (setf (dash-vector *graphics-state*) nil
+            (dash-phase *graphics-state*) nil)
+      (setf (dash-vector *graphics-state*) vector
+            (dash-phase *graphics-state*) phase)))
+
+(defun set-line-cap (style)
+  (assert (member style '(:butt :square :round)))
+  (setf (cap-style *graphics-state*) style))
+
+(defun set-line-join (style)
+  (assert (member style '(:bevel :miter :round)))
+  (setf (join-style *graphics-state*) (if (eql style :bevel) :none style)))
+
+(defun set-line-width (width)
+  (setf (line-width *graphics-state*) width))
+
+(defun set-rgba-color (color r g b a)
+  (setf (red color) (clamp-range 0.0 r 1.0)
+        (green color) (clamp-range 0.0 g 1.0)
+        (blue color) (clamp-range 0.0 b 1.0)
+        (alpha color) (clamp-range 0.0 a 1.0))
+  color)
+
+(defun set-rgb-color (color r g b)
+  (setf (red color) (clamp-range 0.0 r 1.0)
+        (green color) (clamp-range 0.0 g 1.0)
+        (blue color) (clamp-range 0.0 b 1.0)
+        (alpha color) 1.0)
+  color)
+
+(defun set-rgb-stroke (r g b)
+  (set-rgb-color (stroke-color *graphics-state*) r g b))
+
+(defun set-rgba-stroke (r g b a)
+  (set-rgba-color (stroke-color *graphics-state*) r g b a))
+
+(defun set-rgb-fill (r g b)
+  (set-rgb-color (fill-color *graphics-state*) r g b))
+
+(defun set-rgba-fill (r g b a)
+  (set-rgba-color (fill-color *graphics-state*) r g b a))
+
+(defun stroke ()
+  (draw-stroked-paths *graphics-state*)
+  (clear-paths *graphics-state*))
+
+(defun fill-path ()
+  (draw-filled-paths *graphics-state*)
+  (after-painting *graphics-state*)
+  (clear-paths *graphics-state*))
+
+(defun even-odd-fill ()
+  (draw-even-odd-filled-paths *graphics-state*)
+  (after-painting *graphics-state*)
+  (clear-paths *graphics-state*))
+
+(defun fill-and-stroke ()
+  (draw-filled-paths *graphics-state*)
+  (draw-stroked-paths *graphics-state*)
+  (clear-paths *graphics-state*))
+
+(defun even-odd-fill-and-stroke ()
+  (draw-even-odd-filled-paths *graphics-state*)
+  (draw-stroked-paths *graphics-state*)
+  (after-painting *graphics-state*)
+  (clear-paths *graphics-state*))
+
+
+(defun clear-canvas ()
+  (let ((color (fill-color *graphics-state*)))
+    (fill-image (image-data *graphics-state*)
+                (red color)
+                (green color)
+                (blue color)
+                (alpha color))))
+
+(defun translate (x y)
+  (%translate *graphics-state* x y))
+
+(defun scale (x y)
+  (%scale *graphics-state* x y))
+
+(defun skew (x y)
+  (%skew *graphics-state* x y))
+
+(defun rotate (radians)
+  (%rotate *graphics-state* radians))
+
+(defun rotate-degrees (degrees)
+  (%rotate *graphics-state* (* (/ pi 180) degrees)))
+
+(defun save-png (file)
+  (png:write-png (image *graphics-state*) file))
+
+(defun save-png-stream (stream)
+  (png:write-png-stream (image *graphics-state*) stream))
+
+(defmacro with-canvas ((&key width height) &body body)
+  `(let ((*graphics-state* (make-instance 'graphics-state)))
+     (state-image *graphics-state* ,width ,height)
+     (unwind-protect
+          (progn
+            , at body)
+       (clear-state *graphics-state*))))
+
+(defmacro with-graphics-state (&body body)
+  `(let ((*graphics-state* (copy *graphics-state*)))
+     , at body))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/user-shortcuts.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/user-shortcuts.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/user-shortcuts.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,107 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: user-shortcuts.lisp,v 1.6 2007/09/21 01:39:07 xach Exp $
+
+(in-package #:vecto)
+
+(defconstant +kappa+ (* 4.d0 (/ (- (sqrt 2.0d0) 1.0d0) 3.0d0))
+  "From http://www.whizkidtech.redprince.net/bezier/circle/, the top
+Google hit for my vague recollection of this constant.")
+
+(defun centered-ellipse-path (x y rx ry)
+  "Add an elliptical subpath centered at X,Y with x radius RX and
+y radius RY."
+  (let ((cx (* rx +kappa+))
+        (cy (* ry +kappa+)))
+    ;; upper left
+    (move-to (- x rx) y)
+    (curve-to (- x rx) (+ y cy)
+              (- x cx) (+ y ry)
+              x (+ y ry))
+    ;; upper right
+    (curve-to (+ x cx) (+ y ry)
+              (+ x rx) (+ y cy)
+              (+ x rx) y)
+    ;; lower right
+    (curve-to (+ x rx) (- y cy)
+              (+ x cx) (- y ry)
+              x (- y ry))
+    (curve-to (- x cx) (- y ry)
+              (- x rx) (- y cy)
+              (- x rx) y)
+    (close-subpath)))
+
+(defun centered-circle-path (x y radius)
+  "Add a circular subpath centered at X,Y with radius RADIUS."
+  (centered-ellipse-path x y radius radius))
+
+(defun rectangle (x y width height)
+  (move-to x y)
+  (line-to (+ x width) y)
+  (line-to (+ x width) (+ y height))
+  (line-to x (+ y height))
+  (close-subpath))
+
+(defun rounded-rectangle (x y width height rx ry)
+  ;; FIXME: This should go counter-clockwise, like RECTANGLE!
+  (let* ((x3 (+ x width))
+         (x2 (- x3 rx))
+         (x1 (+ x rx))
+         (x0 x)
+         (xkappa (* rx +kappa+))
+         (y3 (+ y height))
+         (y2 (- y3 ry))
+         (y1 (+ y ry))
+         (y0 y)
+         (ykappa (* ry +kappa+)))
+    ;; west
+    (move-to x0 y1)
+    (line-to x0 y2)
+    ;; northwest
+    (curve-to x0 (+ y2 ykappa)
+              (- x1 xkappa) y3
+              x1 y3)
+    ;; north
+    (line-to x2 y3)
+    ;; northeast
+    (curve-to (+ x2 xkappa) y3
+              x3 (+ y2 ykappa)
+              x3 y2)
+    ;; east
+    (line-to x3 y1)
+    ;; southeast
+    (curve-to x3 (- y1 ykappa)
+              (+ x2 xkappa) y0
+              x2 y0)
+    ;; south
+    (line-to x1 y0)
+    ;; southwest
+    (curve-to (- x1 xkappa) y0
+              x0 (+ y0 ykappa)
+              x0 y1)
+    ;; fin
+    (close-subpath)))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/utils.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/utils.lisp	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/utils.lisp	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,40 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: utils.lisp,v 1.3 2007/09/20 17:41:21 xach Exp $
+
+(in-package #:vecto)
+
+(defun clamp-range (low value high)
+  (min (max value low) high))
+
+(defun float-octet (float)
+  "Convert a float in the range 0.0 - 1.0 to an octet."
+  (values (round (* float 255.0))))
+
+(defun octet-float (octet)
+  "Convert an octet to a float."
+  (/ octet 255.0))

Added: branches/trunk-reorg/thirdparty/vecto-1.0.2/vecto.asd
===================================================================
--- branches/trunk-reorg/thirdparty/vecto-1.0.2/vecto.asd	2007-10-05 06:02:12 UTC (rev 2218)
+++ branches/trunk-reorg/thirdparty/vecto-1.0.2/vecto.asd	2007-10-05 06:02:33 UTC (rev 2219)
@@ -0,0 +1,75 @@
+;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;;
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+;;;
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+;;; $Id: vecto.asd,v 1.10 2007/10/01 16:24:50 xach Exp $
+
+(asdf:defsystem #:vecto
+  :depends-on (#:cl-vectors
+               (:version #:salza-png "1.0.1")
+               #:zpb-ttf)
+  :version "1.0.2"
+  :components ((:file "package")
+               (:file "utils"
+                      :depends-on ("package"))
+               (:file "copy"
+                      :depends-on ("package"))
+               (:file "color"
+                      :depends-on ("package"
+                                   "copy"))
+               (:file "paths"
+                      :depends-on ("package"))
+               (:file "transform-matrix"
+                      :depends-on ("package"))
+               (:file "clipping-paths"
+                      :depends-on ("package"
+                                   "copy"))
+               (:file "graphics-state"
+                      :depends-on ("package"
+                                   "color"
+                                   "clipping-paths"
+                                   "transform-matrix"
+                                   "copy"))
+               (:file "drawing"
+                      :depends-on ("package"
+                                   "utils"
+                                   "paths"
+                                   "graphics-state"
+                                   "transform-matrix"))
+               (:file "text"
+                      :depends-on ("package"
+                                   "transform-matrix"
+                                   "graphics-state"
+                                   "drawing"))
+               (:file "user-drawing"
+                      :depends-on ("package"
+                                   "utils"
+                                   "clipping-paths"
+                                   "graphics-state"
+                                   "transform-matrix"
+                                   "text"))
+               (:file "user-shortcuts"
+                      :depends-on ("user-drawing"))))
+




More information about the Bknr-cvs mailing list