! Polygon Fill, by Gordon T.
! This routine has been brought from KB (from the APM) and implemented
! on the APOLLO.

%routine Poly fill (%integer Colour, NE, %short %array %name xline, yline)

    %record (gpr position t) %array PP (1:NE)
    %own %record (gpr window t) win
    %own %record (gpr position t) dest origin
    %integer I

    %routine hline(%integer x1, x2, y)
        %short sx, sy
        %own %integer dist
!        %if colour > 1 %and Dev Data_Max Colour = 0 %start
            dist = x2 - x1
            dest origin_x coord = x1 + 1
            win_window base_x coord = dest origin_x coord & repeat x
            %while dist > 0 %cycle
                %if dist > bitmap width - win_window base_x coord %start
                    win_window size_x size = bitmap width - win_window base_x coord
                %else
                    win_window size_x size = dist
                %finish
                gpr pixel blt(bitmap desc, win, dest origin, status)
                win_window base_x coord = 0
                dist = dist - win_window size_x size
                dest origin_x coord = dest origin_x coord + win_window size_x size
            %repeat
!        %else
!            sy = screen height - y - 1
!            sx = x1 + 1
!            gpr move (sx, sy, status)
!            sx = x2 + 1
!            gpr line (sx, sy, status)
!        %finish
    %end

    %routine draw polygon

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

       %for i=1,1,NE %cycle
            min = ( pp(i)_y coord) %if ( pp(i)_y coord) < min
            max = ( pp(i)_y coord) %if ( pp(i)_y coord) > 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( gpr position t ) ed1, ed2)
           ! ed1_y > ed2_y
           %record(edge) t
       
           t_x = ed1_x coord
           t_y = ed1_y coord
           %if ed1_y coord - ed2_y coord = 0 %start
               t_dx = ed2_x coord-ed1_x coord
           %else
               t_dx =(ed2_x coord - ed1_x coord) / (ed1_y coord - ed2_y coord)
           %finish
           t_dy = ed1_y coord - ed2_y coord
           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 %then %false %c
                  %else %start
                        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
                         %finish %else %start
                             head == e2
                             e2 == e2_next
                             head_next == nil
                             flag = 1
                         %finish
                     %finish %else %start
                         e3 == e2
                         e2 == e2_next
                         e3_next == e1
                         %if %not ( e1==head ) %then e4_next == e3 %c
                             %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 ) %then %c
                      first_next == second_next %c
                  %else %c
                      first == first_next
           %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 coord > pp(i+1)_y coord %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 coord > pp(1)_y coord %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)
            %finish %else %start
                t1 == edges( edg(i)_y )
                t1 == t1_next %while %not ( t1_next == nil )
                t1_next == edg(i)
            %finish

       %repeat

       dest origin_y coord = screen height - max - 1
       win_window base_y coord = dest origin_y coord & repeat x
       win_window size_y size = 1
       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 )
              %if act == nil %then t1 == nil %else t1 == act_next
              t2 == act
              ! point to two edges to generate two points
              %if scan line <= yt %start
                  %while %not ( t2 == nil ) %and %not ( t1 == nil ) %cycle
                         %if xl > t2_x %then x2 = xl %else x2=intpt(t2_x)
                         %if xr < t1_x %then x1 = xr %else x1=intpt(t1_x)
                         hline(x2, x1, scan line)
                         t2 == t1_next
                         %if t2 == nil %then t1 == nil %else t1 == t2_next
                  %repeat
              %finish
              %return %if yb = scan line
              t1 == act
              %while %not ( t1 == nil ) %cycle
                     compute point ( t1 )
                     t1 == t1_next
              %repeat
              scan line = scan line - 1
              dest origin_y coord = dest origin_y coord + 1 
              win_window base_y coord = win_window base_y coord + 1
              win_window base_y coord = 0 %if win_window base_y coord=16
       %repeat
    %end

    %for I = 1, 1, NE %cycle
         PP (i)_X coord = xline (i)
         PP (i)_Y coord = -(yline (i) - screen height)
    %repeat
    ! We should not be here if NE <= 2
!    obscured = gpr acquire display(status)
     draw polygon
     %return %if colour = 0
     endx = pp(1)_x coord + 1
     endy = screen height - pp(1)_y coord - 1
     gpr move(endx, endy, status)
     %for i = 2, 1, NE %cycle
         endx = pp(i)_x coord + 1
         endy = screen height - pp(i)_y coord - 1
         gpr line(endx, endy, status)
     %repeat
     endx = pp(1)_x coord + 1
     endy = screen height - pp(1)_y coord - 1
     gpr line(endx, endy, status)
!    gpr release display(status)
%end

%end %of %file
