! Polygon Fill, by Fred King
%record %format POINTFM (%integer x, y)
%routine Poly fill (%integer NE, ADR)
   %const %integer max vertex = 128,
                   insert limit = 5
   %record %format edge(%integer x0, y0, x1, y1, slope, %record(edge) %name l)
   %record(edge) niledge
   %integer pp = 0
   %integer i
   %record(edge) %array edges(1:max vertex)

   %integer %function muldiv(%integer a, b, c)
      %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 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)//(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
 disable(7)
 x0=currentcolour
 set colour(8)
 line(edges(i)_x0, edges(i)_y0, edges(i)_x1, edges(i)_y1) %for i= 1, 1, pp
 disable(8)
 set colour(x0)

         %cycle
            ael == el
            btm_y =ael_y0
            x0 = ael_x0
            x1 = x0
            el == el_l %until el==niledge %or el_y0#btm_y
            nilael == el
            %cycle
               %while %not ael==nilael %and 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
               x0 = e1_x0
               x1 = x0 %if x1<x0
               %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

   poly(integer (adr+(i-1)*4), integer (adr+(i-1)*4+4)) %for I = 1, 2, 2*NE-1
   close poly
%end

%end %of %file
