/pliant/graphic/vector/outline.pli
1	abstract
2	[Filling an outline (Pliant formula or Bezier)]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	#
6	# This program is free software; you can redistribute it and/or
7	# modify it under the terms of the GNU General Public License version 2
8	# as published by the Free Software Foundation.
9	#
10	# This program is distributed in the hope that it will be useful,
11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13	# GNU General Public License for more details.
14	#
15	# You should have received a copy of the GNU General Public License
16	# version 2 along with this program; if not, write to the Free Software
17	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19	module "/pliant/language/compiler.pli"
20	module "/pliant/math/curve.pli"
21	module "/pliant/math/point.pli"
22	module "/pliant/math/transform.pli"
23	module "/pliant/graphic/image/prototype.pli"
24	module "/pliant/graphic/misc/float.pli"
25
26	public
27	constant outline_evenodd 0 # odd even
28	constant outline_nonzero 1 # non zero
29
30
31	type OutlineChain
32	field Array:Point2 points
33	field Int current
34	field Float x
35	field Int way
36
37	type Outline
38	field Array:OutlineChain chains
39
40
41	method outline build_chains points
42	arg_rw Outline outline ; arg Array:Point2 points
43	var Int start := 0 ; var Float m := float_max
44	for (var Int i) 0 points:size-1
45	if points:i:y<m
46	start := i ; m := points:i:y
47	var Int stop := start+points:size
48	var Int top := start
49	while top<>stop
50	var Int bottom := top
51	while bottom<>stop and (points (bottom+1)%points:size):y>=(points bottom%points:size):y
52	bottom += 1
53	if bottom=stop
54	return
55	outline:chains size += 1
56	var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1
57	chain way := 1
58	chain:points size := bottom-top+1 ; check chain:points:size>=2
59	for (var Int i) 0 bottom-top
60	chain:points i := points (top+i)%points:size
61	var Int back := bottom
62	while back<>stop and (points (back+1)%points:size):y<=(points back%points:size):y
63	back += 1
64	outline:chains size += 1
65	var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1
66	chain way := -1
67	chain:points size := back-bottom+1 ; check chain:points:size>=2
68	for (var Int i) 0 back-bottom
69	chain:points i := points (back-i)%points:size
70	top := back
71
72
73	method outline bbox min_x min_y max_x max_y
74	arg Outline outline ; arg_w Float min_x min_y max_x max_y
75	min_x := float_max
76	min_y := float_max
77	max_x := -float_max
78	max_y := -float_max
79	for (var Int i) 0 outline:chains:size-1
80	var Pointer:OutlineChain chain :> outline:chains i
81	for (var Int j) 0 chain:points:size-1
82	var Pointer:Point2 point :> chain:points j
83	min_x := min min_x point:x
84	min_y := min min_y point:y
85	max_x := max max_x point:x
86	max_y := max max_y point:y
87	if min_x=float_max
88	min_x := undefined
89	min_y := undefined
90	max_x := undefined
91	max_y := undefined
92
93
94	function compare a b -> c
95	arg OutlineChain a b ; arg Int c
96	c := compare a:points:0:y b:points:0:y
97
98	function quick_sort_chains chains nb
99	arg Address chains ; arg Int nb
100	if nb>2
101	var Int ip := nb\2
102	swap (chains map OutlineChain ip) (chains map OutlineChain nb-1)
103	var Pointer:OutlineChain p :> chains map OutlineChain nb-1
104	var Int i0 := 0 ; var Int i1 := nb-1
105	while i0<i1
106	var Pointer:OutlineChain q :> chains map OutlineChain i0
107	if p<q
108	i1 -= 1
109	swap q (chains map OutlineChain i1)
110	else
111	i0 += 1
112	swap p (chains map OutlineChain i0)
113	quick_sort_chains chains i0
114	quick_sort_chains (chains translate OutlineChain i0+1) nb-i0-1
115	eif nb=2
116	var Pointer:OutlineChain p :> chains map OutlineChain 1
117	var Pointer:OutlineChain q :> chains map OutlineChain 0
118	if p<q
119	swap p q
120
121	method p index_x x delta -> i
122	arg ImagePrototype p ; arg Float x delta ; arg Int i
123	i := cast (x-p:x0)/(p:x1-p:x0)*p:size_x+delta Int
124
125	method p index_y y delta -> i
126	arg ImagePrototype p ; arg Float y delta ; arg Int i
127	i := cast (y-p:y0)/(p:y1-p:y0)*p:size_y+delta Int
128
129	method img fill outline mode color
130	oarg_rw ImagePrototype img ; arg_rw Outline outline ; arg Int mode ; arg Address color
131	outline bbox (var Float min_x) (var Float min_y) (var Float max_x) (var Float max_y)
132	if min_x=undefined
133	return
134	var Int iy0 := img index_y min_y -0.499
135	var Int iy1 := (img index_y max_y -0.499)+1
136	img clip (var Int ix0) iy0 (var Int ix1) iy1
137	if outline:chains:size=0 or iy1<=iy0
138	return
139	quick_sort_chains (addressof outline:chains:0) outline:chains:size
140	var Int n0 := 0 ; var Int n1 := 0
141	for (var Int iy) iy0 iy1-1
142	var Float y := img:y0+(iy+0.5)/img:size_y*(img:y1-img:y0)
143	# add new active chains
144	while n1<outline:chains:size and outline:chains:n1:points:0:y<=y
145	outline:chains:n1:current := 0
146	n1 += 1
147	# forward active chains and drop terminated chains
148	for (var Int i) n0 n1-1
149	var Pointer:OutlineChain chain :> outline:chains:i
150	part forward
151	while (chain:points chain:current+1):y<=y
152	if chain:current+2<chain:points:size
153	chain current += 1
154	else
155	if i<>n0
156	swap outline:chains:i outline:chains:n0
157	n0 += 1
158	leave forward
159	# compute horizontal positions
160	for (var Int i) n0 n1-1
161	var Pointer:OutlineChain chain :> outline:chains:i
162	var Pointer:Point2 p0 :> chain:points chain:current
163	var Pointer:Point2 p1 :> chain:points chain:current+1
164	chain x := p0:x+(p1:x-p0:x)*(y-p0:y)/(p1:y-p0:y)
165	# sort active chains from left to right
166	for (var Int i) n0+1 n1-1
167	var Int j := i
168	while j>n0 and outline:chains:j:x<outline:chains:(j-1):x
169	swap outline:chains:j outline:chains:(j-1)
170	j -= 1
171	# draw
172	check (n1-n0)%2=0
173	if mode=outline_evenodd
174	for (var Int i) n0 n1-2 step 2
175	var Int seg_x0 := max (img index_x outline:chains:i:x 0) 0
176	var Int seg_x1 := min (img index_x outline:chains:(i+1):x 0) img:size_x
177	if seg_x1>seg_x0
178	img fill seg_x0 iy seg_x1-seg_x0 color
179	eif mode=outline_nonzero
180	var Int count := 0
181	for (var Int i) n0 n1-2
182	count += outline:chains:i:way
183	if count<>0
184	var Int seg_x0 := max (img index_x outline:chains:i:x 0) 0
185	var Int seg_x1 := min (img index_x outline:chains:(i+1):x 0) img:size_x
186	if seg_x1>seg_x0
187	img fill seg_x0 iy seg_x1-seg_x0 color
188
189
190	method img fill curves mode t color
191	oarg_rw ImagePrototype img ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color
192	var Float epsilon := (min (abs img:x1-img:x0)/img:size_x (abs img:y1-img:y0)/img:size_y)/4
193	var Outline outline
194	for (var Int i) 0 curves:size-1
195	var Array:Point2 pts := curves:i polyline t epsilon
196	outline build_chains pts
197	img fill outline mode color
198
199
200	method img rectangle x0 y0 x1 y1 color
201	oarg_rw ImagePrototype img ; arg Float x0 y0 x1 y1 ; arg Address color
202	var Int ix0 := max (img index_x x0 0) 0
203	var Int iy0 := max (img index_y y0 0) 0
204	var Int ix1 := min (img index_x x1 0) img:size_x
205	var Int iy1 := min (img index_y y1 0) img:size_y
206	if ix1>ix0
207	for (var Int iy) iy0 iy1-1
208	img fill ix0 iy ix1-ix0 color
209
210
211	export Outline '. build_chains' '. bbox'
212	export '. fill' '. rectangle'
213