15.4.1349  src/lib/x-kit/draw/cartouche.pkg

## cartouche.pkg
## Copyright 1988 by the Massachusetts Institute of Technology

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

# Routines to draw/fill rectangles with rounded corners.  The implementation
# is lifted from the MIT X11 distribution.

stipulate
    include package   geometry2d;                               # geometry2d    is from   src/lib/std/2d/geometry2d.pkg
    #
    package xc =  xclient;                                      # xclient       is from   src/lib/x-kit/xclient/xclient.pkg
#   package g2d=  geometry2d;                                   # geometry2d    is from   src/lib/std/2d/geometry2d.pkg
herein
    package   cartouche
    : (weak)  Cartouche                                         # Cartouche     is from   src/lib/x-kit/draw/cartouche.api
    {
        fun draw_cartouche  drawable  pen  { box, corner_radius }
            =
            {   box ->  { col=>x, row=>y, wide=>w, high=>h };

                w2 =   corner_radius + corner_radius;
                h2 =   corner_radius + corner_radius;

                my (ew, ew2)
                    =
                    if (w2 > w) (0, 0);
                    else        (corner_radius, w2);
                    fi;

                my (eh, eh2)
                    =
                    if (h2 > h) (0, 0);
                    else        (corner_radius, h2);
                    fi;


                xc::draw_arcs  drawable  pen  [
                    #
                    { col=> x,         row=> y,         wide=> ew2,     high=> eh2,     angle1=> 180*64, angle2=>  -90*64 },
                    { col=> x+ew,      row=> y,         wide=> w - ew2, high=> 0,       angle1=> 180*64, angle2=> -180*64 },
                    { col=> x+w - ew2, row=> y,         wide=> ew2,     high=> eh2,     angle1=> 90*64,  angle2=>  -90*64 },
                    { col=> x+w,       row=> y+eh,      wide=> 0,       high=> h - eh2, angle1=> 90*64,  angle2=> -180*64 },
                    { col=> x+w - ew2, row=> y+h - eh2, wide=> ew2,     high=> eh2,     angle1=> 0,      angle2=>  -90*64 },
                    { col=> x+ew,      row=> y+h,       wide=> w - ew2, high=> 0,       angle1=> 0,      angle2=> -180*64 },
                    { col=> x,         row=> y+h - eh2, wide=> ew2,     high=> eh2,     angle1=> 270*64, angle2=>  -90*64 },
                    { col=> x,         row=> y+eh,      wide=> 0,       high=> h - eh2, angle1=> 270*64, angle2=> -180*64 }
                ];
            };

        fun fill_cartouche  drawable  pen  { box, corner_radius }
            =
            {   pen =   xc::clone_pen (pen, [xc::p::ARC_MODE_PIE_SLICE]);

                box ->  { col=>x, row=>y, wide=>w, high=>h };

                w2 =   corner_radius + corner_radius;
                h2 =   corner_radius + corner_radius;

                my (ew, ew2) =   if (w2 > w)  (0, 0);   else (corner_radius, w2);   fi;
                my (eh, eh2) =   if (h2 > h)  (0, 0);   else (corner_radius, h2);   fi;

                xc::fill_arcs  drawable  pen  [
                    #
                    { col=> x,         row=> y,         wide=> ew2, high=> eh2, angle1=> 180*64, angle2=> -90*64 },
                    { col=> x+w - ew2, row=> y,         wide=> ew2, high=> eh2, angle1=> 90*64,  angle2=> -90*64 },
                    { col=> x+w - ew2, row=> y+h - eh2, wide=> ew2, high=> eh2, angle1=> 0,      angle2=> -90*64 },
                    { col=> x,         row=> y+h - eh2, wide=> ew2, high=> eh2, angle1=> 270*64, angle2=> -90*64 }
                ];

                xc::fill_boxes  drawable  pen  [
                    #
                    { col=> x + ew,     row=> y,      wide=> w - ew*2, high=> h       },
                    { col=> x,          row=> y + eh, wide=> ew,       high=> h - eh2 },
                    { col=> x + w - ew, row=> y + eh, wide=> ew,       high=> h - eh2 }
                ];
            };
    };
end;


## COPYRIGHT (c) 1992 by AT&T Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.