const integer max vertex = 128,
insert limit = 5
record format edge(integer x0, y0, x1, y1, slope, record (edge) name l)
record (edge) niledge
own integer pp = 0
record (edge) array edges(1:max vertex)
integer function muldiv(integer a, b, c)
*muls d1,d0
*divs d2,d0
*extl d0
*add.l #12,a7
*rts
result = a*b//c
end
routine sort edges(integer l, r)
record (edge) key
integer key y, lp, rp, i
return unless l<r
while r-l>insert limit cycle
lp = l
rp = r+1
key = edges(l)
key y = key_y0
cycle
rp = rp-1 until rp=lp or key y>edges(rp)_y0 or c
(key y=edges(rp)_y0 and key_x0>edges(rp)_x0) or c
(key y=edges(rp)_y0 and key_x0=edges(rp)_x0 and c
key_slope>edges(rp)_slope)
exit if lp=rp
edges(lp) = edges(rp)
lp = lp+1 until rp=lp or key y<edges(lp)_y0 or c
(key y=edges(lp)_y0 and key_x0<=edges(lp)_x0) or c
(key y=edges(lp)_y0 and key_x0=edges(lp)_x0 and c
key_slope<=edges(rp)_slope)
exit if lp=rp
edges(rp) = edges(lp)
repeat
edges(lp) = key
if lp-l>r-rp start
sort edges(rp+1, r)
r = lp-1
finish else start
sort edges(l, lp-1)
l = rp+1
finish
repeat
for rp = l+1, 1, r cycle
key = edges(rp)
key y = key_y0
lp = l
lp = lp+1 while lp#rp and (key y>edges(lp)_y0 or c
(key y=edges(lp)_y0 and key_x0>edges(lp)_x0) or c
(key y=edges(lp)_y0 and key_x0=edges(lp)_x0 and c
key_slope>edges(lp)_slope))
for i = rp-1, -1, lp cycle
edges(i+1) = edges(i)
repeat
edges(lp) = key
repeat
end
routine poly(integer x, y)
signal 11, 1 if pp=max vertex
pp = pp+1
edges(pp)_x0 = x
edges(pp)_y0 = y
end
routine print poly(string (32) mess, record (edge)name p, t)
record (edge) name q
q==p
while not q==t cycle
printstring(mess)
write(addr(q), 10); write(q_x0, 5)
write(q_y0, 5); write(q_x1, 5)
write(q_y1, 5); write(q_slope, 10)
newline
q==q_l
repeat
end
routine close poly
record format hl(integer x0, x1, y)
record (edge) name el, ael, e0, e1, nilael, p, l, q, r, s
record (hl) top, btm
integer i, x0, x1, y0
record (edge) name d
routine set ends(record (edge)name e, integer x, y)
if e_y0<y or (e_y0=y and e_x0<=x) start
e_x1 = x
e_y1 = y
finish else start
e_x1 = e_x0
e_y1 = e_y0
e_x0 = x
e_y0 = y
finish
if e_y0=e_y1 start
e_slope = 0
finish else start
e_slope = ((e_x1-e_x0)<<16)//(e_y1-e_y0)
finish
end
routine check top(record (edge) name e)
record (edge) name p, l
if e_y1>top_y start
e_x0 = e_x0+muldiv(e_x1-e_x0, top_y-btm_y, e_y1-btm_y)
e_y0 = top_y
p == el
while (not p==niledge) and (p_y0<top_y or c
(p_y0=top_y and p_x0<e_x0) or c
(p_y0=top_y and p_x0=e_x0 and p_slope<e_slope)) cycle
l == p
p == p_l
repeat
e_l == p
if p==el then el == e else l_l == e
finish else start
e_x0 = e_x1
finish
end
return if pp=0
if pp=1 start
plot(edges(1)_x0, edges(1)_y0)
finish else start
e1 == edges(1)
x0 = e1_x0
y0 = e1_y0
for i = 1, 1, pp cycle
e0 == e1
e1 == edges(i)
set ends(e0, e1_x0, e1_y0)
repeat
set ends(e1, x0, y0)
sort edges(1, pp)
e1 == edges(1)
el == e1
e0 == e1 and e1 == edges(i) and e0_l == e1 for i = 2, 1, pp
e1_l == niledge
cycle
ael == el
btm_y =ael_y0
x0 = ael_x0
x1 = x0
!print poly("start", el, niledge)
el == el_l until el==niledge or el_y0#btm_y
nilael == el
!print poly("split1", ael, nilael)
!print poly("split2", el, niledge)
cycle
while (not ael==nilael) and c
ael_y1=btm_y and ael_x0<=x1 cycle
x1 = ael_x1 if x1<ael_x1
ael == ael_l
repeat
exit if ael==nilael
e0 == ael
ael == ael_l
if e0_y1=btm_y start
exit if ael==nilael
line(x0, btm_y, x1, btm_y) unless x0=x1
x0 = ael_x0
x1 = x0
continue
finish
while (not ael==nilael) and ael_y1=btm_y cycle
x1 = ael_x1 if x1<ael_x1
ael == ael_l
repeat
e1 == ael
ael == ael_l
line(x0, btm_y, e0_x0, btm_y) if x0<e0_x0 and x0<x1
if x1>e1_x0 start
x0 = e1_x0
finish else if not ael==nilael start
x0 = ael_x0
x1 = x0
finish else start
x0 = x1
finish
if e0_y1<e1_y1 start
top_y = e0_y1
finish else start
top_y = e1_y1
finish
top_y = nilael_y0 unless nilael==niledge or top_y<nilael_y0
btm_x0 = e0_x0
check top(e0)
top_x0 = e0_x0
btm_x1 = e1_x0
check top(e1)
top_x1 = e1_x0
trapeze(btm, top)
p == el
while (not p==niledge) and p_y0<=top_y cycle
if p_y0=top_y and p_y1=top_y start
if top_x0<=p_x0 and p_x1<=top_x1 start
if p==el start
el == p_l
finish else start
l_l == p_l
finish
finish else if top_x0<p_x1<=top_x1 start
p_x1 = top_x0
finish else if top_x0<=p_x0<top_x1 start
p_x0 = top_x1
finish else if p_x0<top_x0 and top_x1<p_x1 start
pp = pp+1
q == edges(pp)
q_x0 = top_x1
q_y0 = top_y
q_x1 = p_x1
q_y1 = top_y
p_x1 = top_x0
r == p_l
while (not r==niledge) and r_y0=top_y and c
r_x0<top_x1 cycle
s == r
r == r_l
repeat
q_l == r
if r==p_l then p_l == q else s_l == q
finish
finish
l == p
p == p_l
repeat
repeat until ael==nilael
line(x0, btm_y, x1, btm_y) unless x0=x1
repeat until el==niledge
finish
pp = 0
end
end of file