15.4.1392  src/lib/x-kit/widget/leaf/diamondbutton-shape.pkg

## diamondbutton-shape.pkg

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






###       "A well-designed and humane interface
###        does not need to be split into
###        beginner and expert subsystems."
###
###                  -- Jef Raskin

# This package gets used in:
#
#     src/lib/x-kit/widget/leaf/diamondbutton-look.pkg

stipulate
    #
    package d3 =  three_d;                                              # three_d               is from   src/lib/x-kit/widget/lib/three-d.pkg
    package wg =  widget;                                               # widget                is from   src/lib/x-kit/widget/basic/widget.pkg
    package xc =  xclient;                                              # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    package xg =  xgeometry;                                            # xgeometry             is from   src/lib/std/2d/xgeometry.pkg
herein

    package diamondbutton_shape: (weak)  Button_Shape {                 # Button_Shape          is from   src/lib/x-kit/widget/leaf/button-shape.api

        attributes = [];

        fun drawfn (d, xg::SIZE { wide, high }, bwid)
            =
            draw
            where 
                offset = 1;

                midx = wide / 2;
                midy = high / 2;

                verts = [ xg::POINT { col=>midx,      row=>offset   },
                          xg::POINT { col=>offset,    row=>midy     },
                          xg::POINT { col=>midx,      row=>high - 1 },
                          xg::POINT { col=>wide - 1,  row=>midy     }
                        ];

                fun draw (base, top, bottom)
                    =
                    {   xc::fill_polygon d base { verts, shape=>xc::CONVEX_SHAPE };

                        d3::draw3dpoly d (verts, bwid) { top, bottom };
                    };
            end;

        fun sizefn (wide, high)
            =
            wg::make_tight_size_preference
              (
                wide,

                case high
                    #
                    THE h => h;
                    NULL  => wide;
                esac
              );

        fun config _
            =
            (sizefn, drawfn);

    };                  # package diamondbutton_shape 

end;


## COPYRIGHT (c) 1994 by AT&T Bell Laboratories  See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.