! Polygon Fill, by Gordon T.
%record %format POINTFM (%integer x, y)

%routine Poly fill (%integer NE, ADR)
    %record (pointfm) %array PP (1:NE)
    %integer I

    %routine triangle(%integer a,b,c,d,e)
      *move.l e,a0
      *move.l (a0),d4
      *move.l 4(a0),d5
      *jsr 16_1178
      *move.l #255,d5
    %end

    %routine draw polygon

       %integer min= 1000 ,max = -100,i

       %for i=1,1,NE %cycle
            min= ( pp(i)_y ) %if ( pp(i)_y ) < min
            max = ( pp(i)_y ) %if ( pp(i)_y ) > max
       %repeat

       %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
       
       ! *******************************************************************
       
       %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

    %for I = 1, 1, NE %cycle
         PP (i)_X = integer (adr)
         PP (i)_Y = integer (adr+4)
         adr = adr + 8
    %repeat
    %if NE=3 %start
        adr = addr (pp(1)_x)
        triangle (integer(adr), integer(adr+4), integer(adr+8), integer(adr+12),
                  adr+16)   { Nb. last point is a %record %name }
    %else
        draw polygon
    %finish
%end

%end %of %file