/[geometry]/geometry/triangle.lisp
ViewVC logotype

Contents of /geometry/triangle.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Thu Oct 4 05:58:00 2007 UTC (6 years, 6 months ago) by rstrandh
Branch: rstrandh, MAIN
CVS Tags: start, HEAD
Changes since 1.1: +0 -0 lines
initial import
1 (in-package :ximage-triangle)
2
3 (defun triangle-area (x1 y1 x2 y2 x3 y3)
4 (* 0.5 (abs (+ (- (* x2 y1) (* x1 y2))
5 (- (* x3 y2) (* x2 y3))
6 (- (* x1 y3) (* x3 y1))))))
7
8 (defun quadrilateral-area (x1 y1 x2 y2 x3 y3 x4 y4)
9 (+ (triangle-area x1 y1 x2 y2 x3 y3)
10 (triangle-area x1 y1 x3 y3 x4 y4)))
11
12 (defun intersect-x (x x1 y1 x2 y2)
13 (+ y1 (/ (* (- x x1) (- y2 y1)) (- x2 x1))))
14
15 (defun intersect-y (y x1 y1 x2 y2)
16 (+ x1 (/ (* (- y y1) (- x2 x1)) (- y2 y1))))
17
18 (defun add-area-to-pixel (x y area)
19 (format t "x: ~a y:~a value: ~a~%" x y area))
20
21 ;;; add the area indicated by the corners of an
22 ;;; arbitrary triangle within a pixel to that pixel
23 (defun triangle-in-pixel (x y x1 y1 x2 y2 x3 y3 fun)
24 (funcall fun
25 x y (triangle-area x1 y1 x2 y2 x3 y3)))
26
27 (defun quadrilateral-in-pixel (x y x1 y1 x2 y2 x3 y3 x4 y4 fun)
28 (funcall fun
29 x y (quadrilateral-area x1 y1 x2 y2 x3 y3 x4 y4)))
30
31 ;;; render an area defined by the left and right edges of a scan line
32 ;;; and by two nonintersecting lines both running from the left edge to
33 ;;; the right edge of the scan line
34 ;;; left-base is the base of the trapezoid at the left edge
35 ;;; right-base is the base of the trapezoid at the left edge
36 (defun trapezoid-within-scanline (minx maxx y left-base right-base fun)
37 (when (= minx maxx)
38 (return-from trapezoid-within-scanline))
39 ;; divide by two to avoid doing that in the loop
40 (assert (>= left-base 0))
41 (assert (>= right-base 0))
42 (setf left-base (* 0.5 left-base))
43 (setf right-base (* 0.5 right-base))
44 (let ((db (/ (- right-base left-base) (- maxx minx))))
45 (loop for x from minx below maxx
46 for lb = left-base then (+ lb db)
47 for rb = (+ left-base db) then (+ rb db)
48 do (funcall fun x y (+ lb rb)))))
49
50 (defun render-triangle-three-points-in-scanline (y x1 y1 x2 y2 x3 y3 fun)
51 (let ((minx (floor (min x1 x2 x3)))
52 (maxx (1- (ceiling (max x1 x2 x3)))))
53 (if (= minx maxx)
54 ;; all three points are in a single pixel
55 (triangle-in-pixel minx y x1 y1 x2 y2 x3 y3 fun)
56 (progn
57 ;; sort the points by x coordinate
58 (when (< x2 x1)
59 (rotatef x1 x2)
60 (rotatef y1 y2))
61 (when (< x3 x1)
62 (rotatef x1 x3)
63 (rotatef y1 y3))
64 (when (< x3 x2)
65 (rotatef x2 x3)
66 (rotatef y2 y3))
67 (cond ((<= x2 (1+ minx))
68 ;; there are two corners in the first pixel
69 ;; (and one in the last pixel)
70 (let ((yyl1 (intersect-x (1+ minx) x1 y1 x3 y3))
71 (yyl2 (intersect-x (1+ minx) x2 y2 x3 y3))
72 (yyr1 (intersect-x maxx x1 y1 x3 y3))
73 (yyr2 (intersect-x maxx x2 y2 x3 y3)))
74 (quadrilateral-in-pixel
75 minx y x1 y1 (1+ minx) yyl1 (1+ minx) yyl2 x2 y2 fun)
76 (trapezoid-within-scanline
77 (1+ minx) maxx y (abs (- yyl1 yyl2)) (abs (- yyr1 yyr2)) fun)
78 (triangle-in-pixel maxx y maxx yyr1 maxx yyr2 x3 y3 fun)))
79 ((>= x2 maxx)
80 ;; there are two corners in the last pixel
81 ;; (and one in the first pixel)
82 (let ((yyl2 (intersect-x (1+ minx) x1 y1 x2 y2))
83 (yyl3 (intersect-x (1+ minx) x1 y1 x3 y3))
84 (yyr2 (intersect-x maxx x1 y1 x2 y2))
85 (yyr3 (intersect-x maxx x1 y1 x3 y3)))
86 (triangle-in-pixel minx y x1 y1 (1+ minx) yyl2 (1+ minx) yyl3 fun)
87 (trapezoid-within-scanline
88 (1+ minx) maxx y (abs (- yyl2 yyl3)) (abs (- yyr2 yyr3)) fun)
89 (quadrilateral-in-pixel
90 maxx y maxx yyr2 x2 y2 x3 y3 maxx yyr3 fun)))
91 (t
92 ;; there is one corner in the first pixel,
93 ;; one corner in the last pixel,
94 ;; and a third corner somewhere in the middle
95 ;; divide the triangle into two parts
96 (let ((yy (intersect-x x2 x1 y1 x3 y3)))
97 (render-triangle-three-points-in-scanline y x1 y1 x2 y2 x2 yy fun)
98 (render-triangle-three-points-in-scanline y x3 y3 x2 y2 x2 yy fun))))))))
99
100 (defun render-triangle-two-points-in-scanline (y x1 y1 x2 y2 x3 y3 fun)
101 ;; sort points by y coordinate
102 (when (< y2 y1)
103 (rotatef x1 x2)
104 (rotatef y1 y2))
105 (when (< y3 y1)
106 (rotatef x1 x3)
107 (rotatef y1 y3))
108 (when (< y3 y2)
109 (rotatef x2 x3)
110 (rotatef y2 y3))
111 ;; now it is either (x1,y1) or (x3,y3) that is outside the scan line
112 (if (< y1 (floor y2))
113 ;; (x1,y1) is outside
114 (let ((xx2 (intersect-y y x1 y1 x2 y2))
115 (xx3 (intersect-y y x1 y1 x3 y3)))
116 (render-triangle-three-points-in-scanline
117 y xx2 y x3 y3 x2 y2 fun)
118 (render-triangle-three-points-in-scanline
119 y xx3 y xx2 y x3 y3 fun))
120 ;; (x3,y3) is outside
121 (let ((xx1 (intersect-y (1+ y) x3 y3 x1 y1))
122 (xx2 (intersect-y (1+ y) x3 y3 x2 y2)))
123 (render-triangle-three-points-in-scanline
124 y xx1 (1+ y) x1 y1 x2 y2 fun)
125 (render-triangle-three-points-in-scanline
126 y xx1 (1+ y) xx2 (1+ y) x2 y2 fun))))
127
128 (defun render-triangle-one-point-in-scanline (y x1 y1 x2 y2 x3 y3 fun)
129 ;; sort points by y coordinate
130 (when (< y2 y1)
131 (rotatef x1 x2)
132 (rotatef y1 y2))
133 (when (< y3 y1)
134 (rotatef x1 x3)
135 (rotatef y1 y3))
136 (when (< y3 y2)
137 (rotatef x2 x3)
138 (rotatef y2 y3))
139 (cond ((>= y1 y)
140 ;; (x1,y1) is in the scanline
141 (let ((xx2 (intersect-y (1+ y) x1 y1 x2 y2))
142 (xx3 (intersect-y (1+ y) x1 y1 x3 y3)))
143 (render-triangle-three-points-in-scanline
144 y x1 y1 xx2 (1+ y) xx3 (1+ y) fun)))
145 ((>= y2 y)
146 ;; (x2,y2) is in the scanline
147 (let ((x12 (intersect-y y x1 y1 x2 y2))
148 (x23 (intersect-y (1+ y) x2 y2 x3 y3))
149 (xu (intersect-y y x1 y1 x3 y3))
150 (xl (intersect-y (1+ y) x1 y1 x3 y3)))
151 (render-triangle-three-points-in-scanline
152 y x2 y2 x12 y x23 (1+ y) fun)
153 (render-triangle-three-points-in-scanline
154 y x12 y xu y x23 (1+ y) fun)
155 (render-triangle-three-points-in-scanline
156 y x23 (1+ y) xu y xl (1+ y) fun)))
157 (t
158 ;; (x3,y3) is in the scanline
159 (let ((xx1 (intersect-y y x1 y1 x3 y3))
160 (xx2 (intersect-y y x2 y2 x3 y3)))
161 (render-triangle-three-points-in-scanline
162 y x3 y3 xx1 y xx2 y fun)))))
163
164 (defun render-triangle-no-points-in-scanline (y x1 y1 x2 y2 x3 y3 fun)
165 ;; sort points by y coordinate
166 (when (< y2 y1)
167 (rotatef x1 x2)
168 (rotatef y1 y2))
169 (when (< y3 y1)
170 (rotatef x1 x3)
171 (rotatef y1 y3))
172 (when (< y3 y2)
173 (rotatef x2 x3)
174 (rotatef y2 y3))
175 (if (< y2 y)
176 ;; points 1 and 2 above, point 3 below
177 (let ((x13u (intersect-y y x1 y1 x3 y3))
178 (x13l (intersect-y (1+ y) x1 y1 x3 y3))
179 (x23u (intersect-y y x2 y2 x3 y3))
180 (x23l (intersect-y (1+ y) x2 y2 x3 y3)))
181 (render-triangle-three-points-in-scanline
182 y x13u y x23u y x23l (1+ y) fun)
183 (render-triangle-three-points-in-scanline
184 y x13u y x23l (1+ y) x13l (1+ y) fun))
185 ;; point 1 above, points 2 and 3 below
186 (let ((x12u (intersect-y y x1 y1 x2 y2))
187 (x12l (intersect-y (1+ y) x1 y1 x2 y2))
188 (x13u (intersect-y y x1 y1 x3 y3))
189 (x13l (intersect-y (1+ y) x1 y1 x3 y3)))
190 (render-triangle-three-points-in-scanline
191 y x12u y x13u y x12l (1+ y) fun)
192 (render-triangle-three-points-in-scanline
193 y x13u y x12l (1+ y) x13l (1+ y) fun))))
194
195 (defun number-of-points-in-scanline (y y1 y2 y3)
196 (let ((result 0))
197 (when (<= y y1 (1+ y)) (incf result))
198 (when (<= y y2 (1+ y)) (incf result))
199 (when (<= y y3 (1+ y)) (incf result))
200 result))
201
202 (defun render-triangle-scanline (y x1 y1 x2 y2 x3 y3 fun)
203 (ecase (number-of-points-in-scanline y y1 y2 y3)
204 (0 (render-triangle-no-points-in-scanline y x1 y1 x2 y2 x3 y3 fun))
205 (1 (render-triangle-one-point-in-scanline y x1 y1 x2 y2 x3 y3 fun))
206 (2 (render-triangle-two-points-in-scanline y x1 y1 x2 y2 x3 y3 fun))))
207
208 (defun points-are-aligned-p (x1 y1 x2 y2 x3 y3)
209 (= (* (- y2 y1) (- x3 x1))
210 (* (- y3 y1) (- x2 x1))))
211
212 (defun render-triangle (x1 y1 x2 y2 x3 y3 &optional (fun #'add-area-to-pixel))
213 (unless (points-are-aligned-p x1 y1 x2 y2 x3 y3)
214 (let ((miny (floor (min y1 y2 y3)))
215 (maxy (ceiling (1- (max y1 y2 y3)))))
216 (if (= miny maxy)
217 (render-triangle-three-points-in-scanline miny x1 y1 x2 y2 x3 y3 fun)
218 (loop for y from miny to maxy
219 do (render-triangle-scanline y x1 y1 x2 y2 x3 y3 fun))))))
220
221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
222 ;;;
223 ;;; Tests
224 ;;;
225 ;;; the tests seems to indicate significant differences for very small
226 ;;; triangles, but not for large ones.
227
228
229 (defun test-render-triangle-three-points-in-scanline (n)
230 (loop repeat n
231 do (let ((y (random 10))
232 (total-area 0))
233 (flet ((add-area-to-pixel (x y area)
234 (declare (ignore x y))
235 (incf total-area area)))
236 (let ((y1 (+ y (random 1.0)))
237 (y2 (+ y (random 1.0)))
238 (y3 (+ y (random 1.0)))
239 (x1 (random 10.0))
240 (x2 (random 10.0))
241 (x3 (random 10.0)))
242 (render-triangle x1 y1 x2 y2 x3 y3 #'add-area-to-pixel)
243 (unless (<= 0.99 (/ (triangle-area x1 y1 x2 y2 x3 y3) total-area) 1.01)
244 (format t "area: ~s sum of areas: ~s~%"
245 (triangle-area x1 y1 x2 y2 x3 y3)
246 total-area)))))))
247
248 (defun test-render-triangle (n)
249 (loop repeat n
250 do (let ((total-area 0))
251 (flet ((add-area-to-pixel (x y area)
252 (declare (ignore x y))
253 (incf total-area area)))
254 (let ((y1 (random 10.0))
255 (y2 (random 10.0))
256 (y3 (random 10.0))
257 (x1 (random 10.0))
258 (x2 (random 10.0))
259 (x3 (random 10.0)))
260 (render-triangle x1 y1 x2 y2 x3 y3 #'add-area-to-pixel)
261 (unless (<= 0.99 (/ (triangle-area x1 y1 x2 y2 x3 y3) total-area) 1.01)
262 (format t "area: ~s sum of areas: ~s~%"
263 (triangle-area x1 y1 x2 y2 x3 y3)
264 total-area)))))))

  ViewVC Help
Powered by ViewVC 1.1.5