PreviousUpNext

15.4.1344  src/lib/x-kit/draw/band.pkg

## band.pkg

# Compiled by:
#     src/lib/x-kit/draw/xkit-draw.sublib



# Code for band data package.
#
# A band is a list non-continguous rectangles listed from left
# to right (increasing x) that all have the same upper and lower
# y coordinates. Regions (see region.api and region.pkg)
# are essentially ordered lists of bands.



###                  "Mark Twain and I are in very much the same position.
###                   We have to put things in such a way as to make people
###                   who would otherwise hang us, believe that we are joking."
###
###                                        -- George Bernard Shaw



stipulate
    package g2d =  geometry2d;                  # geometry2d    is from   src/lib/std/2d/geometry2d.pkg
herein

    api Band {

        Box_Overlap
          = BOX_OUT
          | BOX_IN
          | BOX_PART
          ;

        Band = BAND  { y1:  Int,                        #  top y value 
                       y2:  Int,                        #  Bottom y value 
                       xs:  List( (Int, Int) )  #  list of (left, right) values 
                     };

        y1of:  Band -> Int;    #  Return y1 of band 
        y2of:  Band -> Int;    #  Return y2 of band 

        size_of:  Band -> Int;    #  Return number of intervals. Always > 0 

        boxes_of_band
            :
            (Band, List( g2d::Box ))
            ->
            List( g2d::Box );
            #
            # Concat list of rectangles of band on accumulator list.
            # The leftmost rectangle in the band will be the head of
            # the resulting list.


        in_band:  (Band, g2d::Point) -> Bool;
            #
            # TRUE if point is in band.


        band_extent:  Band -> (Int, Int);
            #
            # Return left and right extent of band 


        box_in_band:  (Band, Int, Int) -> Box_Overlap;
            #
            # Compares argument interval with x intervals of band 


        overlap:  (Band, Band) -> Bool;
            #
            # Returns TRUE if any two x intervals of the bands intersect 



        offset_band:  g2d::Point -> Band -> Band;
            #
            # Translate band by given vector 



        x_offset_band:  Int -> Band -> Band;
        y_offset_band:  Int -> Band -> Band;
            #
            # Translate band horizontally (vertically) 



        coalesce
            :
            { lower:  Band,
              upper:  Band
            }
            ->
            Null_Or( Band );
            #
            # Coalesce lower band below upper band.
            # Return THE new band if successful.
            # Assumes y values are compatible.


        union:     (Band, Band, Int, Int) -> (Band, Int);
        intersect: (Band, Band, Int, Int) -> (Band, Int);
        subtract:  (Band, Band, Int, Int) -> (Band, Int);
            #
            # Create a new band that is the
            # union (intersection, difference)
            # of the two argument bands.
            #
            # The integer return value is the
            # number of intervals in the band.
            #
            # The integer arguments provide the upper
            # and lower y coordinates for the resulting band.
            #
            # The operation only involves the x intervals;
            # it is assumed that y overlap has already been checked.



        squeeze:  (Band, Int, Int) -> (Band, Int);
            #
            # Return a new band that has the same x intervals as the
            # argument band, but with the new upper and lower y values.

    };
end;



stipulate
    package g2d =  geometry2d;                  # geometry2d    is from   src/lib/std/2d/geometry2d.api
herein

    package   band
    : (weak)  Band                              # Band          is from   src/lib/x-kit/draw/band.pkg
    {

        Box_Overlap = BOX_OUT
                    | BOX_IN
                    | BOX_PART
                    ;

        Band = BAND  {
                          y1:  Int,
                          y2:  Int,
                          xs:  List( (Int, Int) )
                        };

            #  It might be worthwhile to maintain the length of xs in the band 



        fun is_in (x:  Int) (x1, x2) =   x1 <= x and x < x2;
        fun xoff  (x:  Int) (x1, x2) =   (x1+x, x2+x);

        fun ontop (   [], l, n) =>   (l, n);
            ontop (a ! t, l, n) =>   ontop (t, a ! l, n+1);
        end;

        fun mkr (y1, y2)
            =
            {   high = y2 - y1;

                \\ ((x1, x2), l)
                    =
                    (   ({ col=>x1, row=>y1, wide=>x2 - x1, high } )
                        !
                        l
                    );
            };

        fun boxes_of_band (BAND { xs, y1, y2 }, l)
            =
            fold_backward (mkr (y1, y2)) l xs;

        fun squeeze (BAND { xs, ... }, top, bot)
            =
            (BAND { xs, y1=>top, y2=>bot }, length xs);

        fun y1of (BAND { y1, ... } ) =   y1;
        fun y2of (BAND { y2, ... } ) =   y2;

        fun size_of (BAND { xs, ... } )
            =
            length xs;

        fun in_band (BAND { y1, y2, xs }, { col=>px, row=>py } )
            =
            y1 <= py   and
            py <  y2   and
            list::exists (is_in px) xs;

        fun band_extent (BAND { xs => xs as ((x1, _) ! _), ... } )
                =>
                (x1, right xs)
                where

                   fun right ([(l, r)]) =>   r;
                       right (_ ! t)    =>   right t;
                       right _          =>   raise exception lib_base::IMPOSSIBLE "Band::bandExtent::right";
                   end;

                end;

            band_extent _
                =>
                raise exception lib_base::IMPOSSIBLE "Band::bandExtent";
        end;

        fun box_in_band (BAND { y1, y2, xs }, x1, x2)
            =
            {   fun rib [] => BOX_OUT; 

                    rib ((l, r) ! rest)
                        =>
                        if (r <= x1               )  rib rest;
                        elif (x2 <= l             )  BOX_OUT;
                        elif (l <= x1 and x2 <= r )  BOX_IN;
                        else                         BOX_PART;
                        fi;
                end;

                rib xs;
            };



        #  Only check overlap of x intervals 

        fun overlap (BAND { xs, ... }, BAND { xs=>xs', ... } )
            =
            {   fun loop ([], _) =>  FALSE;
                    loop(_, []) =>  FALSE;
                    loop (x as ((x1, x2) ! xs), x' as ((x1', x2') ! xs'))
                        =>
                        if   (x2 <= x1')

                             loop (xs, x');
                        else
                             if   (x2' <= x1)

                                  loop (x, xs');
                             else
                                  TRUE;
                             fi;
                        fi;
                end;

                loop (xs, xs');
            };

        fun x_offset_band dx (BAND { y1, y2, xs } )
            =
            BAND { y1, y2, xs => map (xoff dx) xs };

        fun y_offset_band dy (BAND { y1, y2, xs } )
            =
            BAND { y1=>y1+dy, y2=>y2+dy, xs };

        fun offset_band ({ col=>dx, row=>dy } ) (BAND { y1, y2, xs } )
            =
            BAND { y1=>y1+dy, y2=>y2+dy, xs => map (xoff dx) xs };



        # Coalesce two bands into one, if possible.
        # Assume y1 of lower band = y2 of upper band
        # Check that each contain same horizontal intervals.
        # If so, combine and return THE of resulting band.
        # Else return NULL.

        fun coalesce { lower => BAND { y2, xs, ... }, upper => BAND { y1=>y1', xs=>xs', ... }}
            =
            if (xs == xs'   ) THE (BAND { y1=>y1', y2, xs } );
                           else NULL; fi;

        fun union (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
            =
            {   h  =  head xs;
                h' =  head xs';

                fun finalmerge ([], ci, xs)
                        =>
                        ontop (xs,[ci], 1);

                    finalmerge((i as (l, r)) ! t, i' as (l', r'), xs)
                        =>
                        if   (r' < l )   ontop (xs, i' ! i ! t, 2 + length t);
                        elif (r <= r' )  finalmerge (t, i', xs); 
                        else             ontop (xs, (l', r) ! t, 1 + length t);
                        fi;
                end;

                fun loop ([],[], ci, xs) => ontop (xs,[ci], 1);
                    loop (x,[], ci, xs) => finalmerge (x, ci, xs);
                    loop ([], x, ci, xs) => finalmerge (x, ci, xs);
                    loop (x as ((i as (x1, x2)) ! t), x' as ((i' as (x1', x2')) ! t'), ci, xs)
                         =>
                         if (x1 < x1' ) merge (t, x', i, ci, xs); else merge (x, t', i', ci, xs);fi;
                end 

                also
                fun merge (t, t', i as (l, r), i' as (l', r'), xs)
                     =
                     if   (r' < l )  loop (t, t', i, i' ! xs); 
                     elif (r <= r' ) loop (t, t', i', xs); 
                     else            loop (t, t', (l', r), xs);
                     fi;

                my (xs'', n)
                    =
                    if   (#1 h < #1 h')
                         loop (tail xs, xs', h,[]);
                    else loop (xs, tail xs', h',[]);  fi;

                (BAND { y1=>top, y2=>bot, xs=> xs''}, n);
            };

        fun intersect (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
            =
            {   fun loop ([], _, xs) => ontop (xs,[], 0);
                    loop (_,[], xs) => ontop (xs,[], 0);
                    loop (x as ((x1, x2) ! t), x' as ((x1', x2') ! t'), xs)
                         =>
                         {   l = int::max (x1, x1');
                             r = int::min (x2, x2');

                             xs' =   if (l < r   ) (l, r) ! xs;
                                                else xs;fi;

                             if (x2 < x2')
                                  loop (t, x', xs');
                             elif (x2 > x2')
                                  loop (x, t', xs');
                             else loop (t, t', xs');
                             fi;
                         };
                end;

                case (loop (xs, xs',[]))

                     (xs'', n) =>   (BAND { y1=>top, y2=>bot, xs=> xs''}, n);
                esac;
            };

        fun subtract (BAND { xs, ... }, BAND { xs=>xs', ... }, top, bot)
            =
            {   fun loop ([], _, xs) => ontop (xs,[], 0);
                    loop (x,[], xs) => ontop (xs, x, length x);

                    loop (x as ((x1, x2) ! t), x' as ((x1', x2') ! t'), xs)
                         =>
                         if   (x2' <= x1 ) loop (x, t', xs);
                         elif (x2 <= x1' ) loop (t, x', (x1, x2) ! xs);
                         elif (x1' <= x1 )
                             if   (x2' < x2 )  loop((x2', x2) ! t, t', xs);
                             elif (x2' == x2 ) loop (t, t', xs);
                             else              loop (t, x', xs);
                             fi;
                         elif (x2' < x2 ) loop((x2', x2) ! t, t', (x1, x1') ! xs);
                             elif (x2' == x2 ) loop (t, t', (x1, x1') ! xs);
                             else loop (t, x', (x1, x1') ! xs);
                         fi;
                end;

                  case (loop (xs, xs',[]))

                       (xs'', n) => (BAND { y1=>top, y2=>bot, xs=>xs''}, n);
                  esac;
            };
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext