- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r2219 - in branches/trunk-reorg/thirdparty: . vecto-1.0.2 vecto-1.0.2/doc
by bknr＠bknr.net 05 Oct '07

05 Oct '07

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@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)))) + ,@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 + ,@body) + (clear-state *graphics-state*)))) + +(defmacro with-graphics-state (&body body) + `(let ((*graphics-state* (copy *graphics-state*))) + ,@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")))) +

1 0

[bknr-cvs] r2218 - branches/trunk-reorg/thirdparty
by bknr＠bknr.net 05 Oct '07

05 Oct '07

Author: hhubner Date: 2007-10-05 02:02:12 -0400 (Fri, 05 Oct 2007) New Revision: 2218 Removed: branches/trunk-reorg/thirdparty/cl-interpol/ branches/trunk-reorg/thirdparty/vecto-1.0.1/ Log: Update vecto

1 0

[bknr-cvs] r2217 - branches/trunk-reorg/projects/scrabble/src
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:51:42 -0400 (Thu, 04 Oct 2007) New Revision: 2217 Modified: branches/trunk-reorg/projects/scrabble/src/make-letters.lisp branches/trunk-reorg/projects/scrabble/src/scrabble.lisp branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp Log: Add english tile set. Modified: branches/trunk-reorg/projects/scrabble/src/make-letters.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/make-letters.lisp 2007-10-04 22:33:26 UTC (rev 2216) +++ branches/trunk-reorg/projects/scrabble/src/make-letters.lisp 2007-10-04 22:51:42 UTC (rev 2217) @@ -9,6 +9,12 @@ :triple-letter "DREIFACHER\nBUCHSTABEN\nWERT" :triple-word "DREIFACHER\nWORT\nWERT")) +(setf (gethash :en *special-tile-texts*) + '(:double-letter "DOUBLE\nLETTER\nSCORE" + :double-word "DOUBLE\nWORD\nSCORE" + :triple-letter "TRIPLE\nLETTER\nSCORE" + :triple-word "TRIPLE\nWORD\nSCORE")) + (defparameter *special-tile-colors* '(:double-letter (0.53 0.8 0.94) :double-word (0.97 0.67 0.6) Modified: branches/trunk-reorg/projects/scrabble/src/scrabble.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/scrabble.lisp 2007-10-04 22:33:26 UTC (rev 2216) +++ branches/trunk-reorg/projects/scrabble/src/scrabble.lisp 2007-10-04 22:51:42 UTC (rev 2217) @@ -24,36 +24,17 @@ (defparameter *tile-sets* (make-hash-table)) (setf (gethash :de *tile-sets*) - '((#\A 1 5) - (#\B 3 2) - (#\C 4 2) - (#\D 1 4) - (#\E 1 15) - (#\F 4 2) - (#\G 2 3) - (#\H 2 4) - (#\I 1 6) - (#\J 6 1) - (#\K 4 2) - (#\L 2 3) - (#\M 3 4) - (#\N 1 9) - (#\O 2 3) - (#\P 4 1) - (#\Q 10 1) - (#\R 1 6) - (#\S 1 7) - (#\T 1 6) - (#\U 1 6) - (#\V 6 1) - (#\W 3 1) - (#\X 8 1) - (#\Y 10 1) - (#\Z 3 1) - #-cmu (#\LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS 6 1) - #-cmu (#\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS 8 1) - #-cmu (#\LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS 6 1) + '((#\A 1 5) (#\B 3 2) (#\C 4 2) (#\D 1 4) (#\E 1 15) (#\F 4 2) (#\G 2 3) (#\H 2 4) (#\I 1 6) + (#\J 6 1) (#\K 4 2) (#\L 2 3) (#\M 3 4) (#\N 1 9) (#\O 2 3) (#\P 4 1) (#\Q 10 1) (#\R 1 6) + (#\S 1 7) (#\T 1 6) (#\U 1 6) (#\V 6 1) (#\W 3 1) (#\X 8 1) (#\Y 10 1) (#\Z 3 1) + (#\LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS 6 1) + (#\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS 8 1) + (#\LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS 6 1) (nil 0 2))) +(setf (gethash :en *tile-sets*) + '((#\A 1 9) (#\B 3 2) (#\C 3 2) (#\D 2 4) (#\E 1 12) (#\F 4 2) (#\G 2 3) (#\H 4 2) (#\I 1 9) + (#\J 8 1) (#\K 5 1) (#\L 1 4) (#\M 3 2) (#\N 1 6) (#\O 1 8) (#\P 3 2) (#\Q 10 1) (#\R 1 6) + (#\S 1 4) (#\T 1 6) (#\U 1 4) (#\V 4 2) (#\W 4 2) (#\X 8 1) (#\Y 4 2) (#\Z 10 1) (nil 0 2))) (define-condition invalid-move (simple-error) () Modified: branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp =================================================================== --- branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-10-04 22:33:26 UTC (rev 2216) +++ branches/trunk-reorg/projects/scrabble/src/start-webserver.lisp 2007-10-04 22:51:42 UTC (rev 2217) @@ -7,9 +7,9 @@ (defparameter *mochikit-directory* (make-pathname :name nil :type nil :version nil - :defaults (merge-pathnames #p"../../../../thirdparty/MochiKit/MochiKit/"))) + :defaults (merge-pathnames #p"../../../thirdparty/MochiKit/MochiKit/"))) -(when (and (boundp '*server*) *server) +(when (and (boundp '*server*) *server*) (stop-server *server*)) (setq *dispatch-table*

1 0

[bknr-cvs] r2216 - in branches/trunk-reorg/bknr/datastore: . doc experimental src
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:33:26 -0400 (Thu, 04 Oct 2007) New Revision: 2216 Added: branches/trunk-reorg/bknr/datastore/doc/README-orig branches/trunk-reorg/bknr/datastore/experimental/fswrap/ Removed: branches/trunk-reorg/bknr/datastore/README branches/trunk-reorg/bknr/datastore/src/fswrap/ Log: move around cruft Deleted: branches/trunk-reorg/bknr/datastore/README =================================================================== --- branches/trunk-reorg/bknr/datastore/README 2007-10-04 22:31:22 UTC (rev 2215) +++ branches/trunk-reorg/bknr/datastore/README 2007-10-04 22:33:26 UTC (rev 2216) @@ -1,48 +0,0 @@ -BKNR CODENAME: SPUTNIK - -Hans Huebner, David Lichteblau, Manuel Odendahl - -1. Introduction - -BKNR is a software launch platform for LISP satellites. You could -replace ``launch platform'' with framework and ``satellites'' with -``applications'', but that would be too many buzzwords. - -BKNR is made of facilities that are not very useful on their own, but -they can be used to quickly build shiny and elegant LISP -satellites. For example, a very important component of BKNR is its -datastore, which brings persistence to CLOS in a very simple way. By -adding a few declarations to your class definitions, you can have -persistent objects. You can also add XML import/export to your objects -in a similar way. I think this is the single most attractive feature -of BKNR: no more mapping from a relational database to LISP objects, -no more XML parsing and XML generation, you just write plain -application code. - -2. Installation - -BKNR has been developed with CMUCL 19a under FreeBSD, and has been -tested with Allegro Common Lisp 6.2 under Windows and Freebsd. Install -the BKNR sourcecode and the thirdparty sourcecode. - -Then configure the pathnames in bknr/init.lisp, and load -bknr/init.lisp. Afterwards, you can use ASDF to load the BKNR -facilities. - -To load the BKNR indices facility: -(asdf:oos 'asdf:load-op :bknr-indices) - -To load the BKNR datastore facility: -(asdf:oos 'asdf:load-op :bknr-indices) - -To load the BKNR impex facility: -(asdf:oos 'asdf:load-op :bknr-indices) - -To load the BKNR framework: -(asdf:oos 'asdf:load-op :bknr) - -3. Further documentation - -You can read the BKNR manual in bknr/doc/ . You can also browse the -sourcecode for the tutorials in bknr/src/indices/tutorial.lisp, -bknr/src/data/tutorial.lisp and bknr/src/xml-impex/tutorial.lisp. Copied: branches/trunk-reorg/bknr/datastore/doc/README-orig (from rev 2212, branches/trunk-reorg/bknr/datastore/README) Copied: branches/trunk-reorg/bknr/datastore/experimental/fswrap (from rev 2212, branches/trunk-reorg/bknr/datastore/src/fswrap)

1 0

[bknr-cvs] r2215 - branches/trunk-reorg/bknr/datastore
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:31:22 -0400 (Thu, 04 Oct 2007) New Revision: 2215 Removed: branches/trunk-reorg/bknr/datastore/init.lisp Log: cruft Deleted: branches/trunk-reorg/bknr/datastore/init.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/init.lisp 2007-10-04 22:26:55 UTC (rev 2214) +++ branches/trunk-reorg/bknr/datastore/init.lisp 2007-10-04 22:31:22 UTC (rev 2215) @@ -1,108 +0,0 @@ -(in-package :cl-user) - -;;;;;;;;;;;;; -;; Tweak this -(eval-when (:execute :compile-toplevel :load-toplevel) - #+allegro - (setf (logical-pathname-translations "bknr") - `(("**;*.*.*" "bknr/**/")) - (logical-pathname-translations "bknr-thirdparty") - `(("**;*.*.*" "thirdparty/**/")) - (logical-pathname-translations "eboy") - `(("**;*.*.*" "eboy/**/"))) - - #+cmu - (setf (logical-pathname-translations "bknr") - `(("**;*.*.*" "home:bknr-sputnik/bknr/**/")) - (logical-pathname-translations "bknr-thirdparty") - `(("**;*.*.*" "home:bknr-sputnik/thirdparty/**/")) - (logical-pathname-translations "eboy") - `(("**;*.*.*" "home:bknr-sputnik/eboy/**/"))) - - #+sbcl - (setf (logical-pathname-translations "bknr") - `(("**;*.*.*" - ,(merge-pathnames - (make-pathname :directory '(:relative "bknr-svn" "bknr" :wild-inferiors) - :name :wild - :type :wild - :version :wild) - (user-homedir-pathname)))) - (logical-pathname-translations "bknr-thirdparty") - `(("**;*.*.*" - ,(merge-pathnames - (make-pathname :directory '(:relative "bknr-svn" "thirdparty" :wild-inferiors) - :name :wild - :type :wild - :version :wild) - (user-homedir-pathname)))) - (logical-pathname-translations "eboy") - `(("**;*.*.*" - ,(merge-pathnames - (make-pathname :directory '(:relative "bknr-svn" "eboy" :wild-inferiors) - :name :wild - :type :wild - :version :wild) - (user-homedir-pathname)))))) - -(eval-when (:execute :compile-toplevel :load-toplevel) - #-sbcl - (load #p"bknr-thirdparty:asdf;asdf") - #+sbcl - (require :asdf)) - -(pushnew (translate-logical-pathname #p"bknr:src;") asdf:*central-registry* :test #'equal) -(pushnew (translate-logical-pathname #p"eboy:src;") asdf:*central-registry* :test #'equal) - -(defparameter *patch-directory* "bknr:patches;") - -(defun load-patches (&optional (directory *patch-directory*)) - (dolist (file (directory (merge-pathnames directory #p"patch-*.lisp"))) - (warn "; Loading patch from file ~A~%" file) - (load file))) - -(defun fix-dpd () - #+cmu - ;; Die Sache mit dem aktuellen Verzeichnis hat CMUCL noch immer nicht im - ;; Griff. Nachbessern! - (setf *default-pathname-defaults* - (pathname - (concatenate 'string - (nth-value 1 (unix:unix-current-directory)) - "/")))) - -(defun make-wild-pathname (type directory) - (merge-pathnames (make-pathname :type type - :name :wild - :directory '(:relative :wild-inferiors)) - directory)) - -(defun setup-registry () - (mapc #'(lambda (asd-pathname) - (pushnew (make-pathname :directory (pathname-directory asd-pathname)) - asdf:*central-registry* - :test #'equal)) - (append (directory #p"bknr-thirdparty:**;*.asd") - (directory #p"bknr:**;*.asd")))) - -(defun clean-registry (&optional (dirs asdf:*central-registry*)) - (let ((files (mapcan #'directory - (mapcan #'(lambda (dir) - (when (pathnamep dir) - (list (make-wild-pathname "fas" dir) - (make-wild-pathname "lib" dir) - (make-wild-pathname "x86f" dir) - (make-wild-pathname "fasl" dir)))) - dirs)))) - (dolist (file files) - (when (probe-file file) - (format t "Deleting binary file ~S~%" file) - (delete-file file))))) - -#+cmu -(load-patches) - -(setup-registry) -(fix-dpd) - -(pushnew :cl-gd-gif *features*)

1 0

[bknr-cvs] r2214 - in branches/trunk-reorg/bknr/datastore: . src
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:26:55 -0400 (Thu, 04 Oct 2007) New Revision: 2214 Added: branches/trunk-reorg/bknr/datastore/src/xml/ Removed: branches/trunk-reorg/bknr/datastore/xml/ Log: move xml compatibility stuff under src Copied: branches/trunk-reorg/bknr/datastore/src/xml (from rev 2212, branches/trunk-reorg/bknr/datastore/xml)

1 0

[bknr-cvs] r2213 - in branches/trunk-reorg: . bknr projects
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:25:38 -0400 (Thu, 04 Oct 2007) New Revision: 2213 Added: branches/trunk-reorg/projects/ branches/trunk-reorg/projects/scrabble/ Removed: branches/trunk-reorg/bknr/projects/ Log: move projects upstairs, as they are not part of the framework Copied: branches/trunk-reorg/projects (from rev 2195, branches/trunk-reorg/bknr/projects) Copied: branches/trunk-reorg/projects/scrabble (from rev 2212, branches/trunk-reorg/bknr/projects/scrabble)

1 0

[bknr-cvs] r2212 - in branches/trunk-reorg: bknr/datastore/src bknr/datastore/src/utils bknr/projects/scrabble bknr/projects/scrabble/src bknr/projects/scrabble/website/de thirdparty/cxml-2007-08-05/xml
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 18:22:16 -0400 (Thu, 04 Oct 2007) New Revision: 2212 Added: branches/trunk-reorg/bknr/projects/scrabble/src/start-webserver.lisp branches/trunk-reorg/bknr/projects/scrabble/website/de/charmap.xml branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.html branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.js Removed: branches/trunk-reorg/bknr/datastore/src/utils/base64.lisp branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html Modified: branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd branches/trunk-reorg/bknr/projects/scrabble/ branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp Log: Serves static pages through hunchentoot Modified: branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd 2007-10-04 22:22:16 UTC (rev 2212) @@ -31,7 +31,6 @@ (:file "actor" :depends-on ("utils")) (:file "reader" :depends-on ("utils")) (:file "crypt-md5" :depends-on ("utils")) - (:file "base64" :depends-on ("utils")) (:file "capability" :depends-on ("utils")) (:file "make-fdf-file" :depends-on ("utils")) (:file "date-calc") Deleted: branches/trunk-reorg/bknr/datastore/src/utils/base64.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/utils/base64.lisp 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/datastore/src/utils/base64.lisp 2007-10-04 22:22:16 UTC (rev 2212) @@ -1,75 +0,0 @@ -;;;; This file implements the Base64 transfer encoding algorithm as -;;;; defined in RFC 1521 by Borensten & Freed, September 1993. -;;;; -;;;; Written by Juri Pakaste <juri(a)iki.fi>. It is in the public -;;;; domain. Input is welcome. -;;;; -;;;; $Id$ - -(defpackage "BASE64" - (:use "CL") - (:export #:base64-encode #:base64-decode)) - -(in-package :base64) - -(defparameter *encode-table* - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=") - -(defparameter *decode-table* - (let ((da (make-array (list 256) - :element-type 'integer - :initial-element 0))) - (loop for character across *encode-table* - for index from 0 below 64 - do (setf (elt da (char-code character)) index)) - da)) - -(defun base64-encode (string) - (let ((result (make-array - (list (* 4 (truncate (/ (+ 2 (length string)) 3)))) - :element-type 'base-char))) - (do ((sidx 0 (+ sidx 3)) - (didx 0 (+ didx 4)) - (chars 2 2) - (value nil nil)) - ((>= sidx (length string)) t) - (setf value (ash (logand #xFF (char-code (char string sidx))) 8)) - (dotimes (n 2) - (when (< (+ sidx n 1) (length string)) - (setf value - (logior value - (logand #xFF (char-code (char string (+ sidx n 1)))))) - (incf chars)) - (when (= n 0) - (setf value (ash value 8)))) - (setf (elt result (+ didx 3)) - (elt *encode-table* (if (> chars 3) (logand value #x3F) 64))) - (setf value (ash value -6)) - (setf (elt result (+ didx 2)) - (elt *encode-table* (if (> chars 2) (logand value #x3F) 64))) - (setf value (ash value -6)) - (setf (elt result (+ didx 1)) - (elt *encode-table* (logand value #x3F))) - (setf value (ash value -6)) - (setf (elt result didx) - (elt *encode-table* (logand value #x3F)))) - result)) - -(defun base64-decode (string) - (let ((result (make-array (* 3 (truncate (/ (length string) 4))) - :element-type 'base-char)) - (ridx 0)) - (loop for schar across string - for svalue = (elt *decode-table* (char-code schar)) - with bitstore = 0 - with bitcount = 0 - do (unless (null svalue) - (setf bitstore (logior (ash bitstore 6) svalue)) - (incf bitcount 6) - (when (>= bitcount 8) - (decf bitcount 8) - (setf (elt result ridx) - (code-char (logand (ash bitstore (- bitcount)) #xFF))) - (incf ridx) - (setf bitstore (logand bitstore #xFF))))) - (subseq result 0 ridx))) Property changes on: branches/trunk-reorg/bknr/projects/scrabble ___________________________________________________________________ Name: svn:ignore + fonts Modified: branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp 2007-10-04 22:22:16 UTC (rev 2212) @@ -21,24 +21,38 @@ (defun make-letter-tile (char score) (with-canvas (:width 34 :height 34) - (let ((bold-font (get-font *bold-font*)) - (regular-font (get-font *regular-font*)) - (char-string (make-string 1 :initial-element char))) + (let* ((bold-font (get-font *bold-font*)) + (regular-font (get-font *regular-font*)) + (char-string (princ-to-string char)) + (pathname (make-pathname :name (if (and char (> (char-code char) 127)) + (char-name char) + char-string) + :type "png"))) (set-rgb-fill 1.0 0.98 0.8) (rounded-rectangle 0 0 34 34 4 4) (fill-path) - (set-rgb-fill 0 0 0) - (set-font bold-font 27) - (draw-centered-string 13 7 char-string) - (set-font regular-font 11) - (draw-centered-string 26 3 (princ-to-string score)) - (save-png (make-pathname :name char-string :type "png"))))) + (when char + (set-rgb-fill 0 0 0) + (set-font bold-font 27) + (draw-centered-string 13 7 char-string) + (set-font regular-font 11) + (draw-centered-string 26 3 (princ-to-string score))) + (save-png pathname) + pathname))) (defun make-letter-tile-set (language) - (dolist (entry (gethash language *tile-sets*)) - (destructuring-bind (letter score count) entry - (declare (ignore count)) - (make-letter-tile letter score)))) + (with-open-file (letter-map-file "charmap.xml" + :direction :output + :if-exists :supersede + :external-format :utf-8) + (cxml:with-xml-output (cxml:make-character-stream-sink letter-map-file) + (cxml:with-element "chars" + (dolist (entry (gethash language *tile-sets*)) + (destructuring-bind (letter score count) entry + (declare (ignore count)) + (cxml:with-element "char" + (cxml:attribute "filename" (namestring (make-letter-tile letter score))) + (cxml:text (princ-to-string letter))))))))) (defun make-special-tile (name color &key text star) (with-canvas (:width 40 :height 40) @@ -63,10 +77,12 @@ (make-special-tile :standard (getf *special-tile-colors* :standard) :star t)) -(defun make-tile-set (language) - (let ((*default-pathname-defaults* (merge-pathnames - (make-pathname :directory (list :relative - (string-downcase (symbol-name language))))))) +(defun make-tile-set (directory language) + (let ((*default-pathname-defaults* + (merge-pathnames (merge-pathnames (make-pathname + :directory (list :relative (string-downcase (symbol-name language)))) + directory)))) (ensure-directories-exist *default-pathname-defaults*) (make-letter-tile-set language) - (make-special-tile-set language))) \ No newline at end of file + (make-special-tile-set language))) + Modified: branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp 2007-10-04 22:22:16 UTC (rev 2212) @@ -8,4 +8,7 @@ (defpackage :scrabble.graphics (:use :cl :alexandria :vecto :scrabble) (:shadowing-import-from :vecto "ROTATE")) + +(defpackage :scrabble.web + (:use :cl :alexandria :hunchentoot :scrabble)) \ No newline at end of file Modified: branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd 2007-10-04 22:22:16 UTC (rev 2212) @@ -10,7 +10,7 @@ (defsystem :scrabble :name "Scrabble" :licence "BSD" - :depends-on (:bknr-datastore :vecto :alexandria :anaphora) + :depends-on (:bknr-datastore :hunchentoot :cxml :vecto :alexandria :anaphora) :serial t :components ((:file "package") (:file "scrabble") Added: branches/trunk-reorg/bknr/projects/scrabble/src/start-webserver.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/start-webserver.lisp 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/src/start-webserver.lisp 2007-10-04 22:22:16 UTC (rev 2212) @@ -0,0 +1,19 @@ + +(in-package :scrabble.web) + +(defparameter *website-directory* + (make-pathname :name nil :type nil :version nil + :defaults (merge-pathnames #p"../website/" *load-truename*))) + +(defparameter *mochikit-directory* + (make-pathname :name nil :type nil :version nil + :defaults (merge-pathnames #p"../../../../thirdparty/MochiKit/MochiKit/"))) + +(when (and (boundp '*server*) *server) + (stop-server *server*)) + +(setq *dispatch-table* + (list (create-folder-dispatcher-and-handler "/MochiKit/" *mochikit-directory*) + (create-folder-dispatcher-and-handler "/scrabble/" *website-directory*))) + +(setq *server* (start-server :port 4242)) \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/charmap.xml =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/charmap.xml 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/charmap.xml 2007-10-04 22:22:16 UTC (rev 2212) @@ -0,0 +1,2 @@ +<?xml version="1.0" encoding="UTF-8"?> +<chars><char filename="A.png">A</char><char filename="B.png">B</char><char filename="C.png">C</char><char filename="D.png">D</char><char filename="E.png">E</char><char filename="F.png">F</char><char filename="G.png">G</char><char filename="H.png">H</char><char filename="I.png">I</char><char filename="J.png">J</char><char filename="K.png">K</char><char filename="L.png">L</char><char filename="M.png">M</char><char filename="N.png">N</char><char filename="O.png">O</char><char filename="P.png">P</char><char filename="Q.png">Q</char><char filename="R.png">R</char><char filename="S.png">S</char><char filename="T.png">T</char><char filename="U.png">U</char><char filename="V.png">V</char><char filename="W.png">W</char><char filename="X.png">X</char><char filename="Y.png">Y</char><char filename="Z.png">Z</char><char filename="LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS.png">Ä</char><char filename="LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS.png">Ö</char><char filename="LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS.png">Ü</char><char filename="NIL.png">NIL</char></chars> \ No newline at end of file Modified: branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css 2007-10-04 22:22:16 UTC (rev 2212) @@ -1,3 +1,4 @@ +body { background-color: #004B36 } #playfield { position: absolute } #playfield div { position: absolute; width: 40px; height: 40px } #playfield img { position: absolute; top: 3px; left: 3px } Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.html =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.html 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.html 2007-10-04 22:22:16 UTC (rev 2212) @@ -0,0 +1,236 @@ +<html> + <head> + <link rel="stylesheet" type="text/css" href="scrabble.css" /> + <script type="text/javascript" src="/MochiKit/MochiKit.js"> </script> + <script type="text/javascript" src="scrabble.js"> </script> + </head> + <body onload="init()"> + <div id='playfield'> + <div id='field-0-0'/></div> + <div id='field-0-1'/></div> + <div id='field-0-2'/></div> + <div id='field-0-3'/></div> + <div id='field-0-4'/></div> + <div id='field-0-5'/></div> + <div id='field-0-6'/></div> + <div id='field-0-7'/></div> + <div id='field-0-8'/></div> + <div id='field-0-9'/></div> + <div id='field-0-10'/></div> + <div id='field-0-11'/></div> + <div id='field-0-12'/></div> + <div id='field-0-13'/></div> + <div id='field-0-14'/></div> + <div id='field-1-0'/></div> + <div id='field-1-1'/></div> + <div id='field-1-2'/></div> + <div id='field-1-3'/></div> + <div id='field-1-4'/></div> + <div id='field-1-5'/></div> + <div id='field-1-6'/></div> + <div id='field-1-7'/></div> + <div id='field-1-8'/></div> + <div id='field-1-9'/></div> + <div id='field-1-10'/></div> + <div id='field-1-11'/></div> + <div id='field-1-12'/></div> + <div id='field-1-13'/></div> + <div id='field-1-14'/></div> + <div id='field-2-0'/></div> + <div id='field-2-1'/></div> + <div id='field-2-2'/></div> + <div id='field-2-3'/></div> + <div id='field-2-4'/></div> + <div id='field-2-5'/></div> + <div id='field-2-6'/></div> + <div id='field-2-7'/></div> + <div id='field-2-8'/></div> + <div id='field-2-9'/></div> + <div id='field-2-10'/></div> + <div id='field-2-11'/></div> + <div id='field-2-12'/></div> + <div id='field-2-13'/></div> + <div id='field-2-14'/></div> + <div id='field-3-0'/></div> + <div id='field-3-1'/></div> + <div id='field-3-2'/></div> + <div id='field-3-3'/></div> + <div id='field-3-4'/></div> + <div id='field-3-5'/></div> + <div id='field-3-6'/></div> + <div id='field-3-7'/></div> + <div id='field-3-8'/></div> + <div id='field-3-9'/></div> + <div id='field-3-10'/></div> + <div id='field-3-11'/></div> + <div id='field-3-12'/></div> + <div id='field-3-13'/></div> + <div id='field-3-14'/></div> + <div id='field-4-0'/></div> + <div id='field-4-1'/></div> + <div id='field-4-2'/></div> + <div id='field-4-3'/></div> + <div id='field-4-4'/></div> + <div id='field-4-5'/></div> + <div id='field-4-6'/></div> + <div id='field-4-7'/></div> + <div id='field-4-8'/></div> + <div id='field-4-9'/></div> + <div id='field-4-10'/></div> + <div id='field-4-11'/></div> + <div id='field-4-12'/></div> + <div id='field-4-13'/></div> + <div id='field-4-14'/></div> + <div id='field-5-0'/></div> + <div id='field-5-1'/></div> + <div id='field-5-2'/></div> + <div id='field-5-3'/></div> + <div id='field-5-4'/></div> + <div id='field-5-5'/></div> + <div id='field-5-6'/></div> + <div id='field-5-7'/></div> + <div id='field-5-8'/></div> + <div id='field-5-9'/></div> + <div id='field-5-10'/></div> + <div id='field-5-11'/></div> + <div id='field-5-12'/></div> + <div id='field-5-13'/></div> + <div id='field-5-14'/></div> + <div id='field-6-0'/></div> + <div id='field-6-1'/></div> + <div id='field-6-2'/></div> + <div id='field-6-3'/></div> + <div id='field-6-4'/></div> + <div id='field-6-5'/></div> + <div id='field-6-6'/></div> + <div id='field-6-7'/></div> + <div id='field-6-8'/></div> + <div id='field-6-9'/></div> + <div id='field-6-10'/></div> + <div id='field-6-11'/></div> + <div id='field-6-12'/></div> + <div id='field-6-13'/></div> + <div id='field-6-14'/></div> + <div id='field-7-0'/></div> + <div id='field-7-1'/></div> + <div id='field-7-2'/></div> + <div id='field-7-3'/></div> + <div id='field-7-4'/></div> + <div id='field-7-5'/></div> + <div id='field-7-6'/></div> + <div id='field-7-7'/></div> + <div id='field-7-8'/></div> + <div id='field-7-9'/></div> + <div id='field-7-10'/></div> + <div id='field-7-11'/></div> + <div id='field-7-12'/></div> + <div id='field-7-13'/></div> + <div id='field-7-14'/></div> + <div id='field-8-0'/></div> + <div id='field-8-1'/></div> + <div id='field-8-2'/></div> + <div id='field-8-3'/></div> + <div id='field-8-4'/></div> + <div id='field-8-5'/></div> + <div id='field-8-6'/></div> + <div id='field-8-7'/></div> + <div id='field-8-8'/></div> + <div id='field-8-9'/></div> + <div id='field-8-10'/></div> + <div id='field-8-11'/></div> + <div id='field-8-12'/></div> + <div id='field-8-13'/></div> + <div id='field-8-14'/></div> + <div id='field-9-0'/></div> + <div id='field-9-1'/></div> + <div id='field-9-2'/></div> + <div id='field-9-3'/></div> + <div id='field-9-4'/></div> + <div id='field-9-5'/></div> + <div id='field-9-6'/></div> + <div id='field-9-7'/></div> + <div id='field-9-8'/></div> + <div id='field-9-9'/></div> + <div id='field-9-10'/></div> + <div id='field-9-11'/></div> + <div id='field-9-12'/></div> + <div id='field-9-13'/></div> + <div id='field-9-14'/></div> + <div id='field-10-0'/></div> + <div id='field-10-1'/></div> + <div id='field-10-2'/></div> + <div id='field-10-3'/></div> + <div id='field-10-4'/></div> + <div id='field-10-5'/></div> + <div id='field-10-6'/></div> + <div id='field-10-7'/></div> + <div id='field-10-8'/></div> + <div id='field-10-9'/></div> + <div id='field-10-10'/></div> + <div id='field-10-11'/></div> + <div id='field-10-12'/></div> + <div id='field-10-13'/></div> + <div id='field-10-14'/></div> + <div id='field-11-0'/></div> + <div id='field-11-1'/></div> + <div id='field-11-2'/></div> + <div id='field-11-3'/></div> + <div id='field-11-4'/></div> + <div id='field-11-5'/></div> + <div id='field-11-6'/></div> + <div id='field-11-7'/></div> + <div id='field-11-8'/></div> + <div id='field-11-9'/></div> + <div id='field-11-10'/></div> + <div id='field-11-11'/></div> + <div id='field-11-12'/></div> + <div id='field-11-13'/></div> + <div id='field-11-14'/></div> + <div id='field-12-0'/></div> + <div id='field-12-1'/></div> + <div id='field-12-2'/></div> + <div id='field-12-3'/></div> + <div id='field-12-4'/></div> + <div id='field-12-5'/></div> + <div id='field-12-6'/></div> + <div id='field-12-7'/></div> + <div id='field-12-8'/></div> + <div id='field-12-9'/></div> + <div id='field-12-10'/></div> + <div id='field-12-11'/></div> + <div id='field-12-12'/></div> + <div id='field-12-13'/></div> + <div id='field-12-14'/></div> + <div id='field-13-0'/></div> + <div id='field-13-1'/></div> + <div id='field-13-2'/></div> + <div id='field-13-3'/></div> + <div id='field-13-4'/></div> + <div id='field-13-5'/></div> + <div id='field-13-6'/></div> + <div id='field-13-7'/></div> + <div id='field-13-8'/></div> + <div id='field-13-9'/></div> + <div id='field-13-10'/></div> + <div id='field-13-11'/></div> + <div id='field-13-12'/></div> + <div id='field-13-13'/></div> + <div id='field-13-14'/></div> + <div id='field-14-0'/></div> + <div id='field-14-1'/></div> + <div id='field-14-2'/></div> + <div id='field-14-3'/></div> + <div id='field-14-4'/></div> + <div id='field-14-5'/></div> + <div id='field-14-6'/></div> + <div id='field-14-7'/></div> + <div id='field-14-8'/></div> + <div id='field-14-9'/></div> + <div id='field-14-10'/></div> + <div id='field-14-11'/></div> + <div id='field-14-12'/></div> + <div id='field-14-13'/></div> + <div id='field-14-14'/></div> + </div> + </body> +</html> \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.js =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.js 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.js 2007-10-04 22:22:16 UTC (rev 2212) @@ -0,0 +1,22 @@ +// -*- Java -*- (really Javascript) + +function setLetter(x, y, letter) { + $('field-' + x + '-' + y).innerHTML = '<img src="' + letter + '.png"/>'; +} + +function setWord(x, y, word, down) { + for (i = 0; i < word.length; i++) { + setLetter(x, y, word.charAt(i)); + if (down) { + y++; + } else { + x++; + } + }; +} + +function init() { + setWord(6, 6, "ICH"); + setWord(7, 7, "LIEBE"); + setWord(8, 8, "DICH"); +} Deleted: branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html 2007-10-04 22:22:16 UTC (rev 2212) @@ -1,268 +0,0 @@ -<head> - <link rel="stylesheet" type="text/css" href="scrabble.css" /> -</head> -<body bgcolor="#004B36"> -<img src="A.png"/> -<img src="B.png"/> -<img src="C.png"/> -<img src="D.png"/> -<img src="E.png"/> -<img src="F.png"/> -<img src="G.png"/> -<img src="H.png"/> -<img src="I.png"/> -<img src="J.png"/> -<img src="K.png"/> -<img src="L.png"/> -<img src="M.png"/> -<img src="N.png"/> -<img src="O.png"/> -<img src="P.png"/> -<img src="Q.png"/> -<img src="R.png"/> -<img src="S.png"/> -<img src="T.png"/> -<img src="U.png"/> -<img src="V.png"/> -<img src="W.png"/> -<img src="X.png"/> -<img src="Y.png"/> -<img src="Z.png"/> -<img src="�.png"/> -<img src="�.png"/> -<img src="�.png"/> -<br> -<img src="double-letter.png"/> -<img src="double-word.png"/> -<img src="triple-letter.png"/> -<img src="triple-word.png"/> -<img src="standard.png"/> -<br/> -<div id='playfield'> - <div id='field-0-0'/></div> - <div id='field-0-1'/></div> - <div id='field-0-2'/></div> - <div id='field-0-3'/></div> - <div id='field-0-4'/></div> - <div id='field-0-5'/></div> - <div id='field-0-6'/></div> - <div id='field-0-7'/></div> - <div id='field-0-8'/></div> - <div id='field-0-9'/></div> - <div id='field-0-10'/></div> - <div id='field-0-11'/></div> - <div id='field-0-12'/></div> - <div id='field-0-13'/></div> - <div id='field-0-14'/></div> - <div id='field-1-0'/></div> - <div id='field-1-1'/></div> - <div id='field-1-2'/></div> - <div id='field-1-3'/></div> - <div id='field-1-4'/></div> - <div id='field-1-5'/></div> - <div id='field-1-6'/></div> - <div id='field-1-7'/></div> - <div id='field-1-8'/></div> - <div id='field-1-9'/></div> - <div id='field-1-10'/></div> - <div id='field-1-11'/></div> - <div id='field-1-12'/></div> - <div id='field-1-13'/></div> - <div id='field-1-14'/></div> - <div id='field-2-0'/><img src="I.png"/></div> - <div id='field-2-1'/><img src="C.png"/></div> - <div id='field-2-2'/><img src="H.png"/></div> - <div id='field-2-3'/></div> - <div id='field-2-4'/></div> - <div id='field-2-5'/></div> - <div id='field-2-6'/></div> - <div id='field-2-7'/></div> - <div id='field-2-8'/></div> - <div id='field-2-9'/></div> - <div id='field-2-10'/></div> - <div id='field-2-11'/></div> - <div id='field-2-12'/></div> - <div id='field-2-13'/></div> - <div id='field-2-14'/></div> - <div id='field-3-0'/></div> - <div id='field-3-1'/></div> - <div id='field-3-2'/><img src="L.png"/></div> - <div id='field-3-3'/><img src="I.png"/></div> - <div id='field-3-4'/><img src="E.png"/></div> - <div id='field-3-5'/><img src="B.png"/></div> - <div id='field-3-6'/><img src="E.png"/></div> - <div id='field-3-7'/></div> - <div id='field-3-8'/></div> - <div id='field-3-9'/></div> - <div id='field-3-10'/></div> - <div id='field-3-11'/></div> - <div id='field-3-12'/></div> - <div id='field-3-13'/></div> - <div id='field-3-14'/></div> - <div id='field-4-0'/></div> - <div id='field-4-1'/></div> - <div id='field-4-2'/><img src="D.png"/></div> - <div id='field-4-3'/><img src="I.png"/></div> - <div id='field-4-4'/><img src="C.png"/></div> - <div id='field-4-5'/><img src="H.png"/></div> - <div id='field-4-6'/></div> - <div id='field-4-7'/></div> - <div id='field-4-8'/></div> - <div id='field-4-9'/></div> - <div id='field-4-10'/></div> - <div id='field-4-11'/></div> - <div id='field-4-12'/></div> - <div id='field-4-13'/></div> - <div id='field-4-14'/></div> - <div id='field-5-0'/></div> - <div id='field-5-1'/></div> - <div id='field-5-2'/></div> - <div id='field-5-3'/></div> - <div id='field-5-4'/></div> - <div id='field-5-5'/></div> - <div id='field-5-6'/></div> - <div id='field-5-7'/></div> - <div id='field-5-8'/></div> - <div id='field-5-9'/></div> - <div id='field-5-10'/></div> - <div id='field-5-11'/></div> - <div id='field-5-12'/></div> - <div id='field-5-13'/></div> - <div id='field-5-14'/></div> - <div id='field-6-0'/></div> - <div id='field-6-1'/></div> - <div id='field-6-2'/></div> - <div id='field-6-3'/></div> - <div id='field-6-4'/></div> - <div id='field-6-5'/></div> - <div id='field-6-6'/></div> - <div id='field-6-7'/></div> - <div id='field-6-8'/></div> - <div id='field-6-9'/></div> - <div id='field-6-10'/></div> - <div id='field-6-11'/></div> - <div id='field-6-12'/></div> - <div id='field-6-13'/></div> - <div id='field-6-14'/></div> - <div id='field-7-0'/></div> - <div id='field-7-1'/></div> - <div id='field-7-2'/></div> - <div id='field-7-3'/></div> - <div id='field-7-4'/></div> - <div id='field-7-5'/></div> - <div id='field-7-6'/></div> - <div id='field-7-7'/></div> - <div id='field-7-8'/></div> - <div id='field-7-9'/></div> - <div id='field-7-10'/></div> - <div id='field-7-11'/></div> - <div id='field-7-12'/></div> - <div id='field-7-13'/></div> - <div id='field-7-14'/></div> - <div id='field-8-0'/></div> - <div id='field-8-1'/></div> - <div id='field-8-2'/></div> - <div id='field-8-3'/></div> - <div id='field-8-4'/></div> - <div id='field-8-5'/></div> - <div id='field-8-6'/></div> - <div id='field-8-7'/></div> - <div id='field-8-8'/></div> - <div id='field-8-9'/></div> - <div id='field-8-10'/></div> - <div id='field-8-11'/></div> - <div id='field-8-12'/></div> - <div id='field-8-13'/></div> - <div id='field-8-14'/></div> - <div id='field-9-0'/></div> - <div id='field-9-1'/></div> - <div id='field-9-2'/></div> - <div id='field-9-3'/></div> - <div id='field-9-4'/></div> - <div id='field-9-5'/></div> - <div id='field-9-6'/></div> - <div id='field-9-7'/></div> - <div id='field-9-8'/></div> - <div id='field-9-9'/></div> - <div id='field-9-10'/></div> - <div id='field-9-11'/></div> - <div id='field-9-12'/></div> - <div id='field-9-13'/></div> - <div id='field-9-14'/></div> - <div id='field-10-0'/></div> - <div id='field-10-1'/></div> - <div id='field-10-2'/></div> - <div id='field-10-3'/></div> - <div id='field-10-4'/></div> - <div id='field-10-5'/></div> - <div id='field-10-6'/></div> - <div id='field-10-7'/></div> - <div id='field-10-8'/></div> - <div id='field-10-9'/></div> - <div id='field-10-10'/></div> - <div id='field-10-11'/></div> - <div id='field-10-12'/></div> - <div id='field-10-13'/></div> - <div id='field-10-14'/></div> - <div id='field-11-0'/></div> - <div id='field-11-1'/></div> - <div id='field-11-2'/></div> - <div id='field-11-3'/></div> - <div id='field-11-4'/></div> - <div id='field-11-5'/></div> - <div id='field-11-6'/></div> - <div id='field-11-7'/></div> - <div id='field-11-8'/></div> - <div id='field-11-9'/></div> - <div id='field-11-10'/></div> - <div id='field-11-11'/></div> - <div id='field-11-12'/></div> - <div id='field-11-13'/></div> - <div id='field-11-14'/></div> - <div id='field-12-0'/></div> - <div id='field-12-1'/></div> - <div id='field-12-2'/></div> - <div id='field-12-3'/></div> - <div id='field-12-4'/></div> - <div id='field-12-5'/></div> - <div id='field-12-6'/></div> - <div id='field-12-7'/></div> - <div id='field-12-8'/></div> - <div id='field-12-9'/></div> - <div id='field-12-10'/></div> - <div id='field-12-11'/></div> - <div id='field-12-12'/></div> - <div id='field-12-13'/></div> - <div id='field-12-14'/></div> - <div id='field-13-0'/></div> - <div id='field-13-1'/></div> - <div id='field-13-2'/></div> - <div id='field-13-3'/></div> - <div id='field-13-4'/></div> - <div id='field-13-5'/></div> - <div id='field-13-6'/></div> - <div id='field-13-7'/></div> - <div id='field-13-8'/></div> - <div id='field-13-9'/></div> - <div id='field-13-10'/></div> - <div id='field-13-11'/></div> - <div id='field-13-12'/></div> - <div id='field-13-13'/></div> - <div id='field-13-14'/></div> - <div id='field-14-0'/></div> - <div id='field-14-1'/></div> - <div id='field-14-2'/></div> - <div id='field-14-3'/></div> - <div id='field-14-4'/></div> - <div id='field-14-5'/></div> - <div id='field-14-6'/></div> - <div id='field-14-7'/></div> - <div id='field-14-8'/></div> - <div id='field-14-9'/></div> - <div id='field-14-10'/></div> - <div id='field-14-11'/></div> - <div id='field-14-12'/></div> - <div id='field-14-13'/></div> - <div id='field-14-14'/></div> -</div> -</body> \ No newline at end of file Modified: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp 2007-10-04 21:34:36 UTC (rev 2211) +++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp 2007-10-04 22:22:16 UTC (rev 2212) @@ -131,6 +131,5 @@ (sax:start-element (proxy-chained-handler handler) uri lname qname attrs)) (defmethod sax:end-element ((handler namespace-normalizer) uri lname qname) - (declare (ignore qname)) (pop (xmlns-stack handler)) (sax:end-element (proxy-chained-handler handler) (or uri #"") lname qname))

1 0

[bknr-cvs] r2211 - in branches/trunk-reorg/bknr/projects: . scrabble scrabble/src scrabble/website scrabble/website/de
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 17:34:36 -0400 (Thu, 04 Oct 2007) New Revision: 2211 Added: branches/trunk-reorg/bknr/projects/scrabble/ branches/trunk-reorg/bknr/projects/scrabble/scrabble_05.jpg branches/trunk-reorg/bknr/projects/scrabble/src/ branches/trunk-reorg/bknr/projects/scrabble/src/load.lisp branches/trunk-reorg/bknr/projects/scrabble/src/make-html.lisp branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp branches/trunk-reorg/bknr/projects/scrabble/src/scrabble-test.lisp branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.lisp branches/trunk-reorg/bknr/projects/scrabble/src/setup-registry.lisp branches/trunk-reorg/bknr/projects/scrabble/website/ branches/trunk-reorg/bknr/projects/scrabble/website/de/ branches/trunk-reorg/bknr/projects/scrabble/website/de/A.png branches/trunk-reorg/bknr/projects/scrabble/website/de/B.png branches/trunk-reorg/bknr/projects/scrabble/website/de/C.png branches/trunk-reorg/bknr/projects/scrabble/website/de/D.png branches/trunk-reorg/bknr/projects/scrabble/website/de/E.png branches/trunk-reorg/bknr/projects/scrabble/website/de/F.png branches/trunk-reorg/bknr/projects/scrabble/website/de/G.png branches/trunk-reorg/bknr/projects/scrabble/website/de/H.png branches/trunk-reorg/bknr/projects/scrabble/website/de/I.png branches/trunk-reorg/bknr/projects/scrabble/website/de/J.png branches/trunk-reorg/bknr/projects/scrabble/website/de/K.png branches/trunk-reorg/bknr/projects/scrabble/website/de/L.png branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS.png branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS.png branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS.png branches/trunk-reorg/bknr/projects/scrabble/website/de/M.png branches/trunk-reorg/bknr/projects/scrabble/website/de/N.png branches/trunk-reorg/bknr/projects/scrabble/website/de/NIL.png branches/trunk-reorg/bknr/projects/scrabble/website/de/O.png branches/trunk-reorg/bknr/projects/scrabble/website/de/P.png branches/trunk-reorg/bknr/projects/scrabble/website/de/Q.png branches/trunk-reorg/bknr/projects/scrabble/website/de/R.png branches/trunk-reorg/bknr/projects/scrabble/website/de/S.png branches/trunk-reorg/bknr/projects/scrabble/website/de/T.png branches/trunk-reorg/bknr/projects/scrabble/website/de/U.png branches/trunk-reorg/bknr/projects/scrabble/website/de/V.png branches/trunk-reorg/bknr/projects/scrabble/website/de/W.png branches/trunk-reorg/bknr/projects/scrabble/website/de/X.png branches/trunk-reorg/bknr/projects/scrabble/website/de/Y.png branches/trunk-reorg/bknr/projects/scrabble/website/de/Z.png branches/trunk-reorg/bknr/projects/scrabble/website/de/double-letter.png branches/trunk-reorg/bknr/projects/scrabble/website/de/double-word.png branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css branches/trunk-reorg/bknr/projects/scrabble/website/de/standard.png branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-letter.png branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-word.png Log: Add Scrabble project Added: branches/trunk-reorg/bknr/projects/scrabble/scrabble_05.jpg =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/scrabble_05.jpg ___________________________________________________________________ Name: svn:executable + * Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/src/load.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/load.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/load.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,5 @@ +(in-package :cl-user) + +(load (merge-pathnames #p"../thirdparty/asdf.lisp" *load-truename*)) + +(load (merge-pathnames #p"setup-registry.lisp" *load-truename*)) \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/src/make-html.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/make-html.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/make-html.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,16 @@ + +(in-package :scrabble) + +(defun make-playfield-html () + (format t "<div id='playfield'>~%") + (dotimes (x 15) + (dotimes (y 15) + (format t " <div id='field-~A-~A'/><img src='A.png'/></div>~%" + x y))) + (format t "</div>~%")) + +(defun make-playfield-css () + (dotimes (x 15) + (dotimes (y 15) + (format t "#playfield #field-~A-~A { background-image: url(~(~A.png~)); left: ~A; top: ~A }~%" + x y (field-type x y) (* 44 x) (* 44 y))))) \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/make-letters.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,72 @@ + +(in-package :scrabble.graphics) + +(defparameter *special-tile-texts* (make-hash-table)) + +(setf (gethash :de *special-tile-texts*) + '(:double-letter "DOPPELTER\nBUCHSTABEN\nWERT" + :double-word "DOPPELTER\nWORT\nWERT" + :triple-letter "DREIFACHER\nBUCHSTABEN\nWERT" + :triple-word "DREIFACHER\nWORT\nWERT")) + +(defparameter *special-tile-colors* + '(:double-letter (0.53 0.8 0.94) + :double-word (0.97 0.67 0.6) + :triple-letter (0.0 0.62 0.87) + :triple-word (0.93 0.11 0.18) + :standard (0.0 0.59 0.57))) + +(defparameter *bold-font* #.(merge-pathnames #p"../fonts/DIN/DINMd___.ttf" *default-pathname-defaults*)) +(defparameter *regular-font* #.(merge-pathnames #p"../fonts/DIN/DINRg___.ttf" *default-pathname-defaults*)) + +(defun make-letter-tile (char score) + (with-canvas (:width 34 :height 34) + (let ((bold-font (get-font *bold-font*)) + (regular-font (get-font *regular-font*)) + (char-string (make-string 1 :initial-element char))) + (set-rgb-fill 1.0 0.98 0.8) + (rounded-rectangle 0 0 34 34 4 4) + (fill-path) + (set-rgb-fill 0 0 0) + (set-font bold-font 27) + (draw-centered-string 13 7 char-string) + (set-font regular-font 11) + (draw-centered-string 26 3 (princ-to-string score)) + (save-png (make-pathname :name char-string :type "png"))))) + +(defun make-letter-tile-set (language) + (dolist (entry (gethash language *tile-sets*)) + (destructuring-bind (letter score count) entry + (declare (ignore count)) + (make-letter-tile letter score)))) + +(defun make-special-tile (name color &key text star) + (with-canvas (:width 40 :height 40) + (let ((regular-font (get-font *regular-font*))) + (apply #'set-rgb-fill color) + (rounded-rectangle 0 0 40 40 5 5) + (fill-path) + (set-rgb-fill 0 0 0) + (cond + (text + (set-font regular-font 6) + (draw-centered-string 26 3 text)) + (star + )) + (save-png (make-pathname :name (string-downcase (symbol-name name)) :type "png"))))) + +(defun make-special-tile-set (language) + (dolist (tile-name '(:double-letter :double-word :triple-letter :triple-word)) + (make-special-tile tile-name + (getf *special-tile-colors* tile-name) + :text (getf (gethash language *special-tile-texts*) tile-name))) + (make-special-tile :standard (getf *special-tile-colors* :standard) :star t)) + + +(defun make-tile-set (language) + (let ((*default-pathname-defaults* (merge-pathnames + (make-pathname :directory (list :relative + (string-downcase (symbol-name language))))))) + (ensure-directories-exist *default-pathname-defaults*) + (make-letter-tile-set language) + (make-special-tile-set language))) \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/package.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,11 @@ + +(defpackage :scrabble + (:use :cl :alexandria :anaphora) + (:export "*BOARD-SCORING*" + "*TILE-SETS*" + "FIELD-TYPE")) + +(defpackage :scrabble.graphics + (:use :cl :alexandria :vecto :scrabble) + (:shadowing-import-from :vecto "ROTATE")) + \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/src/scrabble-test.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/scrabble-test.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/scrabble-test.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,23 @@ + +(defun test-adjacent () + (let ((board (make-array '(15 15) :initial-element nil))) + (check-adjacent board 7 7) + (handler-case + (check-adjacent board 0 0) + (not-touching-other-tile (e) + (declare (ignore e)))) + (setf (aref board 7 7) t) + (handler-case + (check-adjacent board 7 7) + (tile-placed-on-occupied-field (e) + (declare (ignore e)))) + (check-adjacent board 6 7) + (check-adjacent board 7 6) + (check-adjacent board 8 7) + (check-adjacent board 7 8) + (setf (aref board 0 0) t) + (check-adjacent board 0 1) + (check-adjacent board 1 0) + (setf (aref board 14 14) t) + (check-adjacent board 14 13) + (check-adjacent board 13 14))) Added: branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.asd 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,18 @@ +;;;; -*- lisp -*- + +(in-package :cl-user) + +(defpackage :scrabble.system + (:use :cl :asdf)) + +(in-package :scrabble.system) + +(defsystem :scrabble + :name "Scrabble" + :licence "BSD" + :depends-on (:bknr-datastore :vecto :alexandria :anaphora) + :serial t + :components ((:file "package") + (:file "scrabble") + (:file "make-html") + (:file "make-letters"))) Added: branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/scrabble.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,293 @@ +(in-package :scrabble) + +(defparameter *board-scoring* + #2A((:triple-word nil nil :double-letter nil nil nil :triple-word nil nil nil :double-letter nil nil :triple-word) + (nil :double-word nil nil nil :triple-letter nil nil nil :triple-letter nil nil nil :double-word nil) + (nil nil :double-word nil nil nil :double-letter nil :double-letter nil nil nil :double-word nil nil) + (:double-letter nil nil :double-word nil nil nil :double-letter nil nil nil :double-word nil nil :double-letter) + (nil nil nil nil :double-word nil nil nil nil nil :double-word nil nil nil nil) + (nil :triple-letter nil nil nil :triple-letter nil nil nil :triple-letter nil nil nil :triple-letter nil) + (nil nil :double-letter nil nil nil :double-letter nil :double-letter nil nil nil :double-letter nil nil) + (:triple-word nil nil :double-letter nil nil nil :triple-word nil nil nil :double-letter nil nil :triple-word) + (nil nil :double-letter nil nil nil :double-letter nil :double-letter nil nil nil :double-letter nil nil) + (nil :triple-letter nil nil nil :triple-letter nil nil nil :triple-letter nil nil nil :triple-letter nil) + (nil nil nil nil :double-word nil nil nil nil nil :double-word nil nil nil nil) + (:double-letter nil nil :double-word nil nil nil :double-letter nil nil nil :double-word nil nil :double-letter) + (nil nil :double-word nil nil nil :double-letter nil :double-letter nil nil nil :double-word nil nil) + (nil :double-word nil nil nil :triple-letter nil nil nil :triple-letter nil nil nil :double-word nil) + (:triple-word nil nil :double-letter nil nil nil :triple-word nil nil nil :double-letter nil nil :triple-word))) + +(defun field-type (x y) + (or (aref *board-scoring* x y) + :standard)) + +(defparameter *tile-sets* (make-hash-table)) + +(setf (gethash :de *tile-sets*) + '((#\A 1 5) + (#\B 3 2) + (#\C 4 2) + (#\D 1 4) + (#\E 1 15) + (#\F 4 2) + (#\G 2 3) + (#\H 2 4) + (#\I 1 6) + (#\J 6 1) + (#\K 4 2) + (#\L 2 3) + (#\M 3 4) + (#\N 1 9) + (#\O 2 3) + (#\P 4 1) + (#\Q 10 1) + (#\R 1 6) + (#\S 1 7) + (#\T 1 6) + (#\U 1 6) + (#\V 6 1) + (#\W 3 1) + (#\X 8 1) + (#\Y 10 1) + (#\Z 3 1) + #-cmu (#\LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS 6 1) + #-cmu (#\LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS 8 1) + #-cmu (#\LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS 6 1) + (nil 0 2))) + +(define-condition invalid-move (simple-error) + () + (:report (lambda (c stream) + (format stream "Invalid move: ~A" (type-of c))))) + +(defun seq (from to) + (loop for i from from upto to + collect i)) + +(defun positions-between (start-position end-position) + (if (= (first start-position) + (first end-position)) + (mapcar (lambda (y) (list (first start-position) y)) + (seq (second start-position) (second end-position))) + (mapcar (lambda (x) (list x (second start-position))) + (seq (first start-position) (first end-position))))) + +(defclass tile-placement () + ((x :reader x-of :initarg :x) + (y :reader y-of :initarg :y) + (tile :reader tile-of :initarg :tile)) + (:documentation "Represents placement of a letter tile on the board")) + +(defun make-tile-placement (x y tile) + (make-instance 'tile-placement :x x :y y :tile tile)) + +(defun make-tile-placements (list-of-moves) + (mapcar (curry #'apply 'make-tile-placement) list-of-moves)) + +(defmethod equal-position ((tile-placement-1 tile-placement) (tile-placement-2 tile-placement)) + (and (= (x-of tile-placement-1) (x-of tile-placement-2)) + (= (y-of tile-placement-1) (y-of tile-placement-2)))) + +(defmethod position-equal ((position list) (tile-placement tile-placement)) + "Return non-nil if the given POSITION is at the position of PLACED-TILE" + (and (= (first position) (x-of tile-placement)) + (= (second position) (y-of tile-placement)))) + +(defmethod position-< ((a tile-placement) (b tile-placement)) + "Compare positions of placements, for sorting" + (or (< (x-of a) (x-of b)) + (< (y-of a) (y-of b)))) + +(defclass board () + ((placed-tiles :accessor placed-tiles-of :initform (make-array '(15 15) :initial-element nil)))) + +(defmethod print-object ((board board) stream) + (print-unreadable-object (board stream :type t :identity t) + (terpri stream) + (dotimes (x 15) + (dotimes (y 15) + (format stream "~C " (aif (at-xy board x y) (char-of it) #\.))) + (terpri stream)))) + +(defmethod at-xy ((board board) x y) + (aref (placed-tiles-of board) x y)) + +(defmethod at-placement ((board board) tile-placement) + (at-xy board (x-of tile-placement) (y-of tile-placement))) + +(defmethod put-letter ((board board) tile x y) + (setf (aref (placed-tiles-of board) x y) tile)) + +(defclass tile () + ((char :reader char-of :initarg :char) + (value :reader value-of :initarg :value))) + +(defmethod print-object ((tile tile) stream) + (print-unreadable-object (tile stream :type t :identity nil) + (with-slots (char value) tile + (format stream "~A (~A)" char value)))) + +(defun make-tile (char value) + (make-instance 'tile :char char :value value)) + +(defclass tile-bag () + ((tiles :initarg :tiles :accessor tiles-of))) + +(defmethod remaining-tile-count ((tile-bag tile-bag)) + (fill-pointer (tiles-of tile-bag))) + +(defmethod print-object ((tile-bag tile-bag) stream) + (print-unreadable-object (tile-bag stream :type t :identity t) + (format stream "~A letters remaining" (remaining-tile-count tile-bag)))) + +(defun make-tile-bag (language) + (let ((tiles (make-array 102 :adjustable t :fill-pointer 0))) + (mapcar (lambda (entry) + (destructuring-bind (char value count) entry + (dotimes (i count) + (vector-push-extend (make-tile char value) tiles)))) + (or (gethash language *tile-sets*) + (error "language ~A not defined" language))) + (dotimes (i (fill-pointer tiles)) + (let ((tmp (aref tiles i)) + (random-index (random (fill-pointer tiles)))) + (setf (aref tiles i) (aref tiles random-index)) + (setf (aref tiles random-index) tmp))) + (make-instance 'tile-bag :tiles tiles))) + +(define-condition no-tiles-remaining (simple-error) + ()) + +(defmethod draw-tile ((tile-bag tile-bag)) + (unless (plusp (remaining-tile-count tile-bag)) + (error 'no-tiles-remaining)) + (with-slots (tiles) tile-bag + (prog1 + (aref tiles (1- (fill-pointer tiles))) + (decf (fill-pointer tiles))))) + +(defmethod placed-tile-adjacent ((board board) (tile-placement tile-placement)) + "Check whether the given TILE-PLACEMENT on the board is adjacent to +another tile or if it is the start position." + (with-accessors ((x x-of) (y y-of)) + tile-placement + (or (and (eql x 7) + (eql y 7)) + (and (plusp x) + (at-xy board (1- x) y)) + (and (plusp y) + (at-xy board x (1- y))) + (and (< x 14) + (at-xy board (1+ x) y)) + (and (< y 14) + (at-xy board x (1+ y)))))) + +(defun placed-or-being-placed (board placed-tiles position) + (or (at-xy board (first position) (second position)) + (awhen (find position placed-tiles :test #'position-equal) + (values (tile-of it) t)))) + +(define-condition not-touching-other-tile (invalid-move) ()) +(define-condition not-in-a-row (invalid-move) ()) +(define-condition placed-on-occupied-field (invalid-move) ()) +(define-condition no-tile-placed (invalid-move) ()) +(define-condition multiple-letters-placed-on-one-field (invalid-move) ()) +(define-condition placement-with-holes (invalid-move) ()) + +(defun check-move-legality (board placed-tiles) + "Verify that placing the PLACED-TILES on BOARD is a legal Scrabble +move. If the move is not valid, a specific INVALID-MOVE condition is +signalled. Otherwise, t is returned." + (unless placed-tiles + (error 'no-tile-placed)) + + (unless (or (apply #'= (mapcar #'x-of placed-tiles)) + (apply #'= (mapcar #'y-of placed-tiles))) + (error 'not-in-a-row)) + + (when (some (curry #'at-placement board) placed-tiles) + (error 'tile-placed-on-occupied-field)) + + (unless (equal placed-tiles + (remove-duplicates placed-tiles :test #'equal-position)) + (error 'multiple-letters-placed-on-one-field)) + + (let* ((placed-tiles (sort (copy-list placed-tiles) #'position-<)) + (start-of-placement (first placed-tiles)) + (end-of-placement (first (last placed-tiles)))) + (unless (every (curry 'placed-or-being-placed board placed-tiles) + (positions-between (list (x-of start-of-placement) (y-of start-of-placement)) + (list (x-of end-of-placement) (y-of end-of-placement)))) + (error 'placement-with-holes))) + + (unless (or (find '(7 7) placed-tiles :test #'position-equal) + (some (curry #'placed-tile-adjacent board) placed-tiles)) + (error 'not-touching-other-tile)) + + t) + +(defun words-formed% (board placed-tiles verticalp) + "Scan for words that would be formed by placing PLACED-TILES on +BOARD. VERTICALP determines the scan order, if nil, the board is +scanned horizontally, else vertically. This is called by WORDS-FORMED +below, see there for a description of the return value format." + (let (words) + (dotimes (x 15) + (when (find x placed-tiles :key (if verticalp #'y-of #'x-of) :test #'=) + (let (word is-new-word) + (dotimes (y 15) + (multiple-value-bind (placed-tile being-placed) (placed-or-being-placed board placed-tiles (if verticalp (list y x) (list x y))) + (when (and word (null placed-tile)) + (when (and (cdr word) is-new-word) + (push (nreverse word) words)) + (setf word nil is-new-word nil)) + (when placed-tile + (push (list placed-tile (and being-placed (field-type x y))) word) + (when being-placed + (setf is-new-word t))))) + (when (and (cdr word) is-new-word) + (push (nreverse word) words))))) + (nreverse words))) + +(defun words-formed (board placed-tiles) + "Return list of all words formed by placing the tiles in +PLACED-TILES on the BOARD. Returns each word as a list, with each +letter of the word represented by a list (TILE FIELD-TYPE). TILE is +the tile for the letter, FIELD-TYPE is either the field type of the +field that the letter has been placed on, or NIL if the tile was +already on the board." + (append (words-formed% board placed-tiles nil) + (words-formed% board placed-tiles t))) + +(defun word-score (word-result) + "Process one word result from WORDS-FORMED and calculate the score +for the word." + (let ((factor 1) + (value 0)) + (dolist (entry word-result) + (destructuring-bind (tile field-type) entry + (incf value (value-of tile)) + (case field-type + ((:double-letter) (incf value (value-of tile))) + ((:triple-letter) (incf value (* 2 (value-of tile)))) + ((:double-word) (setf factor (* factor 2))) + ((:triple-word) (setf factor (* factor 3)))))) + (* value factor))) + +(defun word-text (word-result) + "Convert the letter in a word result returned by WORDS-FORMED to a +string." + (coerce (mapcar (compose #'char-of #'car) word-result) 'string)) + +(defun make-move (board placed-tiles) + "Actually perform a move. BOARD contains the already placed tiles, +PLACED-TILES contains the letters for the move to make. BOARD is +modified to include the tiles placed. Returns the two values that +CALCULATE-SCORE returns for the move." + (check-move-legality board placed-tiles) + (prog1 + (mapcar (lambda (word-result) + (list (word-text word-result) (word-score word-result))) + (words-formed board placed-tiles)) + (dolist (placed-tile placed-tiles) + (put-letter board (tile-of placed-tile) (x-of placed-tile) (y-of placed-tile))))) Added: branches/trunk-reorg/bknr/projects/scrabble/src/setup-registry.lisp =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/src/setup-registry.lisp 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/src/setup-registry.lisp 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,14 @@ +(in-package :cl-user) + +(defun setup-registry (directory-path) + (format t "; adding components under ~A to asdf registry~%" directory-path) + (mapc #'(lambda (asd-pathname) + (pushnew (make-pathname :name nil + :type nil + :version nil + :defaults asd-pathname) + asdf:*central-registry* + :test #'equal)) + (directory (merge-pathnames #p"**/*.asd" directory-path)))) + +(setup-registry (merge-pathnames #p"../thirdparty/" *load-truename*)) \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/A.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/A.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/B.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/B.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/C.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/C.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/D.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/D.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/E.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/E.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/F.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/F.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/G.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/G.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/H.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/H.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/I.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/I.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/J.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/J.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/K.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/K.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/L.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/L.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_A_WITH_DIAERESIS.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_O_WITH_DIAERESIS.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/LATIN_CAPITAL_LETTER_U_WITH_DIAERESIS.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/M.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/M.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/N.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/N.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/NIL.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/NIL.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/O.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/O.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/P.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/P.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/Q.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/Q.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/R.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/R.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/S.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/S.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/T.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/T.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/U.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/U.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/V.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/V.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/W.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/W.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/X.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/X.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/Y.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/Y.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/Z.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/Z.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/double-letter.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/double-letter.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/double-word.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/double-word.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/scrabble.css 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,228 @@ +#playfield { position: absolute } +#playfield div { position: absolute; width: 40px; height: 40px } +#playfield img { position: absolute; top: 3px; left: 3px } +#playfield #field-0-0 { background-image: url(triple-word.png); left: 0; top: 0 } +#playfield #field-0-1 { background-image: url(standard.png); left: 0; top: 44 } +#playfield #field-0-2 { background-image: url(standard.png); left: 0; top: 88 } +#playfield #field-0-3 { background-image: url(double-letter.png); left: 0; top: 132 } +#playfield #field-0-4 { background-image: url(standard.png); left: 0; top: 176 } +#playfield #field-0-5 { background-image: url(standard.png); left: 0; top: 220 } +#playfield #field-0-6 { background-image: url(standard.png); left: 0; top: 264 } +#playfield #field-0-7 { background-image: url(triple-word.png); left: 0; top: 308 } +#playfield #field-0-8 { background-image: url(standard.png); left: 0; top: 352 } +#playfield #field-0-9 { background-image: url(standard.png); left: 0; top: 396 } +#playfield #field-0-10 { background-image: url(standard.png); left: 0; top: 440 } +#playfield #field-0-11 { background-image: url(double-letter.png); left: 0; top: 484 } +#playfield #field-0-12 { background-image: url(standard.png); left: 0; top: 528 } +#playfield #field-0-13 { background-image: url(standard.png); left: 0; top: 572 } +#playfield #field-0-14 { background-image: url(triple-word.png); left: 0; top: 616 } +#playfield #field-1-0 { background-image: url(standard.png); left: 44; top: 0 } +#playfield #field-1-1 { background-image: url(double-word.png); left: 44; top: 44 } +#playfield #field-1-2 { background-image: url(standard.png); left: 44; top: 88 } +#playfield #field-1-3 { background-image: url(standard.png); left: 44; top: 132 } +#playfield #field-1-4 { background-image: url(standard.png); left: 44; top: 176 } +#playfield #field-1-5 { background-image: url(triple-letter.png); left: 44; top: 220 } +#playfield #field-1-6 { background-image: url(standard.png); left: 44; top: 264 } +#playfield #field-1-7 { background-image: url(standard.png); left: 44; top: 308 } +#playfield #field-1-8 { background-image: url(standard.png); left: 44; top: 352 } +#playfield #field-1-9 { background-image: url(triple-letter.png); left: 44; top: 396 } +#playfield #field-1-10 { background-image: url(standard.png); left: 44; top: 440 } +#playfield #field-1-11 { background-image: url(standard.png); left: 44; top: 484 } +#playfield #field-1-12 { background-image: url(standard.png); left: 44; top: 528 } +#playfield #field-1-13 { background-image: url(double-word.png); left: 44; top: 572 } +#playfield #field-1-14 { background-image: url(standard.png); left: 44; top: 616 } +#playfield #field-2-0 { background-image: url(standard.png); left: 88; top: 0 } +#playfield #field-2-1 { background-image: url(standard.png); left: 88; top: 44 } +#playfield #field-2-2 { background-image: url(double-word.png); left: 88; top: 88 } +#playfield #field-2-3 { background-image: url(standard.png); left: 88; top: 132 } +#playfield #field-2-4 { background-image: url(standard.png); left: 88; top: 176 } +#playfield #field-2-5 { background-image: url(standard.png); left: 88; top: 220 } +#playfield #field-2-6 { background-image: url(double-letter.png); left: 88; top: 264 } +#playfield #field-2-7 { background-image: url(standard.png); left: 88; top: 308 } +#playfield #field-2-8 { background-image: url(double-letter.png); left: 88; top: 352 } +#playfield #field-2-9 { background-image: url(standard.png); left: 88; top: 396 } +#playfield #field-2-10 { background-image: url(standard.png); left: 88; top: 440 } +#playfield #field-2-11 { background-image: url(standard.png); left: 88; top: 484 } +#playfield #field-2-12 { background-image: url(double-word.png); left: 88; top: 528 } +#playfield #field-2-13 { background-image: url(standard.png); left: 88; top: 572 } +#playfield #field-2-14 { background-image: url(standard.png); left: 88; top: 616 } +#playfield #field-3-0 { background-image: url(double-letter.png); left: 132; top: 0 } +#playfield #field-3-1 { background-image: url(standard.png); left: 132; top: 44 } +#playfield #field-3-2 { background-image: url(standard.png); left: 132; top: 88 } +#playfield #field-3-3 { background-image: url(double-word.png); left: 132; top: 132 } +#playfield #field-3-4 { background-image: url(standard.png); left: 132; top: 176 } +#playfield #field-3-5 { background-image: url(standard.png); left: 132; top: 220 } +#playfield #field-3-6 { background-image: url(standard.png); left: 132; top: 264 } +#playfield #field-3-7 { background-image: url(double-letter.png); left: 132; top: 308 } +#playfield #field-3-8 { background-image: url(standard.png); left: 132; top: 352 } +#playfield #field-3-9 { background-image: url(standard.png); left: 132; top: 396 } +#playfield #field-3-10 { background-image: url(standard.png); left: 132; top: 440 } +#playfield #field-3-11 { background-image: url(double-word.png); left: 132; top: 484 } +#playfield #field-3-12 { background-image: url(standard.png); left: 132; top: 528 } +#playfield #field-3-13 { background-image: url(standard.png); left: 132; top: 572 } +#playfield #field-3-14 { background-image: url(double-letter.png); left: 132; top: 616 } +#playfield #field-4-0 { background-image: url(standard.png); left: 176; top: 0 } +#playfield #field-4-1 { background-image: url(standard.png); left: 176; top: 44 } +#playfield #field-4-2 { background-image: url(standard.png); left: 176; top: 88 } +#playfield #field-4-3 { background-image: url(standard.png); left: 176; top: 132 } +#playfield #field-4-4 { background-image: url(double-word.png); left: 176; top: 176 } +#playfield #field-4-5 { background-image: url(standard.png); left: 176; top: 220 } +#playfield #field-4-6 { background-image: url(standard.png); left: 176; top: 264 } +#playfield #field-4-7 { background-image: url(standard.png); left: 176; top: 308 } +#playfield #field-4-8 { background-image: url(standard.png); left: 176; top: 352 } +#playfield #field-4-9 { background-image: url(standard.png); left: 176; top: 396 } +#playfield #field-4-10 { background-image: url(double-word.png); left: 176; top: 440 } +#playfield #field-4-11 { background-image: url(standard.png); left: 176; top: 484 } +#playfield #field-4-12 { background-image: url(standard.png); left: 176; top: 528 } +#playfield #field-4-13 { background-image: url(standard.png); left: 176; top: 572 } +#playfield #field-4-14 { background-image: url(standard.png); left: 176; top: 616 } +#playfield #field-5-0 { background-image: url(standard.png); left: 220; top: 0 } +#playfield #field-5-1 { background-image: url(triple-letter.png); left: 220; top: 44 } +#playfield #field-5-2 { background-image: url(standard.png); left: 220; top: 88 } +#playfield #field-5-3 { background-image: url(standard.png); left: 220; top: 132 } +#playfield #field-5-4 { background-image: url(standard.png); left: 220; top: 176 } +#playfield #field-5-5 { background-image: url(triple-letter.png); left: 220; top: 220 } +#playfield #field-5-6 { background-image: url(standard.png); left: 220; top: 264 } +#playfield #field-5-7 { background-image: url(standard.png); left: 220; top: 308 } +#playfield #field-5-8 { background-image: url(standard.png); left: 220; top: 352 } +#playfield #field-5-9 { background-image: url(triple-letter.png); left: 220; top: 396 } +#playfield #field-5-10 { background-image: url(standard.png); left: 220; top: 440 } +#playfield #field-5-11 { background-image: url(standard.png); left: 220; top: 484 } +#playfield #field-5-12 { background-image: url(standard.png); left: 220; top: 528 } +#playfield #field-5-13 { background-image: url(triple-letter.png); left: 220; top: 572 } +#playfield #field-5-14 { background-image: url(standard.png); left: 220; top: 616 } +#playfield #field-6-0 { background-image: url(standard.png); left: 264; top: 0 } +#playfield #field-6-1 { background-image: url(standard.png); left: 264; top: 44 } +#playfield #field-6-2 { background-image: url(double-letter.png); left: 264; top: 88 } +#playfield #field-6-3 { background-image: url(standard.png); left: 264; top: 132 } +#playfield #field-6-4 { background-image: url(standard.png); left: 264; top: 176 } +#playfield #field-6-5 { background-image: url(standard.png); left: 264; top: 220 } +#playfield #field-6-6 { background-image: url(double-letter.png); left: 264; top: 264 } +#playfield #field-6-7 { background-image: url(standard.png); left: 264; top: 308 } +#playfield #field-6-8 { background-image: url(double-letter.png); left: 264; top: 352 } +#playfield #field-6-9 { background-image: url(standard.png); left: 264; top: 396 } +#playfield #field-6-10 { background-image: url(standard.png); left: 264; top: 440 } +#playfield #field-6-11 { background-image: url(standard.png); left: 264; top: 484 } +#playfield #field-6-12 { background-image: url(double-letter.png); left: 264; top: 528 } +#playfield #field-6-13 { background-image: url(standard.png); left: 264; top: 572 } +#playfield #field-6-14 { background-image: url(standard.png); left: 264; top: 616 } +#playfield #field-7-0 { background-image: url(triple-word.png); left: 308; top: 0 } +#playfield #field-7-1 { background-image: url(standard.png); left: 308; top: 44 } +#playfield #field-7-2 { background-image: url(standard.png); left: 308; top: 88 } +#playfield #field-7-3 { background-image: url(double-letter.png); left: 308; top: 132 } +#playfield #field-7-4 { background-image: url(standard.png); left: 308; top: 176 } +#playfield #field-7-5 { background-image: url(standard.png); left: 308; top: 220 } +#playfield #field-7-6 { background-image: url(standard.png); left: 308; top: 264 } +#playfield #field-7-7 { background-image: url(triple-word.png); left: 308; top: 308 } +#playfield #field-7-8 { background-image: url(standard.png); left: 308; top: 352 } +#playfield #field-7-9 { background-image: url(standard.png); left: 308; top: 396 } +#playfield #field-7-10 { background-image: url(standard.png); left: 308; top: 440 } +#playfield #field-7-11 { background-image: url(double-letter.png); left: 308; top: 484 } +#playfield #field-7-12 { background-image: url(standard.png); left: 308; top: 528 } +#playfield #field-7-13 { background-image: url(standard.png); left: 308; top: 572 } +#playfield #field-7-14 { background-image: url(triple-word.png); left: 308; top: 616 } +#playfield #field-8-0 { background-image: url(standard.png); left: 352; top: 0 } +#playfield #field-8-1 { background-image: url(standard.png); left: 352; top: 44 } +#playfield #field-8-2 { background-image: url(double-letter.png); left: 352; top: 88 } +#playfield #field-8-3 { background-image: url(standard.png); left: 352; top: 132 } +#playfield #field-8-4 { background-image: url(standard.png); left: 352; top: 176 } +#playfield #field-8-5 { background-image: url(standard.png); left: 352; top: 220 } +#playfield #field-8-6 { background-image: url(double-letter.png); left: 352; top: 264 } +#playfield #field-8-7 { background-image: url(standard.png); left: 352; top: 308 } +#playfield #field-8-8 { background-image: url(double-letter.png); left: 352; top: 352 } +#playfield #field-8-9 { background-image: url(standard.png); left: 352; top: 396 } +#playfield #field-8-10 { background-image: url(standard.png); left: 352; top: 440 } +#playfield #field-8-11 { background-image: url(standard.png); left: 352; top: 484 } +#playfield #field-8-12 { background-image: url(double-letter.png); left: 352; top: 528 } +#playfield #field-8-13 { background-image: url(standard.png); left: 352; top: 572 } +#playfield #field-8-14 { background-image: url(standard.png); left: 352; top: 616 } +#playfield #field-9-0 { background-image: url(standard.png); left: 396; top: 0 } +#playfield #field-9-1 { background-image: url(triple-letter.png); left: 396; top: 44 } +#playfield #field-9-2 { background-image: url(standard.png); left: 396; top: 88 } +#playfield #field-9-3 { background-image: url(standard.png); left: 396; top: 132 } +#playfield #field-9-4 { background-image: url(standard.png); left: 396; top: 176 } +#playfield #field-9-5 { background-image: url(triple-letter.png); left: 396; top: 220 } +#playfield #field-9-6 { background-image: url(standard.png); left: 396; top: 264 } +#playfield #field-9-7 { background-image: url(standard.png); left: 396; top: 308 } +#playfield #field-9-8 { background-image: url(standard.png); left: 396; top: 352 } +#playfield #field-9-9 { background-image: url(triple-letter.png); left: 396; top: 396 } +#playfield #field-9-10 { background-image: url(standard.png); left: 396; top: 440 } +#playfield #field-9-11 { background-image: url(standard.png); left: 396; top: 484 } +#playfield #field-9-12 { background-image: url(standard.png); left: 396; top: 528 } +#playfield #field-9-13 { background-image: url(triple-letter.png); left: 396; top: 572 } +#playfield #field-9-14 { background-image: url(standard.png); left: 396; top: 616 } +#playfield #field-10-0 { background-image: url(standard.png); left: 440; top: 0 } +#playfield #field-10-1 { background-image: url(standard.png); left: 440; top: 44 } +#playfield #field-10-2 { background-image: url(standard.png); left: 440; top: 88 } +#playfield #field-10-3 { background-image: url(standard.png); left: 440; top: 132 } +#playfield #field-10-4 { background-image: url(double-word.png); left: 440; top: 176 } +#playfield #field-10-5 { background-image: url(standard.png); left: 440; top: 220 } +#playfield #field-10-6 { background-image: url(standard.png); left: 440; top: 264 } +#playfield #field-10-7 { background-image: url(standard.png); left: 440; top: 308 } +#playfield #field-10-8 { background-image: url(standard.png); left: 440; top: 352 } +#playfield #field-10-9 { background-image: url(standard.png); left: 440; top: 396 } +#playfield #field-10-10 { background-image: url(double-word.png); left: 440; top: 440 } +#playfield #field-10-11 { background-image: url(standard.png); left: 440; top: 484 } +#playfield #field-10-12 { background-image: url(standard.png); left: 440; top: 528 } +#playfield #field-10-13 { background-image: url(standard.png); left: 440; top: 572 } +#playfield #field-10-14 { background-image: url(standard.png); left: 440; top: 616 } +#playfield #field-11-0 { background-image: url(double-letter.png); left: 484; top: 0 } +#playfield #field-11-1 { background-image: url(standard.png); left: 484; top: 44 } +#playfield #field-11-2 { background-image: url(standard.png); left: 484; top: 88 } +#playfield #field-11-3 { background-image: url(double-word.png); left: 484; top: 132 } +#playfield #field-11-4 { background-image: url(standard.png); left: 484; top: 176 } +#playfield #field-11-5 { background-image: url(standard.png); left: 484; top: 220 } +#playfield #field-11-6 { background-image: url(standard.png); left: 484; top: 264 } +#playfield #field-11-7 { background-image: url(double-letter.png); left: 484; top: 308 } +#playfield #field-11-8 { background-image: url(standard.png); left: 484; top: 352 } +#playfield #field-11-9 { background-image: url(standard.png); left: 484; top: 396 } +#playfield #field-11-10 { background-image: url(standard.png); left: 484; top: 440 } +#playfield #field-11-11 { background-image: url(double-word.png); left: 484; top: 484 } +#playfield #field-11-12 { background-image: url(standard.png); left: 484; top: 528 } +#playfield #field-11-13 { background-image: url(standard.png); left: 484; top: 572 } +#playfield #field-11-14 { background-image: url(double-letter.png); left: 484; top: 616 } +#playfield #field-12-0 { background-image: url(standard.png); left: 528; top: 0 } +#playfield #field-12-1 { background-image: url(standard.png); left: 528; top: 44 } +#playfield #field-12-2 { background-image: url(double-word.png); left: 528; top: 88 } +#playfield #field-12-3 { background-image: url(standard.png); left: 528; top: 132 } +#playfield #field-12-4 { background-image: url(standard.png); left: 528; top: 176 } +#playfield #field-12-5 { background-image: url(standard.png); left: 528; top: 220 } +#playfield #field-12-6 { background-image: url(double-letter.png); left: 528; top: 264 } +#playfield #field-12-7 { background-image: url(standard.png); left: 528; top: 308 } +#playfield #field-12-8 { background-image: url(double-letter.png); left: 528; top: 352 } +#playfield #field-12-9 { background-image: url(standard.png); left: 528; top: 396 } +#playfield #field-12-10 { background-image: url(standard.png); left: 528; top: 440 } +#playfield #field-12-11 { background-image: url(standard.png); left: 528; top: 484 } +#playfield #field-12-12 { background-image: url(double-word.png); left: 528; top: 528 } +#playfield #field-12-13 { background-image: url(standard.png); left: 528; top: 572 } +#playfield #field-12-14 { background-image: url(standard.png); left: 528; top: 616 } +#playfield #field-13-0 { background-image: url(standard.png); left: 572; top: 0 } +#playfield #field-13-1 { background-image: url(double-word.png); left: 572; top: 44 } +#playfield #field-13-2 { background-image: url(standard.png); left: 572; top: 88 } +#playfield #field-13-3 { background-image: url(standard.png); left: 572; top: 132 } +#playfield #field-13-4 { background-image: url(standard.png); left: 572; top: 176 } +#playfield #field-13-5 { background-image: url(triple-letter.png); left: 572; top: 220 } +#playfield #field-13-6 { background-image: url(standard.png); left: 572; top: 264 } +#playfield #field-13-7 { background-image: url(standard.png); left: 572; top: 308 } +#playfield #field-13-8 { background-image: url(standard.png); left: 572; top: 352 } +#playfield #field-13-9 { background-image: url(triple-letter.png); left: 572; top: 396 } +#playfield #field-13-10 { background-image: url(standard.png); left: 572; top: 440 } +#playfield #field-13-11 { background-image: url(standard.png); left: 572; top: 484 } +#playfield #field-13-12 { background-image: url(standard.png); left: 572; top: 528 } +#playfield #field-13-13 { background-image: url(double-word.png); left: 572; top: 572 } +#playfield #field-13-14 { background-image: url(standard.png); left: 572; top: 616 } +#playfield #field-14-0 { background-image: url(triple-word.png); left: 616; top: 0 } +#playfield #field-14-1 { background-image: url(standard.png); left: 616; top: 44 } +#playfield #field-14-2 { background-image: url(standard.png); left: 616; top: 88 } +#playfield #field-14-3 { background-image: url(double-letter.png); left: 616; top: 132 } +#playfield #field-14-4 { background-image: url(standard.png); left: 616; top: 176 } +#playfield #field-14-5 { background-image: url(standard.png); left: 616; top: 220 } +#playfield #field-14-6 { background-image: url(standard.png); left: 616; top: 264 } +#playfield #field-14-7 { background-image: url(triple-word.png); left: 616; top: 308 } +#playfield #field-14-8 { background-image: url(standard.png); left: 616; top: 352 } +#playfield #field-14-9 { background-image: url(standard.png); left: 616; top: 396 } +#playfield #field-14-10 { background-image: url(standard.png); left: 616; top: 440 } +#playfield #field-14-11 { background-image: url(double-letter.png); left: 616; top: 484 } +#playfield #field-14-12 { background-image: url(standard.png); left: 616; top: 528 } +#playfield #field-14-13 { background-image: url(standard.png); left: 616; top: 572 } +#playfield #field-14-14 { background-image: url(triple-word.png); left: 616; top: 616 } Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/standard.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/standard.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html =================================================================== --- branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html 2007-10-04 21:08:36 UTC (rev 2210) +++ branches/trunk-reorg/bknr/projects/scrabble/website/de/test.html 2007-10-04 21:34:36 UTC (rev 2211) @@ -0,0 +1,268 @@ +<head> + <link rel="stylesheet" type="text/css" href="scrabble.css" /> +</head> +<body bgcolor="#004B36"> +<img src="A.png"/> +<img src="B.png"/> +<img src="C.png"/> +<img src="D.png"/> +<img src="E.png"/> +<img src="F.png"/> +<img src="G.png"/> +<img src="H.png"/> +<img src="I.png"/> +<img src="J.png"/> +<img src="K.png"/> +<img src="L.png"/> +<img src="M.png"/> +<img src="N.png"/> +<img src="O.png"/> +<img src="P.png"/> +<img src="Q.png"/> +<img src="R.png"/> +<img src="S.png"/> +<img src="T.png"/> +<img src="U.png"/> +<img src="V.png"/> +<img src="W.png"/> +<img src="X.png"/> +<img src="Y.png"/> +<img src="Z.png"/> +<img src="�.png"/> +<img src="�.png"/> +<img src="�.png"/> +<br> +<img src="double-letter.png"/> +<img src="double-word.png"/> +<img src="triple-letter.png"/> +<img src="triple-word.png"/> +<img src="standard.png"/> +<br/> +<div id='playfield'> + <div id='field-0-0'/></div> + <div id='field-0-1'/></div> + <div id='field-0-2'/></div> + <div id='field-0-3'/></div> + <div id='field-0-4'/></div> + <div id='field-0-5'/></div> + <div id='field-0-6'/></div> + <div id='field-0-7'/></div> + <div id='field-0-8'/></div> + <div id='field-0-9'/></div> + <div id='field-0-10'/></div> + <div id='field-0-11'/></div> + <div id='field-0-12'/></div> + <div id='field-0-13'/></div> + <div id='field-0-14'/></div> + <div id='field-1-0'/></div> + <div id='field-1-1'/></div> + <div id='field-1-2'/></div> + <div id='field-1-3'/></div> + <div id='field-1-4'/></div> + <div id='field-1-5'/></div> + <div id='field-1-6'/></div> + <div id='field-1-7'/></div> + <div id='field-1-8'/></div> + <div id='field-1-9'/></div> + <div id='field-1-10'/></div> + <div id='field-1-11'/></div> + <div id='field-1-12'/></div> + <div id='field-1-13'/></div> + <div id='field-1-14'/></div> + <div id='field-2-0'/><img src="I.png"/></div> + <div id='field-2-1'/><img src="C.png"/></div> + <div id='field-2-2'/><img src="H.png"/></div> + <div id='field-2-3'/></div> + <div id='field-2-4'/></div> + <div id='field-2-5'/></div> + <div id='field-2-6'/></div> + <div id='field-2-7'/></div> + <div id='field-2-8'/></div> + <div id='field-2-9'/></div> + <div id='field-2-10'/></div> + <div id='field-2-11'/></div> + <div id='field-2-12'/></div> + <div id='field-2-13'/></div> + <div id='field-2-14'/></div> + <div id='field-3-0'/></div> + <div id='field-3-1'/></div> + <div id='field-3-2'/><img src="L.png"/></div> + <div id='field-3-3'/><img src="I.png"/></div> + <div id='field-3-4'/><img src="E.png"/></div> + <div id='field-3-5'/><img src="B.png"/></div> + <div id='field-3-6'/><img src="E.png"/></div> + <div id='field-3-7'/></div> + <div id='field-3-8'/></div> + <div id='field-3-9'/></div> + <div id='field-3-10'/></div> + <div id='field-3-11'/></div> + <div id='field-3-12'/></div> + <div id='field-3-13'/></div> + <div id='field-3-14'/></div> + <div id='field-4-0'/></div> + <div id='field-4-1'/></div> + <div id='field-4-2'/><img src="D.png"/></div> + <div id='field-4-3'/><img src="I.png"/></div> + <div id='field-4-4'/><img src="C.png"/></div> + <div id='field-4-5'/><img src="H.png"/></div> + <div id='field-4-6'/></div> + <div id='field-4-7'/></div> + <div id='field-4-8'/></div> + <div id='field-4-9'/></div> + <div id='field-4-10'/></div> + <div id='field-4-11'/></div> + <div id='field-4-12'/></div> + <div id='field-4-13'/></div> + <div id='field-4-14'/></div> + <div id='field-5-0'/></div> + <div id='field-5-1'/></div> + <div id='field-5-2'/></div> + <div id='field-5-3'/></div> + <div id='field-5-4'/></div> + <div id='field-5-5'/></div> + <div id='field-5-6'/></div> + <div id='field-5-7'/></div> + <div id='field-5-8'/></div> + <div id='field-5-9'/></div> + <div id='field-5-10'/></div> + <div id='field-5-11'/></div> + <div id='field-5-12'/></div> + <div id='field-5-13'/></div> + <div id='field-5-14'/></div> + <div id='field-6-0'/></div> + <div id='field-6-1'/></div> + <div id='field-6-2'/></div> + <div id='field-6-3'/></div> + <div id='field-6-4'/></div> + <div id='field-6-5'/></div> + <div id='field-6-6'/></div> + <div id='field-6-7'/></div> + <div id='field-6-8'/></div> + <div id='field-6-9'/></div> + <div id='field-6-10'/></div> + <div id='field-6-11'/></div> + <div id='field-6-12'/></div> + <div id='field-6-13'/></div> + <div id='field-6-14'/></div> + <div id='field-7-0'/></div> + <div id='field-7-1'/></div> + <div id='field-7-2'/></div> + <div id='field-7-3'/></div> + <div id='field-7-4'/></div> + <div id='field-7-5'/></div> + <div id='field-7-6'/></div> + <div id='field-7-7'/></div> + <div id='field-7-8'/></div> + <div id='field-7-9'/></div> + <div id='field-7-10'/></div> + <div id='field-7-11'/></div> + <div id='field-7-12'/></div> + <div id='field-7-13'/></div> + <div id='field-7-14'/></div> + <div id='field-8-0'/></div> + <div id='field-8-1'/></div> + <div id='field-8-2'/></div> + <div id='field-8-3'/></div> + <div id='field-8-4'/></div> + <div id='field-8-5'/></div> + <div id='field-8-6'/></div> + <div id='field-8-7'/></div> + <div id='field-8-8'/></div> + <div id='field-8-9'/></div> + <div id='field-8-10'/></div> + <div id='field-8-11'/></div> + <div id='field-8-12'/></div> + <div id='field-8-13'/></div> + <div id='field-8-14'/></div> + <div id='field-9-0'/></div> + <div id='field-9-1'/></div> + <div id='field-9-2'/></div> + <div id='field-9-3'/></div> + <div id='field-9-4'/></div> + <div id='field-9-5'/></div> + <div id='field-9-6'/></div> + <div id='field-9-7'/></div> + <div id='field-9-8'/></div> + <div id='field-9-9'/></div> + <div id='field-9-10'/></div> + <div id='field-9-11'/></div> + <div id='field-9-12'/></div> + <div id='field-9-13'/></div> + <div id='field-9-14'/></div> + <div id='field-10-0'/></div> + <div id='field-10-1'/></div> + <div id='field-10-2'/></div> + <div id='field-10-3'/></div> + <div id='field-10-4'/></div> + <div id='field-10-5'/></div> + <div id='field-10-6'/></div> + <div id='field-10-7'/></div> + <div id='field-10-8'/></div> + <div id='field-10-9'/></div> + <div id='field-10-10'/></div> + <div id='field-10-11'/></div> + <div id='field-10-12'/></div> + <div id='field-10-13'/></div> + <div id='field-10-14'/></div> + <div id='field-11-0'/></div> + <div id='field-11-1'/></div> + <div id='field-11-2'/></div> + <div id='field-11-3'/></div> + <div id='field-11-4'/></div> + <div id='field-11-5'/></div> + <div id='field-11-6'/></div> + <div id='field-11-7'/></div> + <div id='field-11-8'/></div> + <div id='field-11-9'/></div> + <div id='field-11-10'/></div> + <div id='field-11-11'/></div> + <div id='field-11-12'/></div> + <div id='field-11-13'/></div> + <div id='field-11-14'/></div> + <div id='field-12-0'/></div> + <div id='field-12-1'/></div> + <div id='field-12-2'/></div> + <div id='field-12-3'/></div> + <div id='field-12-4'/></div> + <div id='field-12-5'/></div> + <div id='field-12-6'/></div> + <div id='field-12-7'/></div> + <div id='field-12-8'/></div> + <div id='field-12-9'/></div> + <div id='field-12-10'/></div> + <div id='field-12-11'/></div> + <div id='field-12-12'/></div> + <div id='field-12-13'/></div> + <div id='field-12-14'/></div> + <div id='field-13-0'/></div> + <div id='field-13-1'/></div> + <div id='field-13-2'/></div> + <div id='field-13-3'/></div> + <div id='field-13-4'/></div> + <div id='field-13-5'/></div> + <div id='field-13-6'/></div> + <div id='field-13-7'/></div> + <div id='field-13-8'/></div> + <div id='field-13-9'/></div> + <div id='field-13-10'/></div> + <div id='field-13-11'/></div> + <div id='field-13-12'/></div> + <div id='field-13-13'/></div> + <div id='field-13-14'/></div> + <div id='field-14-0'/></div> + <div id='field-14-1'/></div> + <div id='field-14-2'/></div> + <div id='field-14-3'/></div> + <div id='field-14-4'/></div> + <div id='field-14-5'/></div> + <div id='field-14-6'/></div> + <div id='field-14-7'/></div> + <div id='field-14-8'/></div> + <div id='field-14-9'/></div> + <div id='field-14-10'/></div> + <div id='field-14-11'/></div> + <div id='field-14-12'/></div> + <div id='field-14-13'/></div> + <div id='field-14-14'/></div> +</div> +</body> \ No newline at end of file Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-letter.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-letter.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-word.png =================================================================== (Binary files differ) Property changes on: branches/trunk-reorg/bknr/projects/scrabble/website/de/triple-word.png ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

1 0

[bknr-cvs] r2210 - in branches/trunk-reorg: bknr/datastore/src bknr/datastore/src/data bknr/datastore/src/utils thirdparty xhtmlgen
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 17:08:36 -0400 (Thu, 04 Oct 2007) New Revision: 2210 Added: branches/trunk-reorg/thirdparty/cl-interpol/ Modified: branches/trunk-reorg/bknr/datastore/src/bknr-data-impex.asd branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd branches/trunk-reorg/bknr/datastore/src/data/package.lisp branches/trunk-reorg/bknr/datastore/src/data/txn.lisp branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp branches/trunk-reorg/bknr/datastore/src/utils/package.lisp branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp branches/trunk-reorg/xhtmlgen/xhtmlgen.asd branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp Log: SBCL-1.0.10 loads :bknr-datastore and performs some basic operations. The rest of this is untested. I'll be moving this forward while working on the scrabble application that I'm going to commit later on. Modified: branches/trunk-reorg/bknr/datastore/src/bknr-data-impex.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-data-impex.asd 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/bknr-data-impex.asd 2007-10-04 21:08:36 UTC (rev 2210) @@ -16,8 +16,6 @@ :description "baikonour - launchpad for lisp satellites" :depends-on (:cl-interpol :unit-test :bknr-utils :bknr-indices - :bknr-datastore :bknr-impex - #+(not allegro) - :acl-compat) + :bknr-datastore :bknr-impex) :components ((:module "data" :components ((:file "xml-object"))))) Modified: branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/bknr-datastore.asd 2007-10-04 21:08:36 UTC (rev 2210) @@ -17,10 +17,10 @@ :description "baikonour - launchpad for lisp satellites" :depends-on (:cl-interpol + :closer-mop :unit-test :bknr-utils - :bknr-indices - #+(not allegro) :acl-compat) + :bknr-indices) :components ((:module "data" :components ((:file "package") (:file "encoding" :depends-on ("package")) Modified: branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/bknr-utils.asd 2007-10-04 21:08:36 UTC (rev 2210) @@ -18,8 +18,6 @@ :depends-on (:cl-interpol :cl-ppcre :md5 - #+(not allegro) - :acl-compat :iconv) :components ((:module "statistics" :components ((:file "package") Modified: branches/trunk-reorg/bknr/datastore/src/data/package.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -3,16 +3,7 @@ (defpackage :bknr.datastore (:use :cl :bknr.utils :cl-interpol :cl-ppcre :bknr.indices :bknr.statistics - #+allegro - :mp - #+(not allegro) - :acl-compat.mp - #+allegro :aclmop - #+cmu :pcl - #+openmcl :openmcl-mop - #+sbcl :sb-mop) - #+(not allegro) - (:shadowing-import-from :acl-compat.mp process-kill process-wait) + :closer-mop ) (:shadowing-import-from :cl-interpol quote-meta-chars) (:export #:*store-debug* #:*store* Modified: branches/trunk-reorg/bknr/datastore/src/data/txn.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -37,15 +37,18 @@ (transaction-run-time :accessor store-transaction-run-time :initform 0 :documentation "The total run time of all application transaction code since last snapshot")) - (:default-initargs :guard #'funcall :log-guard #'funcall :subsystems (list (make-instance 'store-object-subsystem)))) + (:default-initargs + :guard #'funcall + :log-guard #'funcall + :subsystems (list (make-instance 'store-object-subsystem)))) (defclass mp-store (store) () - (:default-initargs :guard (let ((lock (make-process-lock))) + (:default-initargs :guard (let ((lock (mp-make-lock))) (lambda (thunk) (mp-with-recursive-lock-held (lock) (funcall thunk)))) - :log-guard (let ((lock (make-process-lock))) + :log-guard (let ((lock (mp-make-lock))) (lambda (thunk) (mp-with-recursive-lock-held (lock) (funcall thunk))))) Modified: branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/utils/acl-mp-compat.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -1,24 +1,24 @@ -(in-package :bknr.utils) - -(defun mp-make-lock (&optional (name "Anonymous")) - #+allegro - (mp:make-process-lock :name name) - #+sbcl - (sb-thread:make-mutex :name name) - #+cmu - (mp:make-lock name)) - -(defmacro mp-with-lock-held ((lock) &rest body) - #+allegro - `(mp:with-process-lock (,lock) - ,@body) - #+sbcl - `(sb-thread:with-mutex (,lock) - ,@body) - #+cmu - `(mp:with-lock-held (,lock) - ,@body)) +(in-package :bknr.utils) +(defun mp-make-lock (&optional (name "Anonymous")) + #+allegro + (mp:make-process-lock :name name) + #+sbcl + (sb-thread:make-mutex :name name) + #+cmu + (mp:make-lock name)) + +(defmacro mp-with-lock-held ((lock) &rest body) + #+allegro + `(mp:with-process-lock (,lock) + ,@body) + #+sbcl + `(sb-thread:with-mutex (,lock) + ,@body) + #+cmu + `(mp:with-lock-held (,lock) + ,@body)) + (defmacro mp-with-recursive-lock-held ((lock) &rest body) #+allegro `(mp:with-process-lock (,lock) Modified: branches/trunk-reorg/bknr/datastore/src/utils/package.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/utils/package.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/utils/package.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -6,12 +6,8 @@ :cl-interpol :md5 #+cmu :extensions -; #+sbcl :sb-ext - #+(not allegro) :acl-compat.mp - #+allegro :mp) + #+sbcl :sb-ext) (:shadowing-import-from :cl-interpol quote-meta-chars) - #+(not allegro) - (:shadowing-import-from :acl-compat.mp process-kill process-wait) (:export #:define-bknr-class ;; byte size formatting Modified: branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -546,14 +546,3 @@ (t (format nil "~A" byte-count)))) -;;; from norvig -(defun find-all (item sequence &rest keyword-args - &key (test #'eql) test-not &allow-other-keys) - "Find all those elements of sequence that match item, - according to the keywords. Doesn't alter sequence." - (if test-not - (apply #'remove item sequence - :test-not (complement test-not) keyword-args) - (apply #'remove item sequence - :test (complement test) keyword-args))) - Modified: branches/trunk-reorg/xhtmlgen/xhtmlgen.asd =================================================================== --- branches/trunk-reorg/xhtmlgen/xhtmlgen.asd 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/xhtmlgen/xhtmlgen.asd 2007-10-04 21:08:36 UTC (rev 2210) @@ -1,6 +1,7 @@ (in-package :cl-user) -(defsystem :xhtmlgen - :serial t - :components ((:file "package") - (:file "xhtmlgen"))) \ No newline at end of file +(asdf:defsystem :xhtmlgen + :depends-on (:cxml) + :serial t + :components ((:file "package") + (:file "xhtmlgen"))) \ No newline at end of file Modified: branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp =================================================================== --- branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp 2007-10-04 20:57:29 UTC (rev 2209) +++ branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp 2007-10-04 21:08:36 UTC (rev 2210) @@ -49,12 +49,12 @@ #-rune-is-character (defun make-sink-for-utf8-strings (stream) - (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3) + (cxml:make-recoder (cxml:make-character-stream-sink/utf8 stream :canonical nil :indentation 3) #'cxml::utf8-string-to-rod)) #-rune-is-character (defun make-sink-for-latin1-strings (stream) - (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3) + (cxml:make-recoder (cxml:make-character-stream-sink/utf8 stream :canonical nil :indentation 3) #'cxml::string-rod)) #-rune-is-character @@ -75,9 +75,9 @@ `(let ((*html-sink* (if (boundp '*html-sink*) *html-sink* #+rune-is-character - (cxml:make-character-stream-sink net.html.generator:*html-stream* :canonical nil :indentation 3) + (cxml:make-character-stream-sink *standard-output* :canonical nil :indentation 3) #-rune-is-character - (make-sink-for-internal-strings net.html.generator:*html-stream*)))) + (make-sink-for-internal-strings *standard-output*)))) ,(process-html-forms forms env))) (defmacro html-stream (stream &rest forms &environment env)

1 0