PreviousUpNext

15.4.1516  src/lib/x-kit/widget/old/leaf/label.pkg

## label.pkg
#
# Label widget.
#
# TODO:         XXX SUCKO FIXME
#   allow user control over maxc, either in pixels or as character

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





###                    "I think computer viruses should count as life.
###                     I think it says something about human nature
###                     that the only form of life we have created
###                     so far is purely destructive.
###                     We've created life in our own image."
###
###                                    -- Stephen Hawking (1942 - )



stipulate
    include package   threadkit;                # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package g2d=  geometry2d;                   # geometry2d            is from   src/lib/std/2d/geometry2d.pkg
    #
    package xc =  xclient;                      # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package d3 =  three_d;                      # three_d               is from   src/lib/x-kit/widget/old/lib/three-d.pkg
    package fil =  file__premicrothread;        # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
    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 wy =  widget_style_old;             # widget_style_old      is from   src/lib/x-kit/widget/old/lib/widget-style-old.pkg
    package wt =  widget_types;                 # widget_types          is from   src/lib/x-kit/widget/old/basic/widget-types.pkg
herein

    package   label
    : (weak)  Label                             # Label                 is from   src/lib/x-kit/widget/old/leaf/label.api
    {
        Label_Type = TEXT  String
                   | ICON  xc::Ro_Pixmap
                   ;

        Plea_Mail
            = SET_LABEL  Label_Type
            #
            | SET_BC  xc::Rgb
            | SET_FC  xc::Rgb
            #
            | GET_SIZE_CONSTRAINT  Oneshot_Maildrop( wg::Widget_Size_Preference )
            #
            | DO_REALIZE
                {
                  kidplug:     xc::Kidplug,
                  window:      xc::Window,
                  window_size: g2d::Size
                };

        Label_Data
          = TEXT_DATA  { s:  String, rb:  Int, lb:  Int }
          | ICON_DATA  xc::Ro_Pixmap
          ;

        Font_Info = FONT_INFO
                      {
                        font:   xc::Font,
                        fonta:  Int,                  #  font ascent 
                        fontd:  Int,                  #  font descent 
                        maxc:   Int                   #  max. char width 
                      };

        fun make_font_info font
            =
            {   (xc::font_high     font) ->   { ascent, descent };
                (xc::font_info_of  font) ->   { max_bounds, ... };

                max_bounds ->  xc::CHAR_INFO { char_width, ... };

               FONT_INFO { font, fonta=>ascent, fontd=>descent, maxc => char_width };
            };

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

                TEXT_DATA { s, lb, rb };
            };

        Label_View
            =
            LABEL_VIEW
              {
                label:   Ref( Label_Data   ), 
                fg:      Ref( xc::Rgb ), 
                bg:      Ref( xc::Rgb ), 
                shades:  Ref( wg::Shades    ),
                #
                relief:        wg::Relief,
                border_thickness:  Int,
                font:          Font_Info,
                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::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::FLAT),
              (wa::foreground,   wa::COLOR,  wa::STRING_VAL "black"),
              (wa::background,   wa::COLOR,  wa::STRING_VAL "white")
            ];


        fun label_view (root_window, view, args)
            =
            {
                attributes = wg::find_attribute (wg::attributes (view, attributes, args));
                #
                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);

                (make_font_info (wa::get_font (attributes wa::font)))
                    ->
                    fifi as FONT_INFO { font=>f, ... };
                    

                label = ICON_DATA (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);

                shades = wg::shades root_window bg;

                LABEL_VIEW {
                    label => REF label,
                    fg => REF fg,
                    bg => REF bg,
                    shades => REF shades,
                    relief,
                    border_thickness => int::max (0, bw),
                    font => fifi,
                    align,

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

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

        Label = LABEL { widget:     wg::Widget,
                        plea_slot:  Mailslot( Plea_Mail )
                      };

        fun bounds lview
            =
            {   lview ->   LABEL_VIEW { border_thickness, width, height, padx, pady, font, ... };
                #
                fun compute_size (LABEL_VIEW { label => REF (ICON_DATA ro_pixmap), ... } )
                        =>
                        {   (xc::size_of_ro_pixmap  ro_pixmap)
                                ->
                                { wide, high };

                            w =    (width  > 0)  ??  width  ::  wide;
                            h =    (height > 0)  ??  height ::  high;

                            { wide=>w, high=>h };
                        };

                   compute_size (LABEL_VIEW { label => REF (TEXT_DATA { rb, lb, s } ), ... } )
                       =>
                       {   font ->  FONT_INFO { fonta, fontd, maxc, ... };

                           wide = rb - lb;
                           line_high = fonta + fontd;

                           w = if (width == 0)  wide; 
                               else             width*maxc;
                               fi;

                           h = if (height > 0)  height*line_high;
                               else             line_high;
                               fi;

                           { wide=>w, high=>h };
                        };
                end;

                (compute_size  lview) ->   { wide, high };

                col_preference =  wg::tight_preference (wide + 2*(border_thickness+padx+1));
                row_preference =  wg::tight_preference (high + 2*(border_thickness+pady+1));

                { col_preference,
                  row_preference
                };
            };

        fun update_label (lv as LABEL_VIEW { label, ... }, ICON t)
                =>
                {   label := ICON_DATA t;
                    lv;
                };

            update_label (lv as LABEL_VIEW { label, font=>FONT_INFO { font, ... }, ... }, TEXT s)
                => 
                {   label := make_text_label (s, font);
                    lv;
                };
        end;

        fun update_fg (lv as LABEL_VIEW { fg, ... }, c)
            =
            {   fg := c;
                lv;
            };

        fun update_bg root_window (lv as LABEL_VIEW { bg, shades, ... }, c)
            = 
            {   bg := c;
                shades := wg::shades root_window c;
                lv;
            };

        fun draw
            (dr, { wide, high } )
            (LABEL_VIEW lv)
            =
            {
                lv ->  { shades, relief, label, border_thickness, fg, bg, ... };
                #
                box  =  { col=>0, row=>0, wide, high };
                xoff =  border_thickness + lv.padx;

                xc::fill_box  dr  (xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb *bg)])  box;

                case *label
                    #
                    ICON_DATA ro_pixmap
                        =>
                        {   pen = xc::make_pen [ xc::p::FOREGROUND (xc::rgb8_from_rgb  *fg),
                                                 xc::p::BACKGROUND (xc::rgb8_from_rgb  *bg)
                                               ];

                            (xc::size_of_ro_pixmap  ro_pixmap)
                                ->
                                { wide=>twid, high=>tht };

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

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

                            y = (high - tht) / 2;

                            pos =  { col=>x, row=>y };

                            xc::bitblt dr pen { from     =>  xc::FROM_RO_PIXMAP ro_pixmap,
                                                from_box =>  sr,
                                                to_pos   =>  pos
                                              };
                            (); 
                        };

                    TEXT_DATA { s, lb, rb }
                        =>
                        {   lv.font -> FONT_INFO { font, fonta, fontd, ... };
                            #
                            pen = xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb  *fg)];

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

                            row = (high + fonta - fontd) / 2;

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

                d3::draw_box dr { box, relief, width=>border_thickness }
                        *shades;
            };

        fun realize { kidplug, window, window_size } (root_window, plea_slot, lv)
            =
            {   (xc::ignore_mouse_and_keyboard  kidplug)
                    ->
                    xc::KIDPLUG { from_other', to_mom, ... };

                dr =  xc::drawable_of_window  window;

                fun check_size (label, label', wide, high)
                    =
                    case (label, label')
                        #
                        (TEXT_DATA { lb, rb, ... }, TEXT_DATA { lb=>lb', rb=>rb', ... } )
                            =>
                            if (wide == 0 and rb' - lb' != rb - lb)
                                #
                                block_until_mailop_fires  (to_mom  xc::REQ_RESIZE);
                            fi;

                        (ICON_DATA t, ICON_DATA t')
                            =>
                            {   size  = xc::size_of_ro_pixmap t ;
                                size' = xc::size_of_ro_pixmap t';

                                if ((wide == 0 or high == 0) and size != size' )
                                    #
                                    fil::print "resize2\n";
                                    block_until_mailop_fires  (to_mom  xc::REQ_RESIZE);
                                fi; 
                            };

                        _   =>
                            {   fil::print "resize3\n";
                                block_until_mailop_fires  (to_mom  xc::REQ_RESIZE);
                            };
                    esac;


                fun do_plea (SET_LABEL v, lv)
                        =>
                        {   lv ->  LABEL_VIEW { label=> REF l, width, height, ... };
                            #
                            (update_label (lv, v))
                                ->
                                lv' as LABEL_VIEW { label => REF l', ... };

                            check_size (l, l', width, height);

                            THE lv';
                        };

                    do_plea (SET_BC c, lv)
                        =>
                        THE (update_bg root_window (lv, c));

                    do_plea (SET_FC c, lv)
                        =>
                        {   update_fg (lv, c);
                            THE lv;
                        };

                    do_plea (GET_SIZE_CONSTRAINT reply_1shot, lv)
                        =>
                        {   put_in_oneshot (reply_1shot, bounds lv);
                            NULL;
                        };

                    do_plea _
                        =>
                        NULL;
                end;


                fun do_mom (xc::ETC_REDRAW _, me as (lv, drawf))
                        => 
                        {   drawf lv;
                            me;
                        };

                    do_mom (xc::ETC_RESIZE ({ wide, high, ... }: g2d::Box), (lv, _))
                        => 
                        (lv, draw (dr, { wide, high } ));

                    do_mom (_, me)
                        =>
                        me;
                end;


                fun loop (lv, drawf)
                    =
                    do_one_mailop [
                        #
                        take_from_mailslot'  plea_slot
                            ==>
                            (\\ event = case (do_plea (event, lv))
                                            #
                                            NULL    => loop (lv, drawf);
                                            #
                                            THE lv' => {   drawf lv';
                                                           loop (lv', drawf);
                                                       };
                                        esac),

                        from_other'
                            ==>
                            (\\ envelope
                                =
                                loop (do_mom (xc::get_contents_of_envelope envelope, (lv, drawf))))
                    ];

                loop (lv, draw (dr, window_size));
            };

        fun init (root_window, plea_slot, lv)
            =
            loop lv
            where 
                fun loop lv
                    =
                    case (take_from_mailslot  plea_slot)
                        #                  
                        SET_LABEL l => loop (update_label (lv, l));

                        SET_BC c => loop (update_bg root_window (lv, c));
                        SET_FC c => loop (update_fg (lv, c));

                        DO_REALIZE arg =>  realize arg (root_window, plea_slot, lv);

                        GET_SIZE_CONSTRAINT reply_1shot =>  {   put_in_oneshot (reply_1shot, bounds lv);   loop lv;  };
                    esac;
            end;

        fun make_label' (args as (root_window, _, _))
            =
            {   lv = label_view args;
                #
                plea_slot = make_mailslot ();

                fun get_bounds ()
                    =
                    {   reply_1shot =  make_oneshot_maildrop ();
                        #
                        put_in_mailslot (plea_slot, GET_SIZE_CONSTRAINT reply_1shot);

                        get_from_oneshot  reply_1shot;
                    };

                make_thread  "label"  {.
                    #
                    init (root_window, plea_slot, lv);
                };

                LABEL
                  {
                    plea_slot,

                    widget => wg::make_widget
                                { root_window,
                                  args                     =>  \\ () = { background => NULL },
                                  size_preference_thunk_of =>  get_bounds,
                                  realize_widget           =>  \\ arg = put_in_mailslot (plea_slot, DO_REALIZE arg)
                                }
                  };
              };


        fun make_label root_window { label=>caption, font, foreground, background, align }
            =
            {   name = wy::make_view
                         { name    => wy::style_name ["label"],
                           aliases => []
                         };

                args = [ (wa::halign, wa::HALIGN_VAL align),
                         (wa::label,  wa::STRING_VAL caption)
                       ];

                args = case font
                           #
                           THE f => (wa::font, wa::STRING_VAL f) ! args;
                           NULL  => args;
                       esac;

                args = case foreground    
                           #
                           THE fc => (wa::foreground, wa::COLOR_VAL fc) ! args;
                           NULL   => args;
                       esac;

                args = case background    
                           #
                           THE bc => (wa::background, wa::COLOR_VAL bc) ! args;
                           NULL   => args;
                       esac;

                make_label' (root_window, (name, wg::style_of root_window), args);
            };

        fun as_widget (LABEL { widget,    ... } )     =   widget;
        fun set msg   (LABEL { plea_slot, ... } ) arg =   put_in_mailslot  (plea_slot,  msg arg);

        set_label =  set  SET_LABEL;

        set_background = set SET_BC;
        set_foreground = set SET_FC;

    };                  #  Label 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext