! Polygon Fill, by Gordon T. with modifications my Gordon H.
%option "-noass"
%const %integer MAX POINT = 500
%record %format POINTFM (%integer x, y)

%own %integer Min = 10000, Max = -10000, NE = 0
%own %record (POINTFM) %name %array PP(1:MAX POINT)

%routine Add Point (%integer X, Y)
   %own %record (POINTFM) %name POINT == NIL
   %if NE<MAX POINT %start
       NE = NE + 1
       PP(NE) == NEW (POINT)
       PP(NE)_X = X;   PP(NE)_Y = Y
       min= ( pp(NE)_y ) %if ( pp(NE)_y ) < min
       max = ( pp(NE)_y ) %if ( pp(NE)_y ) > max
   %finish
%end

%routine Close Polygon
    %integer I
    %routine draw polygon
       %record %format edge ( %integer dy , y , %real dx , x ,
                              %record(edge) %name next )
       %record(edge) %name %array edges( min:max )
       %record(edge) %name  act,t1,t2,e1,e2,e3,e4,head
       %record(edge) %array edg(1:NE)
       %integer scan line, x1, x2, i
       
       ! *******************************************************************
       
       %record(edge) %function create edge ( %record( pointfm ) ed1, ed2)
           ! ed1_y > ed2_y
           %record(edge) t
       
           t_x = ed1_x;t_y = ed1_y
           %if ed1_y - ed2_y = 0 %start
               t_dx = ed2_x-ed1_x
           %else
               t_dx =( ed2_x - ed1_x ) / ( ed1_y - ed2_y )
           %finish
           t_dy = ed1_y - ed2_y
           t_next == nil
           %result = t
       %end
       
       ! *******************************************************************

       %predicate list sorted on x ( %record(edge) %name head )
           %real last x
           %record(edge) %name e1

           last x = -1
           e1 == head
           %while %not (e1 == nil) %cycle
              %if last x > e1_x %start
                  %false
              %else
                  last x = e1_x
                  e1 == e1_next
              %finish
           %repeat
           %true
       %end

       ! ****************************************************************

       %routine insert on x ; ! head = top and e2 = inserted
           %integer flag = 1

          flag = 0 %if head == nil
          e1 == head
          %while %not ( e2 == nil ) %cycle
             e4 == head
             %while (%not (e1==nil)) %and ( e2_x >= e1_x ) %cycle
                e4 == e1
                e1 == e1_next
             %repeat

             %if e1 == nil %start
                 %if flag # 0 %start
                     e4_next == e2
                     e2 == e2_next
                     e4 == e4_next
                     e4_next == nil
                 %else
                     head == e2
                     e2 == e2_next
                     head_next == nil
                     flag = 1
                 %finish
             %else
                 e3 == e2
                 e2 == e2_next
                 e3_next == e1
                 %if %not ( e1==head ) %then e4_next == e3 %else head == e3
             %finish
             e1 == head
          %repeat
       %end

       ! *******************************************************************

       %routine remove rec ( %integer val )
          %record(edge) %name first , second , head

          act == act_next %while %not ( act==nil ) %and (act_dy  = val )

          first == act
          %while %not ( first == nil ) %cycle
             second == first_next
             %if %not ( second == nil ) %and ( second_dy  = val ) %start
                 first_next == second_next
             %else
                 first == first_next
             %finish
          %repeat
       %end

       ! *******************************************************************

       %routine compute point ( %record(edge) %name t1 )
          t1_x = t1_x + t1_dx
          t1_dy = t1_dy-1
       %end

       ! *******************************************************************

       %for i = 1,1,NE - 1 %cycle
          %if pp(i)_y > pp(i+1)_y %start
            edg ( i ) = create edge ( pp(i),pp(i+1) )
          %else
            edg ( i ) = create edge ( pp(i+1),pp(i)) 
          %finish
       %repeat

       %if pp(NE)_y > pp(1)_y %start
           edg(NE) = create edge( pp(NE) , pp( 1 ) )
       %else
           edg(NE) = create edge( pp(1) , pp(NE) )
       %finish

       edges(i) == nil %for i = min , 1 , max 

       %for i = 1,1,NE %cycle
            %if edges( edg(i)_y ) == nil %start
                edges( edg(i)_y ) == edg(i)
            %else
                t1 == edges( edg(i)_y )
                t1 == t1_next %while %not ( t1_next == nil )
                t1_next == edg(i)
            %finish
       %repeat

       scan line = max
       act == nil
       %while scan line # min - 1 %cycle

              %if %not ( list sorted on x ( act ) ) %start
                  head == nil
                  e2   == act
                  insert on x
                  act == head
              %finish
              head == act
              e2 == edges(scan line)
              insert on x
              act == head
              ! Inserts a new record and sorts the list pointed to by act on x
              remove rec ( -1 )
              ! removes a record if the value of dy = -1
              remove rec ( 0 ) %if %not ( edges(scan line) == nil )
              t1 == act_next
              t2 == act
              ! point to two edges to generate two points
              %while %not ( t2 == nil ) %and %not ( t1 == nil ) %cycle
                     hline(intpt(t2_x),intpt(t1_x),scanline)
                     t2 == t1_next
                     t1 == t2_next
              %repeat
              t1 == act
              %while %not ( t1 == nil ) %cycle
                     compute point ( t1 )
                     t1 == t1_next
              %repeat
              scan line = scan line - 1
       %repeat

    %end

    %if NE>0 %start
        %if NE=1 %start
            plot (pp(1)_x, pp(1)_y)
        %else %if NE=2
            Line (pp(1)_x, pp(1)_y, pp(2)_x, pp(2)_y)
        %else %if NE=3
            triangle (pp(1)_x, pp(1)_y, pp(2)_x, pp(2)_y, pp(3)_x, pp(3)_y)
        %else
            draw polygon
        %finish
        ! Reset for next polygon
        Dispose (PP(I)) %for I = 1, 1, NE
        Min = 10000
        Max = -10000
        NE = 0
    %finish
%end

%end %of %file
