PreviousUpNext

15.4.1002  src/lib/std/2d/xgeometry.pkg

## xgeometry.pkg
#
# Basic geometric types and operations.
#
# The 'X' on the name is for X Windows; this
# file was original part of x-kit, which is
# still its major user.

# Compiled by:
#     src/lib/std/standard.lib


###                      "Much learning does not teach understanding."
###
###                                               -- Heraclitus  (540BC-480BC, On the Universe)


###                      "Logic will get you from A to B. Imagination will take you everywhere."
###
###                                               -- Albert Einstein


                                        # Xgeometry             is from   src/lib/std/2d/xgeometry.api
stipulate
    package rc = range_check;           # range_check           is from   src/lib/std/2d/range-check.pkg
herein

    package xgeometry {

        stipulate

            fun min (col: Int, row) =   col < row  ??  col  ::  row;
            fun max (col: Int, row) =   col > row  ??  col  ::  row;

        herein

            # Geometric types (from Xlib::h)
            #
            Point =
                POINT
                  { col:  Int,
                    row:  Int
                  };

            Line =  LINE (Point, Point);

            Size =
                SIZE
                  { wide:  Int,
                    high:  Int
                  };

            Box =
                BOX
                  { col:  Int,
                    row:  Int,

                    wide:  Int,
                    high:  Int
                  };

            Arc =
                ARC
                  { col:     Int,
                    row:     Int,

                    wide:    Int,
                    high:    Int,

                    angle1:  Int,
                    angle2:  Int
                  };

            # The size and position of a window         # XXX BUGGO FIXME This belongs in xclient, not stdlib.
            # with respect to its parent:
            #
            Window_Site
                =
                WINDOW_SITE
                  { upperleft:     Point,
                    size:          Size,
                    border_thickness:  Int
                  };

            package point {

                # Points:
                #
                zero = POINT { col => 0, row => 0 };

                fun col (POINT { col, ... } ) =  col;
                fun row (POINT { row, ... } ) =  row;

                fun add      (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 } ) =  POINT { col=>(col1+col2), row=>(row1+row2) };
                fun subtract (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 } ) =  POINT { col=>(col1-col2), row=>(row1-row2) };

                fun scale (POINT { col, row }, s ) =  POINT { col=>s*col, row=>s*row };

                fun ne (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 != col2) or  (row1 != row2);
                fun eq (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 == col2) and (row1 == row2);
                fun lt (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 <  col2) and (row1 <  row2);
                fun le (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 <= col2) and (row1 <= row2);
                fun gt (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 >  col2) and (row1 >  row2);
                fun ge (POINT { col=>col1, row=>row1 }, POINT { col=>col2, row=>row2 }) =  (col1 >= col2) and (row1 >= row2);

                fun add_size (POINT { col, row }, SIZE { wide, high } )
                    =
                    POINT { col =>  col + wide,
                            row =>  row + high
                          };
                #
                fun clip (POINT { col, row }, SIZE { wide, high })
                    =
                    POINT {
                          col =>  if (col <= 0)  0; elif (col < wide)  col; else (wide - 1); fi,
                          row =>  if (row <= 0)  0; elif (row < high)  row; else (high - 1); fi
                        };

                fun in_box (POINT { col=>px, row=>py }, BOX { col, row, wide, high } )
                    =
                    px >=  col    and
                    py >=  row    and
                    px < col+wide and
                    py < row+high;


                # Bounding box of a list of points:
                #
                fun bounding_box []
                        =>
                        BOX { col=>0, row=>0, wide=>0, high=>0 };

                    bounding_box ((POINT { col, row } ) ! pts)
                        =>
                        bb (col, row, col, row, pts)
                        where
                            fun bb (minx, miny, maxx, maxy, [])
                                    => 
                                    BOX { col => minx, row => miny, wide => maxx-minx+1, high => maxy-miny+1 };

                                bb (minx, miny, maxx, maxy, (POINT { col, row } ) ! pts)
                                    => 
                                   bb (min (minx, col), min (miny, row), max (maxx, col), max (maxy, row), pts);
                            end;
                        end;
                end;
            };

            package size {
                #
                fun add      (SIZE { wide=>w1, high=>h1 }, SIZE { wide=>w2, high=>h2 } ) =  SIZE { wide=>(w1+w2), high=>(h1+h2) };
                fun subtract (SIZE { wide=>w1, high=>h1 }, SIZE { wide=>w2, high=>h2 } ) =  SIZE { wide=>(w1-w2), high=>(h1-h2) };
                fun scale    (SIZE { wide,     high     }, s                           ) =  SIZE { wide=>wide*s,  high=>high*s  };
                #
                fun eq       (SIZE { wide=>w1, high=>h1 }, SIZE { wide=>w2, high=>h2 } ) =  (w1==w2 and h1==h2);
            };

            package box {

                fun make (POINT { col, row }, SIZE { wide, high } )
                    =
                    BOX { col, row, wide, high };


                fun upperleft (BOX { col, row, ... } )
                    =
                    POINT { col, row };


                fun size (BOX { wide, high, ... } )
                    =
                    SIZE { wide, high };


                fun upperleft_and_size (BOX { col, row, wide, high } )
                    =
                    (POINT { col, row }, SIZE { wide, high } );


                fun lowerright r
                    =
                    point::add_size (upperleft_and_size r);


                fun clip_point (BOX { col=>min_col, row=>min_row, wide, high }, POINT { col, row } )
                    =
                    POINT {
                        col => if (col <= min_col)  min_col; elif (col < min_col+wide)  col; else (min_col+wide - 1); fi,
                        row => if (row <= min_row)  min_row; elif (row < min_row+high)  row; else (min_row+high - 1); fi
                      };

                fun  translate (BOX { col, row, wide, high }, POINT { col=>px, row=>py } ) =  BOX { col=>col+px, row=>row+py, wide, high };
                fun rtranslate (BOX { col, row, wide, high }, POINT { col=>px, row=>py } ) =  BOX { col=>col-px, row=>row-py, wide, high };

                fun middle (BOX { col, row, wide, high } )
                    =
                    POINT { col => col+(wide / 2),
                            row => row+(high / 2)
                          };

                fun intersect
                        (BOX { col=>col1, row=>row1, wide=>w1, high=>h1 },
                         BOX { col=>col2, row=>row2, wide=>w2, high=>h2 }
                        )
                    =
                    (   (col1 < (col2+w2)) and (row1 < (row2+h2))
                    and (col2 < (col1+w1)) and (row2 < (row1+h1)));

                exception INTERSECTION;

                fun intersection
                        ( BOX { col=>col1, row=>row1, wide=>w1, high=>h1 },
                          BOX { col=>col2, row=>row2, wide=>w2, high=>h2 } )
                    =
                    {   col = max (col1, col2);
                        row = max (row1, row2);

                        cx = min (col1+w1, col2+w2);
                        cy = min (row1+h1, row2+h2);

                        if (col < cx  and  row < cy)
                             BOX { col, row, wide=>(cx-col), high=>(cy-row) };
                        else
                             raise exception INTERSECTION;
                        fi;
                      };

                fun union (
                      r1 as BOX { col=>col1, row=>row1, wide=>w1, high=>h1 },
                      r2 as BOX { col=>col2, row=>row2, wide=>w2, high=>h2 }
                    )
                    =
                    if   (w1 == 0  or  h1 == 0)    r2;
                    elif (w2 == 0  or  h2 == 0)    r1;
                    else

                        col = min (col1, col2);
                        row = min (row1, row2);

                        cx = max (col1+w1, col2+w2);
                        cy = max (row1+h1, row2+h2);

                        BOX { col, row, wide=>(cx-col), high=>(cy-row) };
                    fi;


                fun in_box
                    ( BOX { col=>col1, row=>row1, wide=>w1, high=>h1 },
                      BOX { col=>col2, row=>row2, wide=>w2, high=>h2 }
                    )
                    =
                    col1 >= col2        and
                    row1 >= row2        and
                    col1+w1 <= col2+w2  and
                    row1+h1 <= row2+h2;


                # The symmetric difference of two sets is essentially
                # a geometric XOR operation;  it contains all elements
                # in either set but not both sets -- in other words,
                # the union minus the intersection:
                #
                #     http://en.wikipedia.org/wiki/Symmetric_difference
                #
                # Here we compute the symmetric difference of two
                # rectangles and return it as a list of rectangles:
                # 
                fun xor (r, r')
                    =
                    difference (r', r, difference (r, r',[]))
                    where
                        fun difference (r as BOX { col=>x, row=>y, wide, high }, r', result_list)
                            =
                            {   my BOX { col=>ix, row=>iy, wide=>iwide, high=>ihigh }           # "i-" for "intersection-".
                                    =
                                    intersection (r, r');

                                icx = ix + iwide;               # Opposite corner of
                                icy = iy + ihigh;               # intersection box.

                                # (x,y) is one corner of a rectangle,
                                # (cx,cy is the opposite corner.
                                #       
                                # Cyclically identify all parts of the rectangle
                                # which project outside the borders of the above
                                # intersection rectangle, adding each of them to
                                # the result list and then shrinking the argument
                                # rectangle correspondingly:
                                #
                                fun pare (x, y, cx, cy, result_list)
                                    =
                                    if   (  x < ix)  pare (ix,  y,  cx,  cy, (BOX { col=>x,   row=>y,   high=>cy-y,   wide=>ix-x   } ) ! result_list);  # Pare off the part to the left.
                                    elif (  y < iy)  pare ( x, iy,  cx,  cy, (BOX { col=>x,   row=>y,   high=>iy-y,   wide=>cx-x   } ) ! result_list);  # Pare off the part above. (Assuming y==0 is at top.)
                                    elif (icx < cx)  pare ( x,  y, icx,  cy, (BOX { col=>icx, row=>y,   high=>cy-y,   wide=>cx-icx } ) ! result_list);  # Pare off the part to the right.
                                    elif (icy < cy)  pare ( x,  y,  cx, icy, (BOX { col=>x,   row=>icy, high=>cy-icy, wide=>cx-x   } ) ! result_list);  # Pare off the part below.
                                    else
                                        result_list;
                                    fi;

                                pare (x, y, x+wide, y+high, result_list);
                            }
                            except
                                INTERSECTION = r ! result_list;

                    end;
            };


            # XXX BUGGO FIXME Remaining stuff belongs in xclient, not stdlib:

            fun site_to_box (WINDOW_SITE { upperleft => POINT { col, row }, size => SIZE { wide, high }, ... })
                =
                BOX { col, row, wide, high };


            # Validation routines:
            #
            fun valid_point(POINT { col, row } )  =   rc::valid_signed16 col    and   rc::valid_signed16 row;
            fun valid_line (LINE (p1, p2))        =       valid_point    p1     and       valid_point    p2;
            fun valid_size (SIZE { wide, high } ) =   rc::valid16        wide   and   rc::valid16        high;

            fun valid_box (BOX { col, row, wide, high } )
                =
                rc::valid_signed16 col      and
                rc::valid_signed16 row      and 
                rc::valid16 wide            and
                rc::valid16 high;

            fun valid_arc (ARC { col, row, wide, high, angle1, angle2 } )
                =
                rc::valid_signed16  col     and
                rc::valid_signed16  row     and 
                rc::valid16  wide           and
                rc::valid16  high           and 
                rc::valid_signed16  angle1  and
                rc::valid_signed16  angle2;

            fun valid_site (WINDOW_SITE { upperleft, size, border_thickness } )
                = 
                valid_point  upperleft      and
                valid_size   size           and
                rc::valid16  border_thickness;

        end;            # stipulate
    };                  # package geometry 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext