PreviousUpNext

15.4.1389  src/lib/x-kit/widget/leaf/checkbutton-look.pkg

## checkbutton-look.pkg
#
# View for check-box buttons.

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






###              "The general application of the transistor in
###               radio and television is far in the future."
###                             --  Lee deForest, 1952

# This package gets used in:
#
#     src/lib/x-kit/widget/leaf/toggleswitches.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 wa =  widget_attribute;                                     # widget_attribute      is from   src/lib/x-kit/widget/lib/widget-attribute.pkg
    package wt =  widget_types;                                         # widget_types          is from   src/lib/x-kit/widget/basic/widget-types.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 checkbutton_look: (weak)  Button_Look {             # Button_Look   is from   src/lib/x-kit/widget/leaf/button-look.api


        attributes
            =
            [ (wa::relief,         wa::RELIEF, wa::RELIEF_VAL wg::FLAT),
              (wa::width,          wa::INT,    wa::INT_VAL 30),
              (wa::ready_color,    wa::COLOR,  wa::NO_VAL),
              (wa::color,          wa::COLOR,  wa::NO_VAL),
              (wa::background,     wa::COLOR,  wa::STRING_VAL "white"),
              (wa::foreground,     wa::COLOR,  wa::STRING_VAL "black")
            ];

         Button_Look
             =
             BUTTON_LOOK
               {
                 relief:  wg::Relief,
                 shades:  wg::Shades,
                 stipple: xc::Ro_Pixmap,
                 fg:      xc::Rgb,
                 bg:      xc::Rgb,
                 color:   xc::Rgb,
                 readyc:  xc::Rgb,
                 size:    Int
               };

        fun make_button_look (root, view, args)
            =
            {   attributes = wg::find_attribute (wg::attributes (view, attributes, args));

                size   = wa::get_int    (attributes wa::width);
                relief = wa::get_relief (attributes wa::relief);

                forec  = wa::get_color  (attributes wa::foreground);
                backc  = wa::get_color  (attributes wa::background);

                color = case (wa::get_color_opt (attributes wa::color))   
                            #
                            THE c => c; 
                           _ => forec;
                        esac;

                readyc = case (wa::get_color_opt (attributes wa::ready_color))   
                             #  
                             NULL => color;
                             THE c => c;
                         esac;

                stipple = wg::ro_pixmap root "lightGray";

                BUTTON_LOOK
                  {
                    fg => forec,
                    stipple,
                    bg => backc,
                    color,
                    readyc,
                    relief,
                    shades => wg::shades root color,
                    size
                  };
            };

        fun config (BUTTON_LOOK (v as { size, color, shades, readyc, ... } ), window, xg::SIZE { wide, high } )
            =
            setf
            where
                drawable = xc::drawable_of_window window;

                bwid = 2; 
                pwid = 3; 

                focus_pen = if (xc::same_rgb (v.bg, readyc))   NULL;
                            else                               THE (xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb  readyc)]);
                            fi;

                shades ->  { light, base, dark };

                check_pen = xc::make_pen [ xc::p::FOREGROUND (xc::rgb8_from_rgb  v.fg), 
                                           xc::p::LINE_WIDTH 3,
                                           xc::p::JOIN_STYLE_MITER
                                         ];

                stipple = v.stipple;

                fun mki p
                    =
                    xc::clone_pen
                      ( p,
                        [ xc::p::FILL_STYLE_STIPPLED,
                          xc::p::STIPPLE stipple
                        ]
                      );

                i_check_pen = mki check_pen;

                ishades = { light=> mki light, dark => mki dark, base => mki base };

                bsz    =  int::min (wide, high) / 2;

                xstart =  (wide - bsz) / 2;
                ystart =  (high - bsz) / 2;

                box_r  =  xg::BOX { col=>xstart, row=>xstart, wide=>bsz, high=>bsz };

                drawr = d3::draw_box drawable { width=>bwid, box=>box_r, relief=> v.relief };

                check_pts
                    =
                    [ xg::POINT { col=>xstart+4,       row=>high / 2 },
                      xg::POINT { col=>wide / 2,       row=>(ystart+bsz) - 4 },
                      xg::POINT { col=>(xstart+bsz)+4, row=> ystart - (bsz / 6) }
                    ];

                fun draw_check pen
                    =
                    xc::draw_lines drawable pen check_pts;

                fun draw_box (shades, back)
                    =
                    {   xc::clear_drawable drawable;

                        case back   
                            #
                            THE p => xc::fill_box drawable p box_r;
                            NULL => ();
                        esac;

                        drawr shades;
                    };

                fun setf { button_state => wt::INACTIVE TRUE, has_mouse_focus, mousebutton_is_down }
                        => 
                        {   draw_box (ishades, NULL);
                            draw_check i_check_pen;
                        };

                   setf { button_state => wt::INACTIVE FALSE, has_mouse_focus, mousebutton_is_down }
                       =>
                       draw_box (ishades, NULL);

                   setf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => FALSE }
                      => 
                      if has_mouse_focus  draw_box (shades, focus_pen);
                      else                draw_box (shades, NULL);
                      fi;

                   setf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => TRUE }
                      =>
                      if has_mouse_focus  { draw_box (shades, focus_pen); draw_check check_pen; };
                      else                { draw_box (shades, NULL);      draw_check check_pen; };
                      fi;

                   setf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => FALSE }
                      =>
                      if has_mouse_focus  { draw_box (shades, focus_pen);  draw_check check_pen; };
                      else                { draw_box (shades, NULL);       draw_check check_pen; };
                      fi;

                   setf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => TRUE }
                       =>
                       if has_mouse_focus  draw_box (shades, focus_pen);
                       else                draw_box (shades, NULL);
                       fi;
                end;

            end;

        fun bounds      (BUTTON_LOOK { size, ... } ) =  wg::make_tight_size_preference (size, size);
        fun window_args (BUTTON_LOOK { bg,   ... } ) =  { background => THE bg };

    };                                                          # package checkbutton_look 

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.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext