PreviousUpNext

15.4.1396  src/lib/x-kit/widget/leaf/labelbutton-look.pkg

## labelbutton-look.pkg
#
# Basic labeled button view.

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




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

stipulate
    include threadkit;                                                  # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    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 labelbutton_look: (weak)  Button_Look {             # Button_Look           is from   src/lib/x-kit/widget/leaf/button-look.api


        Label_Type = TEXT  String | ICON  xc::Ro_Pixmap;

    # 2010-01-09 CrT: Commented out because unused.
    #    Plea_Mail
    #      = SET_LABEL  Label_Type
    #      #
    #      | SET_BC     xc::Color
    #      | SET_FC     xc::Color
    #      #
    #      | GET_SIZE_CONSTRAINT  Oneshot_Maildrop( wg::Bounds )
    #      #
    #      | DO_REALIZE  {
    #          kidplug:  xinputt::Kidplug,
    #          window:   xc::Window,
    #          size:     xg::Size
    #        };

        Label_Data
          =  TXT  { s:  String, rb:  Int, lb:  Int }
          | ICON  xc::Ro_Pixmap
          ;

        fun make_font_info font
            =
            {   my { ascent=>font_ascent, descent=>font_descent }
                    =
                    xc::font_high font;

               (font, font_ascent, font_descent);
            };

        fun make_text_label (s, font)
            =
            {   my xc::CHAR_INFO { left_bearing=>lb, right_bearing=>rb, ... }
                    =
                    .overall_info (xc::text_extents font s);

                TXT { s, lb, rb };
            };

        fun size_of_label (ICON ro_pixmap, _)
                =>
                xc::size_of_ro_pixmap ro_pixmap;

            size_of_label (TXT { lb, rb, ... }, (_, fa, fd))
                =>
                xg::SIZE { wide => rb - lb + 2, high => fa + fd + 2 };
        end;

        Light_Type = RADIO_LIGHT | CHECK_LIGHT;


        fun cvt_light "radio" => THE RADIO_LIGHT;
            cvt_light "check" => THE CHECK_LIGHT;
            cvt_light _       => NULL;
        end;


        Light = { space:  Int, 
                  size:   Int, 

                  ltype:  Light_Type, 
                  color:  xc::Rgb
                };


        fun make_light (NULL, _, _, _, _)
                =>
                NULL;

            make_light (THE lt, ICON ro_pixmap, height, _, color)
                =>
                {   my  xg::SIZE { wide, high }
                        =
                        xc::size_of_ro_pixmap ro_pixmap;

                    high = if (height > 0)  height;
                           else             high;
                           fi;

                    size =   case lt
                                 #
                                 CHECK_LIGHT => (65*high) / 100;
                                 RADIO_LIGHT => (75*high) / 100;
                             esac;

                    THE { ltype=>lt, space=>high, size, color };
                };

            make_light (THE lt, _, _, (font, font_ascent, font_descent), color)
                =>
                {   size =  case lt
                                 CHECK_LIGHT => (80*(font_ascent + font_descent)) / 100;
                                 RADIO_LIGHT =>      font_ascent + font_descent;
                            esac;

                    high = size + (xc::text_width font "0");

                    THE { ltype=>lt, space=>high, size, color };
                };
        end;

        Button_Look
            =
            BUTTON_LOOK
              { light:  Null_Or( Light ), 
                label:  Label_Data, 
                relief:  wg::Relief,
                #
                fg:      xc::Rgb, 
                bg:      xc::Rgb, 
                readyc:  xc::Rgb, 
                #
                shades:  wg::Shades,
                stipple:  xc::Ro_Pixmap,
                border_thickness:  Int,
                #
                font:  (xc::Font, Int, Int),
                align:  wt::Horizontal_Alignment,
                #
                width:  Int,
                height: Int,
                padx:   Int,
                pady:   Int
              };

        default_font = "-Adobe-Helvetica-Bold-R-Normal--*-120-*";


        attributes
            =
            [ (wa::halign,         wa::HALIGN,     wa::HALIGN_VAL  wt::HCENTER),
              (wa::tile,           wa::TILE,       wa::NO_VAL),
              (wa::label,          wa::STRING,     wa::STRING_VAL ""),
              (wa::type,           wa::STRING,     wa::STRING_VAL "NoLight"),
              (wa::border_thickness,   wa::INT,        wa::INT_VAL 2),
              (wa::height,         wa::INT,        wa::INT_VAL 0),
              (wa::width,          wa::INT,        wa::INT_VAL 0),
              (wa::padx,           wa::INT,        wa::INT_VAL 1),
              (wa::pady,           wa::INT,        wa::INT_VAL 1),
              (wa::font,           wa::FONT,       wa::STRING_VAL default_font),
              (wa::relief,         wa::RELIEF,     wa::RELIEF_VAL wg::RAISED),
              (wa::foreground,     wa::COLOR,      wa::STRING_VAL "black"),
              (wa::color,          wa::COLOR,      wa::NO_VAL),
              (wa::ready_color,    wa::COLOR,      wa::NO_VAL),
              (wa::background,     wa::COLOR,      wa::STRING_VAL "white")
            ];


        fun make_button_look (root, view, args)
            =
            {   

                attributes = wg::find_attribute (wg::attributes (view, attributes, args));

                ltype  = wa::get_string (attributes wa::type);
                align  = wa::get_halign (attributes wa::halign);

                bw     = wa::get_int (attributes wa::border_thickness);

                height = wa::get_int (attributes wa::height);
                width  = wa::get_int (attributes wa::width);

                padx   = wa::get_int (attributes wa::padx);
                pady   = wa::get_int (attributes wa::pady);

                my font as (f, _, _)
                    =
                    make_font_info (wa::get_font (attributes wa::font));

                label = ICON (wa::get_tile (attributes wa::tile))
                              except _ = make_text_label (wa::get_string (attributes wa::label), f);

                relief = wa::get_relief (attributes wa::relief);
                lab    = wa::get_string (attributes wa::label);

                fg     = wa::get_color (attributes wa::foreground);
                bg     = wa::get_color (attributes wa::background);

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

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

                light = make_light (cvt_light ltype, label, height, font, set_color);

                BUTTON_LOOK {
                  light,
                  label,
                  relief,
                  stipple => wg::ro_pixmap root "gray",
                  fg,
                  bg,
                  shades => wg::shades root bg,
                  readyc,
                  border_thickness => int::max (0, bw),
                  font,
                  align,

                  width  => int::max (0, width),
                  height => int::max (0, height),

                  padx   => int::max (0, padx),
                  pady   => int::max (0, pady)
                };
              };

        fun bounds (BUTTON_LOOK v)
            =
            {   v ->  { label, border_thickness, width, height, padx, pady, font, ... };

                light_space = case v.light
                                  #
                                  NULL => 0;
                                  THE { space, ... } => space;
                              esac;

                my  xg::SIZE { wide, high }
                    =
                    size_of_label (label, font);

                wide = if (width > 0)   width;
                       else             (2*border_thickness + 2*padx + light_space + wide);
                       fi;

                high = if (height > 0)  height;
                       else             (2*border_thickness + 2*pady + high);
                       fi;

                col_preference =  wg::loose_preference  wide;
                row_preference =  wg::loose_preference  high;

                { col_preference,
                  row_preference
                };
            };

        fun config (BUTTON_LOOK v, window, xg::SIZE { wide, high } )
            =
            {   dr =  xc::drawable_of_window  window;

                v ->  { light, shades, label, border_thickness=>bw, fg, bg, readyc, ... };

                box  = xg::BOX { col=>0, row=>0, wide, high };

                xoff = bw + v.padx;

                back_pen     =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb bg)];
                ready_pen    =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb readyc)];
                normal_pen   =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb fg), xc::p::BACKGROUND (xc::rgb8_from_rgb  bg)];
                inactive_pen =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb fg)];

                inactive_pen =  xc::make_pen
                                  [ xc::p::FOREGROUND (xc::rgb8_from_rgb fg),
                                    xc::p::BACKGROUND (xc::rgb8_from_rgb bg),
                                    xc::p::FILL_STYLE_STIPPLED,
                                    xc::p::STIPPLE v.stipple
                                  ];

                lspace =   case light
                               #
                               NULL => 0;
                               THE { space, ... } => space;
                           esac;


                fun draw_radio (pen, size) is_on
                    =
                    {   ystart = high / 2;
                        half = size / 2;

                        ps = [ xg::POINT { col=>xoff,      row=>ystart },
                               xg::POINT { col=>xoff+half, row=>ystart+half },
                               xg::POINT { col=>xoff+size, row=>ystart },
                               xg::POINT { col=>xoff+half, row=>ystart-half }
                             ];

                        if is_on   xc::fill_polygon dr pen { verts=>ps, shape=>xc::CONVEX_SHAPE };   fi;

                        d3::draw_poly dr { pts=>ps, width=>bw, relief=>wg::RAISED } shades;
                    };


                fun draw_check (pen, size) is_on
                    =
                    {   r = xg::BOX { col=>xoff, row=> (high - size) / 2, wide => size, high => size };

                        if is_on   xc::fill_box dr pen r;   fi;

                        d3::draw_box dr { box=>r, width=>bw, relief=>wg::SUNKEN } shades;
                    };

                draw_label
                    =
                    case label

                         ICON ro_pixmap
                             =>
                             {   my  xg::SIZE { wide=>twid, high=>tht }
                                     =
                                     xc::size_of_ro_pixmap ro_pixmap;

                                 sr = xg::BOX { col=>0, row=>0, wide=>twid, high=>tht };

                                 x = case v.align
                                         #
                                         wt::HLEFT   =>  xoff + lspace;
                                         wt::HRIGHT  =>  wide - xoff - twid;
                                         wt::HCENTER => (wide + lspace - twid) / 2;
                                     esac;

                                 y = (high - tht) / 2;

                                 arg = { from=> xc::FROM_RO_PIXMAP ro_pixmap, from_box=>sr, to_pos=>xg::POINT { col=>x, row=>y }};

                                 fn pen
                                     =
                                     {   xc::bitblt dr pen arg;

                                         ();
                                     };
                             };

                         TXT { s, lb, rb }
                             =>
                             {   v.font ->  (font, font_ascent, font_descent);

                                 pen =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb fg)];

                                 col = case v.align   
                                           #
                                           wt::HLEFT   =>   xoff + lspace - lb + 1;
                                           wt::HRIGHT  =>   wide - xoff - rb - 1;
                                           wt::HCENTER =>  (wide + lspace - lb - rb) / 2;
                                       esac;

                                 row = (high + font_ascent - font_descent) / 2;

                                 fn pen
                                     =
                                     xc::draw_transparent_string
                                         dr
                                         pen
                                         font
                                         (xg::POINT { col, row },  s);
                             };
                    esac;

                fun setf { button_state => wt::INACTIVE s, ... }
                        =>
                        {   rel =   s  ??  wg::SUNKEN
                                       ::  v.relief;

                            xc::fill_box dr back_pen box;

                            draw_label inactive_pen;

                            d3::draw_box dr { box, relief=>rel, width=>bw } shades;
                         };

                    setf { button_state => wt::ACTIVE s, has_mouse_focus, mousebutton_is_down }
                        =>
                        {   backpen = if has_mouse_focus  ready_pen;
                                      else                back_pen;
                                      fi;

                            relief =  (s == mousebutton_is_down)  ??   v.relief
                                                                  ::   wg::SUNKEN;

                            xc::fill_box dr backpen box;

                            draw_label normal_pen;

                            d3::draw_box dr { box, relief, width=>bw } shades;
                        };
                end;

                fun lsetf draw_light { button_state => wt::INACTIVE s, ... }
                        =>
                        {   rel = v.relief;

                            xc::fill_box dr back_pen box;

                            draw_label inactive_pen;
                            draw_light s;

                            d3::draw_box dr { box, relief=>rel, width=>bw } shades;
                        };

                    lsetf draw_light { button_state => wt::ACTIVE s, has_mouse_focus, mousebutton_is_down }
                        =>
                        {   backpen = if has_mouse_focus  ready_pen;
                                      else                back_pen;
                                      fi;

                            relief =    mousebutton_is_down  ??  wg::SUNKEN
                                                             ::  v.relief;

                            xc::fill_box dr backpen box;
                            draw_label normal_pen;
                            draw_light s;
                            d3::draw_box dr { box, relief, width=>bw } shades;
                        };
                end;


                case light 
                    #
                    NULL => setf;
                    #
                    THE { ltype => CHECK_LIGHT, size, color, ... }
                        => 
                        lsetf (draw_check (xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb color)], size));

                    THE { ltype => RADIO_LIGHT, size, color, ... }
                        => 
                        lsetf (draw_radio (xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb color)], size));
                esac;
            };

        fun window_args (BUTTON_LOOK { bg, ... } )
            =
            { background => THE bg };

    };                  # package labelbutton_look 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext