15.4.1478  src/lib/x-kit/widget/old/basic/widget-base.pkg

## widget-base.pkg
#
# Definitions for basic widget types.

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






###                 "Programming graphics in X is like
###                  finding sqrt (pi) using Roman numerals."
###
###                                    - Henry Spencer

stipulate
    include package   threadkit;                        # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package si =  shade_imp_old;                        # shade _imp_old        is from   src/lib/x-kit/widget/old/lib/shade-imp-old.pkg
    package xc =  xclient;                              # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    package g2d=  geometry2d;                           # geometry2d            is from   src/lib/std/2d/geometry2d.pkg
herein

    package   widget_base
    : (weak)  Widget_Base                               # Widget_Base           is from   src/lib/x-kit/widget/old/basic/widget-base.api
    {
        Shades = si::Shades;

        exception BAD_STEP;

        Int_Preference
            =
            INT_PREFERENCE
              {
                start_at:     Int,
                step_by:      Int,
                #
                min_steps:    Int,
                max_steps:    Null_Or(Int),
                best_steps:  Int
              };

        Widget_Size_Preference
            =
            { col_preference:  Int_Preference,
              row_preference:  Int_Preference
            };

        # This is apparently nowhere called at present:
        #
        fun make_widget_size_preference  x
            =
            x;

        fun tight_preference x =  INT_PREFERENCE { start_at => x, step_by => 1, min_steps => 0, best_steps => 0, max_steps => THE 0 };
        fun loose_preference x =  INT_PREFERENCE { start_at => x, step_by => 1, min_steps => 0, best_steps => 0, max_steps => NULL  };

        fun preferred_length (INT_PREFERENCE { start_at, step_by, best_steps, ... } ) =  start_at + step_by*best_steps;
        fun minimum_length   (INT_PREFERENCE { start_at, step_by,   min_steps, ... } ) =  start_at + step_by*min_steps;

        fun maximum_length   (INT_PREFERENCE { start_at, step_by, max_steps=>NULL,    ... } ) =>  NULL;
            maximum_length   (INT_PREFERENCE { start_at, step_by, max_steps=>THE max, ... } ) =>  THE (start_at + step_by*max);
        end;

        fun make_tight_size_preference (x, y)
            =
            { col_preference => tight_preference x,
              row_preference => tight_preference y
            };

        fun is_between_length_limits (dim, v)
            =
            minimum_length dim <= v
            and
            case (maximum_length dim)   
                #
                THE max =>  v <= max;
                NULL    =>  TRUE;
            esac;

        fun is_within_size_limits
            ( { col_preference, row_preference }:   Widget_Size_Preference,
              { wide, high }
            )
            =
            is_between_length_limits (col_preference, wide)  and
            is_between_length_limits (row_preference, high);

        Window_Args
            =
            { background:  Null_Or( xc::Rgb ) };


        fun make_child_window
            ( parent_window,
              box,
              args:  Window_Args
            )
            =
            {   (g2d::box::size  box)
                    ->
                    { wide, high };

                if (wide <= 0  or  high <= 0) 
                    #
                    lib_base::failure
                        {
                            module => "Widget",
                            fn   => "wrapCreate",
                            msg    => "invalid size"
                        };
                fi;

                xc::make_simple_subwindow  parent_window
                  {
                    background_color =>  case args.background  THE rgb => THE (xc::rgb8_from_rgb rgb); NULL => NULL; esac,
                    border_color     =>  NULL,          # Not used.
                    #   
                    site =>    { upperleft    =>  g2d::box::upperleft  box,
                                 size         =>  g2d::box::size       box,
                                 border_thickness =>  0
                               }
                               : g2d::Window_Site
                  };
              };

        # Wrap a queue around given input mailop,
        # converting it from synchronous to asynchronous:
        #
        fun wrap_queue ine                      # "ine" may be "input_event"
            =
            {   make_thread "widget_base" {.
                    loop ([],[]);
                };

                take_from_mailslot'  out_slot;
            }
            where
                out_slot =   make_mailslot ();
                #
                fun loop ([],[])
                        =>
                        loop ([block_until_mailop_fires ine],[]);

                    loop ([], l)
                        =>
                        loop (reverse l,[]);

                    loop (l as e ! tl, rest)
                        => 
                        loop (
                            do_one_mailop [

                                put_in_mailslot'  (out_slot,  e)
                                    ==>
                                    {.   (tl, rest);  },

                                ine
                                    ==>
                                    {.   (l, #e ! rest);  }
                            ]
                        );
                end;
            end;

    };                          # package widget_base 

end;