clipping-paths.lisp

   1 ;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved
   2 ;;;
   3 ;;; Redistribution and use in source and binary forms, with or without
   4 ;;; modification, are permitted provided that the following conditions
   5 ;;; are met:
   6 ;;;
   7 ;;;   * Redistributions of source code must retain the above copyright
   8 ;;;     notice, this list of conditions and the following disclaimer.
   9 ;;;
  10 ;;;   * Redistributions in binary form must reproduce the above
  11 ;;;     copyright notice, this list of conditions and the following
  12 ;;;     disclaimer in the documentation and/or other materials
  13 ;;;     provided with the distribution.
  14 ;;;
  15 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  16 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  17 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  19 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  21 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  22 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  23 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  24 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  25 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 ;;;
  27 ;;; $Id: clipping-paths.lisp,v 1.2 2007/10/01 16:25:48 xach Exp $
  28
  29 (in-package #:vecto)
  30
  31 ;;; Clipping paths are represented as a grayscale channel against
  32 ;;; which drawing operations are masked; it's intersected with the
  33 ;;; alpha channel. They are part of the graphics state that are saved
  34 ;;; and restored by WITH-GRAPHICS-STATE. However, there's no reason to
  35 ;;; pay a channel copying penalty if the clipping path is not
  36 ;;; modified, or pay a data creation/drawing penalty if the clipping
  37 ;;; path is empty.
  38 ;;;
  39 ;;; This is implemented by making WRITABLE-CLIPPING-DATA the method to
  40 ;;; obtain the data of a clipping path; it will create data for an
  41 ;;; empty clipping path, and copy data for a clipping path in a
  42 ;;; temporary graphics state. If WRITABLE-CLIPPING-DATA is never
  43 ;;; called, no mask will be created, and drawing operations won't
  44 ;;; bother consulting the clipping path.
  45 ;;;
  46 ;;; TODO: Store a bounding box with a clipping path, so drawing can be
  47 ;;; limited to the clipping path area when possible.
  48
  49 (defclass clipping-path ()
  50   ((height
  51     :initarg :height
  52     :accessor height)
  53    (width
  54     :initarg :width
  55     :accessor width)
  56    (data
  57     :initarg :data
  58     :accessor data)
  59    (scratch
  60     :initarg :scratch
  61     :accessor scratch
  62     :documentation "A temporary channel used to store the new clipping
  63     path to intersect with the old one.")))
  64
  65 (defclass empty-clipping-path (clipping-path) ())
  66
  67 (defclass proxy-clipping-path (clipping-path) ())
  68
  69 (defmethod print-object ((clipping-path clipping-path) stream)
  70   (print-unreadable-object (clipping-path stream :type t :identity t)
  71     (format stream "~Dx~D" (width clipping-path) (height clipping-path))))
  72
  73 (defmethod copy ((clipping-path clipping-path))
  74   (make-instance 'proxy-clipping-path
  75                  :data (data clipping-path)
  76                  :scratch (scratch clipping-path)
  77                  :height (height clipping-path)
  78                  :width (width clipping-path)))
  79
  80 (defmethod copy ((clipping-path empty-clipping-path))
  81   (make-instance 'empty-clipping-path
  82                  :height (height clipping-path)
  83                  :width (width clipping-path)))
  84
  85 (defgeneric emptyp (object)
  86   (:method (object)
  87     nil)
  88   (:method ((object empty-clipping-path))
  89     t))
  90
  91 (defun make-clipping-channel (width height initial-element)
  92   (make-array (* width height)
  93               :element-type '(unsigned-byte 8)
  94               :initial-element initial-element))
  95
  96 (defgeneric clipping-data (object)
  97   (:method ((clipping-path clipping-path))
  98     (data clipping-path))
  99   (:method ((clipping-path empty-clipping-path))
 100     nil))
 101
 102 (defgeneric writable-clipping-data (object)
 103   (:method ((clipping-path clipping-path))
 104     (data clipping-path))
 105   (:method ((clipping-path empty-clipping-path))
 106     (let* ((width (width clipping-path))
 107            (height (height clipping-path))
 108            (data (make-clipping-channel width height #xFF))
 109            (scratch (make-clipping-channel width height #x00)))
 110       (change-class clipping-path 'clipping-path
 111                     :data data
 112                     :scratch scratch)
 113       data))
 114   (:method ((clipping-path proxy-clipping-path))
 115     (let ((data (copy-seq (data clipping-path))))
 116       (change-class clipping-path 'clipping-path :data data)
 117       data)))
 118
 119 (defun make-clipping-path (width height)
 120   (make-instance 'empty-clipping-path :width width :height height))