aa.lisp

   1 ;;;; cl-vectors -- Rasterizer and paths manipulation library
   2 ;;;; Copyright (C) 2007  Frédéric Jolliton <frederic@jolliton.com>
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the Lisp Lesser GNU Public License
   6 ;;;; (http://opensource.franz.com/preamble.html), known as the LLGPL.
   7 ;;;;
   8 ;;;; This library is distributed in the hope that it will be useful, but
   9 ;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the Lisp
  11 ;;;; Lesser GNU Public License for more details.
  12
  13 ;;;; This file implement the AA algorithm from the AntiGrain project
  14 ;;;; (http://antigrain.com/).
  15 ;;;;
  16 ;;;; Changelogs:
  17 ;;;;
  18 ;;;; 2007-03-11: Extended the protocol to provide a way to sweep only
  19 ;;;;             a rectangular zone of the resulting state. This was
  20 ;;;;             done with some new functions: FREEZE-STATE,
  21 ;;;;             SCANLINE-SWEEP, SCANLINE-Y and CELLS-SWEEP/RECTANGLE.
  22 ;;;;             The function CELLS-SWEEP is now based on them.
  23 ;;;;
  24 ;;;; 2007-02-25: Released under LLGPL this time. Future changes made
  25 ;;;;             in this file will be thus covered by this license.
  26 ;;;;
  27 ;;;; 2007-01-20: Minors updates to comments and code.
  28 ;;;;
  29 ;;;; 2007-01-11: I chose to release the code in this file in public
  30 ;;;;             domain. You can do whatever you want with the code.
  31 ;;;;
  32 ;;;; 2007-01-07: fixed 2 bugs related to cells reuse. The first bug
  33 ;;;;             was that the cell after the last reused one was kept
  34 ;;;;             in the list. The second bug occured when the latest
  35 ;;;;             cell (the current one) was empty. The code was
  36 ;;;;             failing to correctly eliminate unused cells in such
  37 ;;;;             case.
  38 ;;;;
  39 ;;;; 2007-01-05: +cell-width+ is no longer passed as parameter to let
  40 ;;;;             the CL compiler optimize various computation
  41 ;;;;             involving this value. Added docstrings and
  42 ;;;;             (hopefully) clarified some points.
  43 ;;;;
  44 ;;;; 2006-12-31: moved examples to a separate file
  45 ;;;;
  46 ;;;; 2006-12-30: added animated GIF (using Skippy) example
  47 ;;;;
  48 ;;;; 2006-12-30: cleaned the code, factorized, simplified
  49 ;;;;
  50 ;;;; 2006-12-30: map-grid-spans rewritten in term of map-line-spans
  51 ;;;;
  52 ;;;; 2006-12-30: first release
  53 ;;;;
  54 ;;;; About AntiGrain: "Anti-Grain Geometry (AGG) is an Open Source,
  55 ;;;; free of charge graphic library, written in industrially standard
  56 ;;;; C++." "A High Quality Rendering Engine for C++". Its main author
  57 ;;;; is Maxim Shemanarev. Project home page is at http://antigrain.com/
  58 ;;;;
  59 ;;;; How to use it:
  60 ;;;;
  61 ;;;; 1) create a state with MAKE-STATE, or reuse a previous state by
  62 ;;;;    calling STATE-RESET on it.
  63 ;;;;
  64 ;;;; 2) call LINE-F (or LINE) to draw each line of one or several
  65 ;;;;    closed polygons. It is very important to close them to get a
  66 ;;;;    coherent result. Note that nothing is really drawn at this
  67 ;;;;    stage (not until the call to CELLS-SWEEP.)
  68 ;;;;
  69 ;;;; 3) finally, call CELLS-SWEEP to let it call your own function for
  70 ;;;;    each pixels covered by the polygon(s), where the callback
  71 ;;;;    function take 3 arguments: x, y, alpha. Pixels are scanned on
  72 ;;;;    increasing y, then on increasing x. Optionnaly, CELLS-SWEEP
  73 ;;;;    can take another callback function as parameter. See its
  74 ;;;;    documentation for details.
  75 ;;;;
  76 ;;;;    The alpha value passed to the callback function can be used in
  77 ;;;;    various way. Usually you want:
  78 ;;;;
  79 ;;;;      (defun normalize-alpha (alpha)
  80 ;;;;        (min 255 (abs alpha)))
  81 ;;;;
  82 ;;;;    to get a normalized alpha value between 0 and 255. But you may
  83 ;;;;    also be interested by:
  84 ;;;;
  85 ;;;;      (defun even-odd-alpha (alpha)
  86 ;;;;        (let ((value (mod alpha 512)))
  87 ;;;;          (min 255 (if (< value 256) value (- 512 value)))))
  88 ;;;;
  89 ;;;;    to simulate "even/odd" fill. You can also use the alpha value
  90 ;;;;    to render polygons without anti-aliasing by using:
  91 ;;;;
  92 ;;;;      (defun bool-alpha (value)
  93 ;;;;        (if (>= (abs value) 128) 255 0))
  94 ;;;;
  95 ;;;;    or, for "even/odd" fill:
  96 ;;;;
  97 ;;;;      (defun bool-even-odd-alpha (value)
  98 ;;;;        (if (<= 128 (mod (abs value) 256) 384) 255 0))
  99 ;;;;
 100 ;;;; Note: Drawing direction (clockwise or counter-clockwise) is only
 101 ;;;; important if polygons overlap during a single
 102 ;;;; cells-state. Opposite directions produce hole at the intersection
 103 ;;;; (coverage is canceled), while identical directions does not
 104 ;;;; (coverage overflow.)
 105 ;;;;
 106 ;;;; The latest version can be downloaded from:
 107 ;;;;
 108 ;;;;     http://tuxee.net/cl-aa.lisp
 109 ;;;;     http://tuxee.net/cl-aa-sample.lisp
 110 ;;;;
 111 ;;;; See also:
 112 ;;;;
 113 ;;;;     http://projects.tuxee.net/cl-aa-path/
 114 ;;;;
 115 ;;;; See examples of output at:
 116 ;;;;
 117 ;;;;     http://tuxee.net/cl-aa-1.png
 118 ;;;;     http://tuxee.net/cl-aa-2.png (this one was a bug.)
 119 ;;;;     http://tuxee.net/cl-aa-3.png
 120 ;;;;     http://tuxee.net/cl-aa-4.png
 121 ;;;;     http://tuxee.net/cl-aa-5.png (when testing transparency, but looks bad.)
 122 ;;;;     http://tuxee.net/cl-aa-6.png
 123 ;;;;     http://tuxee.net/cl-aa-7.png
 124 ;;;;     http://tuxee.net/cl-aa-8.png
 125 ;;;;     http://tuxee.net/cl-aa-stroke-0.png (using stroke functions not provided here.)
 126 ;;;;     http://tuxee.net/cl-aa-stroke-1.png
 127 ;;;;     http://tuxee.net/cl-aa-stroke-2.png
 128 ;;;;     http://tuxee.net/cl-aa-skippy-1.gif (animated GIF, thanks to Skippy library)
 129 ;;;;     http://tuxee.net/cl-aa-skippy-2.gif
 130 ;;;;
 131 ;;;; The code is absolutely NOT optimized in any way. It was mainly to
 132 ;;;; figure how the algorithm was working. Also, I don't have tested
 133 ;;;; many corner cases. It is absolutely NOT for production use.
 134 ;;;;
 135 ;;;; About the example, note that the resulting image is exported as a
 136 ;;;; PNM file. Not great, but no need for any external lib. You can
 137 ;;;; use pnmtopng to convert it to PNG afterward.
 138 ;;;;
 139 ;;;; Inspiration come from agg/include/agg_rasterizer_cells_aa.h and
 140 ;;;; agg/include/agg_rasterizer_scanline_aa.h sources files from the
 141 ;;;; AntiGrain project (version 2.5 at this date.)
 142 ;;;;
 143 ;;;; For animated GIF, see Zach Beane's Skippy project at:
 144 ;;;;     http://www.cliki.net/Skippy
 145
 146 ;;;; Naming convention:
 147 ;;;; foo-m for fixed-point mantissa,
 148 ;;;; foo-f for fixed-point fractional part.
 149
 150 #+nil(error "This file assume that #+NIL is never defined.")
 151
 152 (defpackage #:net.tuxee.aa
 153   (:use #:common-lisp)
 154   (:nicknames #:aa)
 155   (:export #:make-state
 156            #:state-reset
 157            #:line
 158            #:line-f
 159            #:freeze-state
 160            #:scanline-y
 161            #:scanline-sweep
 162            #:cells-sweep
 163            #:cells-sweep/rectangle))
 164
 165 (in-package #:net.tuxee.aa)
 166
 167 ;;;--[ Utility function ]-----------------------------------------------------
 168
 169 (defconstant +cell-width+ 256
 170   "A cell represent a pixel square, and the width is the
 171 fractional part of the fixed-point coordinate. A large value
 172 increase precision. 256 should be enough though. Note that
 173 smaller value should NOT increase performance.")
 174
 175 ;;; This function is used to split a line at each pixel boundaries
 176 ;;; (when using sub-pixel coordinates.) Since the function only cut
 177 ;;; along one axis, it must be called twice (with the second call with
 178 ;;; coordinates swapped) to split along X and Y axis.
 179 ;;;
 180 ;;; In the comments below, by "main axis" I mean the X axis if A1 and
 181 ;;; A2 are the X coordinates, or the Y axis otherwise.
 182 (declaim (inline map-line-spans))
 183 (defun map-line-spans (function a1 b1 a2 b2)
 184   "Call FUNCTION for each segment of a line with integer
 185 coordinates (A1,B1)-(A2,B2) cut by a grid of spacing
 186 +CELL-WIDTH+."
 187   (multiple-value-bind (b1-m b1-f) (floor b1 +cell-width+)
 188     (multiple-value-bind (b2-m b2-f) (floor b2 +cell-width+)
 189       (cond
 190         ;; The line doesn't cross the grid in the main axis. We have a
 191         ;; single segment. Just call FUNCTION.
 192         ((= b1-m b2-m)
 193          (funcall function b1-m a1 b1-f a2 b2-f))
 194         ;; The line cross the grid in the main axis. We have at least
 195         ;; 2 segments.
 196         (t
 197          (let* ((b-m b1-m)
 198                 (delta-a (- a2 a1))
 199                 (delta-b (abs (- b2 b1)))
 200                 (b-increment (signum (- b2 b1)))
 201                 (from-boundary (if (< b1 b2) 0 +cell-width+))
 202                 (to-boundary (if (< b1 b2) +cell-width+ 0)))
 203            (multiple-value-bind (a ma) (floor (+ (* delta-a (if (< b1 b2)
 204                                                                 (- +cell-width+ b1-f)
 205                                                                 b1-f))
 206                                                  ;; a littre change compared to
 207                                                  ;; AntiGrain AA algorithm. Used
 208                                                  ;; to round to the nearest integer
 209                                                  ;; instead of the "floor" one.
 210                                                  (floor delta-b 2))
 211                                               delta-b)
 212              (incf a a1)
 213              ;; The first segment (to reach the first grid boundary)
 214              (funcall function b1-m a1 b1-f a to-boundary)
 215              (incf b-m b-increment)
 216              (when (/= b-m b2-m)
 217                (multiple-value-bind (step mod) (floor (* +cell-width+ delta-a) delta-b)
 218                  (loop
 219                     do (let ((prev-a a))
 220                          (incf a step)
 221                          (incf ma mod)
 222                          (when (>= ma delta-b)
 223                            (incf a)
 224                            (decf ma delta-b))
 225                          ;; A segment from one grid boundary to the other.
 226                          (funcall function b-m prev-a from-boundary a to-boundary)
 227                          (incf b-m b-increment))
 228                     while (/= b-m b2-m))))
 229              ;; The last segment (from the latest grid boundary up to
 230              ;; the final coordinates.)
 231              (funcall function b-m a from-boundary a2 b2-f))))))))
 232
 233 (defun map-grid-spans (function x1 y1 x2 y2)
 234   "Call FUNCTION for each segments of the line from (X1,Y1)
 235 to (X2,Y2) cut by a grid with spacing +CELL-WIDTH+."
 236   (check-type x1 integer)
 237   (check-type y1 integer)
 238   (check-type x2 integer)
 239   (check-type y2 integer)
 240   (flet ((hline (y-m x1 y1-f x2 y2-f)
 241            (declare (integer y-m x1 y1-f x2 y2-f))
 242            (flet ((pixel (x-m y1-f x1-f y2-f x2-f)
 243                     (declare (integer x-m y1-f x1-f y2-f x2-f))
 244                     (funcall function x-m y-m x1-f y1-f x2-f y2-f)))
 245              ;; further split along Y axis
 246              (map-line-spans #'pixel y1-f x1 y2-f x2))))
 247     ;; first split along X axis
 248     (map-line-spans #'hline x1 y1 x2 y2)))
 249
 250 ;;;--[ cell ]-----------------------------------------------------------------
 251
 252 ;;; Note that cover and area are unbound and could take any value
 253 ;;; while drawing polygons (even negative values), especially when
 254 ;;; drawing multiple overlapping polygons. However, for non
 255 ;;; overlapping polygons, cover is in the range (-width,width) and
 256 ;;; area in the range (-2*width*width,2*width*width), where width is
 257 ;;; +cell-width+ defined above.
 258 (defstruct cell
 259   "A cell used to represent the partial area covered by a line
 260 passing by a corresponding pixel. The cell alone doesn't hold all
 261 the information to calculate the area."
 262   (x 0 :type integer)
 263   (y 0 :type integer)
 264   (cover 0 :type integer)
 265   (area 0 :type integer))
 266
 267 (declaim (inline cell-empty-p))
 268 (defun cell-empty-p (cell)
 269   "Test if the cell is empty. A cell is empty when COVER and AREA
 270 are both zero."
 271   (and (zerop (cell-cover cell))
 272        (zerop (cell-area cell))))
 273
 274 (declaim (inline cell-reset))
 275 (defun cell-reset (cell)
 276   "Reset the cell such that CELL-EMPTY-P is true."
 277   (setf (cell-area cell) 0
 278         (cell-cover cell) 0))
 279
 280 (declaim (inline compare-cells))
 281 (defun compare-cells (a b)
 282   "Compare coordinates between 2 cells. Used to sort cells by Y,
 283 then by X."
 284   (or (< (cell-y a) (cell-y b))
 285       (and (= (cell-y a) (cell-y b))
 286            (< (cell-x a) (cell-x b)))))
 287
 288 (declaim (inline update-cell))
 289 (defun update-cell (cell fx1 fy1 fx2 fy2)
 290   "Update COVER and AREA given a segment inside the corresponding
 291 cell. FX1, FY1, FX2 and FY2 must be subpixel coordinates between
 292 0 and +CELL-WIDTH+ included."
 293   (let ((delta (- fy2 fy1)))
 294     (incf (cell-cover cell) delta)
 295     ;; Note: increase by twice the area, for optimization
 296     ;; purpose. Will be divided by 2 in the final pass.
 297     (incf (cell-area cell) (* (+ fx1 fx2) delta))))
 298
 299 ;;;-------------------------------------------------------------------------
 300
 301 (defconstant +alpha-range+ 256
 302   "For non overlapping polygons, the alpha value will be in the
 303 range (-limit,limit) where limit is +alpha-range+. The value is
 304 negative or positive accordingly to the polygon
 305 orientation (clockwise or counter-clockwise.)")
 306
 307 (defconstant +alpha-divisor+ (floor (* 2 +cell-width+ +cell-width+)
 308                                     +alpha-range+)
 309   "Constant used to translate value computed by AREA and COVER to
 310 an alpha value.")
 311
 312 (defstruct state
 313   "AA state. Hold all the cells generated when drawing lines."
 314   (current-cell (make-cell) :type cell)
 315   (cells nil)
 316   (scanlines nil)
 317   ;; these slots for reusing cells with state-reset
 318   (end-of-lines nil)
 319   (dropped-cells nil)
 320   (recycling-cells (cons nil nil)))
 321
 322 (defun state-reset (state)
 323   "Reset the state, losing all accumulated cells. It can be
 324 faster or less memory consuming to reset a state and reuse it,
 325 rather than creating a new state."
 326   (cell-reset (state-current-cell state))
 327   (when (state-end-of-lines state)
 328     ;; join back the scanlines to form a single list
 329     (loop for line in (rest (state-scanlines state))
 330        for eol in (state-end-of-lines state)
 331        do (setf (cdr eol) line)))
 332   (let ((cells (nconc (state-dropped-cells state)
 333                       (state-cells state))))
 334     (setf (state-recycling-cells state) (cons nil cells)
 335           (state-scanlines state) nil
 336           (state-end-of-lines state) nil
 337           (state-dropped-cells state) nil
 338           (state-cells state) cells)))
 339
 340 (declaim (inline state-push-current-cell))
 341 (defun state-push-cell (state cell)
 342   "Store a copy of the current cell into the cells list. If the
 343 state was reset, possibly reuse previous cells."
 344   (unless (cell-empty-p cell)
 345     (let ((recycling-cells (cdr (state-recycling-cells state))))
 346       (cond
 347         (recycling-cells
 348          (let ((target-cell (car recycling-cells)))
 349            (setf (cell-x target-cell) (cell-x cell)
 350                  (cell-y target-cell) (cell-y cell)
 351                  (cell-cover target-cell) (cell-cover cell)
 352                  (cell-area target-cell) (cell-area cell)))
 353          (setf (state-recycling-cells state) recycling-cells))
 354         (t
 355          (push (copy-cell cell) (state-cells state)))))))
 356
 357 (defun state-finalize (state)
 358   "Finalize the state."
 359   ;; Ensure that the current cell is stored with other cells and that
 360   ;; old cells (before the last reset) that were not reused are
 361   ;; correctly removed from the result.
 362   (let ((current-cell (state-current-cell state)))
 363     (unless (cell-empty-p current-cell)
 364       (state-push-cell state current-cell)
 365       (cell-reset current-cell))
 366     (when (cdr (state-recycling-cells state))
 367       (setf (cdr (state-recycling-cells state)) nil)
 368       (unless (car (state-recycling-cells state))
 369         (setf (state-cells state) nil)))))
 370
 371 (defun set-current-cell (state x y)
 372   "Ensure current cell is one at coordinate X and Y. If not,
 373 the current cell is stored, then reset accordingly to new
 374 coordinate.
 375
 376 Returns the current cell."
 377   (let ((current-cell (state-current-cell state)))
 378     (declare (cell current-cell))
 379     (when (or (/= x (cell-x current-cell))
 380               (/= y (cell-y current-cell)))
 381       ;; Store the current cell, then reset it.
 382       (state-push-cell state current-cell)
 383       (setf (cell-x current-cell) x
 384             (cell-y current-cell) y
 385             (cell-cover current-cell) 0
 386             (cell-area current-cell) 0))
 387     current-cell))
 388
 389 (defun state-sort-cells (state)
 390   "Sort the cells by Y, then by X."
 391   (setf (state-cells state)
 392         (sort (state-cells state) #'compare-cells)))
 393
 394 (defun line (state x1 y1 x2 y2)
 395   "Draw a line from (X1,Y1) to (X2,Y2). All coordinates are
 396 integers with subpixel accuracy (a pixel width is given by
 397 +CELL-WIDTH+.) The line must be part of a closed polygon."
 398   (declare (integer x1 y1 x2 y2))
 399   (map-grid-spans (lambda (x y fx1 fy1 fx2 fy2)
 400                          (update-cell (set-current-cell state x y)
 401                                       fx1 fy1 fx2 fy2))
 402                        x1 y1 x2 y2))
 403
 404 (defun line-f (state x1 y1 x2 y2)
 405   "Draw a line, whose coordinates are translated to fixed-point
 406 as expected by function LINE. This is a convenient function to
 407 not depend on +CELL-WIDTH+."
 408   (labels ((float-to-fixed (n)
 409              (values (round (* +cell-width+ n)))))
 410     (line state
 411           (float-to-fixed x1) (float-to-fixed y1)
 412           (float-to-fixed x2) (float-to-fixed y2))))
 413
 414 (declaim (inline compute-alpha))
 415 (defun compute-alpha (cover area)
 416   "Compute the alpha value given the accumulated cover and the
 417 actual area of a cell."
 418   (truncate (- (* 2 +cell-width+ cover) area)
 419             +alpha-divisor+))
 420
 421 (defun freeze-state (state)
 422   "Freeze the state and return a list of scanlines. A scanline is
 423 an object which can be examined with SCANLINE-Y and processed
 424 with SCANLINE-SWEEP."
 425   (unless (state-scanlines state)
 426     (state-finalize state)
 427     (state-sort-cells state)
 428     (let (lines
 429           end-of-lines
 430           dropped-cells
 431           (cells (state-cells state)))
 432       (when cells
 433         (push cells lines)
 434         (let ((previous-cell (first cells)))
 435           (loop
 436              (unless (rest cells)
 437                (return))
 438              (let ((cell (second cells))
 439                    (rest (cdr cells)))
 440                (cond
 441                  ((/= (cell-y previous-cell) (cell-y cell))
 442                   ;; different y, break the cells list, begin a new
 443                   ;; line.
 444                   (push cells end-of-lines)
 445                   (push rest lines)
 446                   (setf (cdr cells) nil
 447                         previous-cell cell)
 448                   (setf cells rest))
 449                  ((/= (cell-x previous-cell) (cell-x cell))
 450                   ;; same y, different x, do nothing special, move to
 451                   ;; the next cell.
 452                   (setf previous-cell cell)
 453                   (setf cells rest))
 454                  (t
 455                   ;; same coordinates, accumulate current cell into
 456                   ;; the previous, and remove current from the list.
 457                   (incf (cell-cover previous-cell) (cell-cover cell))
 458                   (incf (cell-area previous-cell) (cell-area cell))
 459                   (push cell dropped-cells)
 460                   (setf (cdr cells) (cdr rest))))))))
 461       (setf (state-scanlines state) (nreverse lines)
 462             (state-end-of-lines state) (nreverse end-of-lines)
 463             (state-dropped-cells state) dropped-cells)))
 464   (state-scanlines state))
 465
 466 (declaim (inline scanline-y))
 467 (defun scanline-y (scanline)
 468   "Get the Y position of SCANLINE."
 469   (cell-y (first scanline)))
 470
 471 (defun scanline-sweep (scanline function function-span &key start end)
 472   "Call FUNCTION for each pixel on the polygon covered by
 473 SCANLINE. The pixels are scanned in increasing X. The sweep can
 474 be limited to a range by START (included) or/and END (excluded)."
 475   (declare (optimize speed (debug 0) (safety 0) (space 2)))
 476   (let ((cover 0)
 477         (y (scanline-y scanline))
 478         (cells scanline)
 479         (last-x nil))
 480     (when start
 481       ;; skip initial cells that are before START
 482       (loop while (and cells (< (cell-x (car cells)) start))
 483          do (incf cover (cell-cover (car cells)))
 484          (setf last-x (cell-x (car cells))
 485                cells (cdr cells))))
 486     (when cells
 487       (dolist (cell cells)
 488         (let ((x (cell-x cell)))
 489           (when (and last-x (> x (1+ last-x)))
 490             (let ((alpha (compute-alpha cover 0)))
 491               (unless (zerop alpha)
 492                 (let ((start-x (if start (max start (1+ last-x)) (1+ last-x)))
 493                       (end-x (if end (min end x) x)))
 494                   (if function-span
 495                       (funcall function-span start-x end-x y alpha)
 496                       (loop for ix from start-x below end-x
 497                          do (funcall function ix y alpha)))))))
 498           (when (and end (>= x end))
 499             (return))
 500           (incf cover (cell-cover cell))
 501           (let ((alpha (compute-alpha cover (cell-area cell))))
 502             (unless (zerop alpha)
 503               (funcall function x y alpha)))
 504           (setf last-x x))))))
 505
 506 (defun cells-sweep/rectangle (state x1 y1 x2 y2 function &optional function-span)
 507   "Call FUNCTION for each pixel on the polygon described by
 508 previous call to LINE or LINE-F. The pixels are scanned in
 509 increasing Y, then on increasing X. This is limited to the
 510 rectangle region specified with (X1,Y1)-(X2,Y2) (where X2 must be
 511 greater than X1 and Y2 must be greater than Y1, to describe a
 512 non-empty region.)
 513
 514 For optimization purpose, the optional FUNCTION-SPAN, if
 515 provided, is called for a full span of identical alpha pixel. If
 516 not provided, a call is made to FUNCTION for each pixel in the
 517 span."
 518   (let ((scanlines (freeze-state state)))
 519     (dolist (scanline scanlines)
 520       (when (<= y1 (scanline-y scanline) (1- y2))
 521         (scanline-sweep scanline function function-span :start x1 :end x2))))
 522   (values))
 523
 524 (defun cells-sweep (state function &optional function-span)
 525   "Call FUNCTION for each pixel on the polygon described by
 526 previous call to LINE or LINE-F. The pixels are scanned in
 527 increasing Y, then on increasing X.
 528
 529 For optimization purpose, the optional FUNCTION-SPAN, if
 530 provided, is called for a full span of identical alpha pixel. If
 531 not provided, a call is made to FUNCTION for each pixel in the
 532 span."
 533   (let ((scanlines (freeze-state state)))
 534     (dolist (scanline scanlines)
 535       (scanline-sweep scanline function function-span)))
 536   (values))