15.4.1511  src/lib/x-kit/widget/old/leaf/colorbox.pkg

## colorbox.pkg
#
# Widget that fills box with a color.

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





###      "Who the hell wants to hear actors talk?"
###               --  H M Warner
###                   of Warner Brothers, 1927 


stipulate
    package wg =  widget;                               # widget                is from   src/lib/x-kit/widget/old/basic/widget.pkg
    package wa =  widget_attribute_old;                 # widget_attribute_old  is from   src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg
    #
    package xc =  xclient;                              # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
herein

    package   colorbox
    : (weak)  Colorbox                                  # Colorbox              is from   src/lib/x-kit/widget/old/leaf/colorbox.api
    {
        attributes
            =
            [  (wa::foreground,     wa::COLOR,    wa::STRING_VAL "black")  ];

        fun crect (root_window, color, size_preference_thunk_of)
            =
            {   fun realize_widget { kidplug, window, window_size }
                    =
                    {   xc::ignore_all  kidplug;
                        ();
                    };

                wg::make_widget
                  {
                    root_window, 
                    args =>   \\ () = { background => THE color },
                    size_preference_thunk_of,
                    realize_widget
                  };
            };

        fun colorbox  (root_window, view, args)  size_preference_thunk_of
            =
            {   attributes = wg::find_attribute (wg::attributes (view, attributes, args));
                #
                color = wa::get_color (attributes wa::foreground);

                crect (root_window, color, size_preference_thunk_of);
            };

        fun make_colorbox  root_window  (color_opt, size_preference_thunk_of)
            =
            {   screen =  wg::screen_of  root_window;
                #
                color = case color_opt   
                            #
                            THE color =>  color;
                            NULL      =>  xc::black;
                        esac;

                crect (root_window, color, size_preference_thunk_of);
            };

    };          # package colored_box 

end;


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