PreviousUpNext

15.4.1384  src/lib/x-kit/widget/leaf/button-base.pkg

## button-base.pkg

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



# Base types and values for buttons, etc.



###              "I have traveled the length and breadth of
###               this country and talked with the best people,
###               and I can assure you that data processing is
###               a fad that won't last out the year."
###
###                         -- Editor of business books
###                            for Prentice Hall, 1954


stipulate
    include threadkit;                                          # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package wg =  widget;                                       # widget                is from   src/lib/x-kit/widget/basic/widget.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 button_base {

        package mouse {
            Event
              = DOWN  xc::Mousebutton                           # User has pressed  given mousebutton.
              | UP    xc::Mousebutton                           # User has released given mousebutton.
              | FOCUS Bool                                      # We send (mouse::FOCUS TRUE) on a MOUSE_ENTER xevent, (mouse::FOCUS FALSE) on a MOUSE_LEAVE xevent.
              ;
        };

        Button_State                                            # Button_State          def in    src/lib/x-kit/widget/basic/widget-base.api
            =
            { button_state:            wt::Button_State,        # IN/ACTIVE state + on/off state.
              has_mouse_focus:         Bool,                    # has_mouse_focus: TRUE iff we've seen a MOUSE_ENTER xevent but not yet a matching MOUSE_LEAVE.
              mousebutton_is_down:  Bool                        #
            };                                                  #               Button_State should be a record, not a tuple. XXX BUGGO FIXME.

        fun make_button_state (TRUE,  v) =>  wt::ACTIVE   v;
            make_button_state (FALSE, v) =>  wt::INACTIVE v;
        end;

        fun flip (wt::ACTIVE   is_on) => wt::ACTIVE   (not is_on);
            flip (wt::INACTIVE is_on) => wt::INACTIVE (not is_on);
        end;

        fun get_state { button_state => wt::ACTIVE   is_on, has_mouse_focus, mousebutton_is_down } => is_on;            # Boolean on/off state.
            get_state { button_state => wt::INACTIVE is_on, has_mouse_focus, mousebutton_is_down } => is_on;
        end;

        fun set_state (TRUE,  { button_state => wt::INACTIVE _, has_mouse_focus, mousebutton_is_down }) =>   { button_state => wt::INACTIVE TRUE,  has_mouse_focus, mousebutton_is_down };
            set_state (TRUE,  { button_state => wt::ACTIVE _,   has_mouse_focus, mousebutton_is_down }) =>   { button_state => wt::ACTIVE   TRUE,  has_mouse_focus, mousebutton_is_down };
            set_state (FALSE, { button_state => wt::INACTIVE _, has_mouse_focus, mousebutton_is_down }) =>   { button_state => wt::INACTIVE FALSE, has_mouse_focus, mousebutton_is_down };
            set_state (FALSE, { button_state => wt::ACTIVE _,   has_mouse_focus, mousebutton_is_down }) =>   { button_state => wt::ACTIVE   FALSE, has_mouse_focus, mousebutton_is_down };
        end;

        fun get_button_active_flag { button_state => wt::ACTIVE _, has_mouse_focus, mousebutton_is_down } =>  TRUE;
            get_button_active_flag _                                                                      =>  FALSE;
        end;

        fun set_button_active_flag (TRUE,  { button_state => wt::INACTIVE is_on, has_mouse_focus, mousebutton_is_down }) =>  { button_state => wt::ACTIVE   is_on, has_mouse_focus, mousebutton_is_down };
            set_button_active_flag (FALSE, { button_state => wt::ACTIVE   is_on, has_mouse_focus, mousebutton_is_down }) =>  { button_state => wt::INACTIVE is_on, has_mouse_focus, mousebutton_is_down };
            set_button_active_flag (_,     state                                                                       ) =>   state;
        end;

        Plea_Mail
          #
          = GET_BUTTON_ACTIVE_FLAG  Oneshot_Maildrop( Bool )
          | SET_BUTTON_ACTIVE_FLAG  Bool
          #
          | GET_STATE               Oneshot_Maildrop( Bool )
          | SET_STATE               Bool
          #
          | GET_SIZE_CONSTRAINT     Oneshot_Maildrop( wg::Widget_Size_Preference   )
          | GET_ARGS                Oneshot_Maildrop( wg::Window_Args )
          #
          | DO_REALIZE  {
              kidplug:     xc::Kidplug,
              window:      xc::Window,
              window_size: xg::Size
            }
          ;

        # Read from X server mouse events
        #
        #     MOUSE_LAST_UP
        #     MOUSE_ENTER
        #     MOUSE_LEAVE
        #     MOUSE_FIRST_DOWN
        #     MOUSE_LAST_UP
        #
        # and generate corresponding messages to the button
        #
        #     mouse::UP
        #     mouse::DOWN
        #     mouse::FOCUS
        #
        fun mse_p (from_mouse', mouse_slot)
            =
            loop ()
            where
                fun down_loop button
                    = 
                    case (xc::envelope_contents (block_until_mailop_fires  from_mouse'))
                        #
                        xc::MOUSE_LAST_UP _ =>   put_in_mailslot  (mouse_slot, mouse::UP button);
                        xc::MOUSE_LEAVE   _ => { put_in_mailslot  (mouse_slot, mouse::FOCUS FALSE );   down_loop  button; };
                        xc::MOUSE_ENTER   _ => { put_in_mailslot  (mouse_slot, mouse::FOCUS TRUE  );   down_loop  button; };
                        _                   =>                                              down_loop  button;
                    esac; 

                fun loop ()
                    =
                    loop ()
                    where 

                        case (xc::envelope_contents (block_until_mailop_fires  from_mouse'))
                            #                       
                            xc::MOUSE_FIRST_DOWN { mouse_button, ... }
                                =>
                                {   put_in_mailslot  (mouse_slot,  mouse::DOWN mouse_button);
                                    down_loop  mouse_button;
                                };

                            xc::MOUSE_ENTER _ =>  put_in_mailslot  (mouse_slot,  mouse::FOCUS  TRUE );
                            xc::MOUSE_LEAVE _ =>  put_in_mailslot  (mouse_slot,  mouse::FOCUS  FALSE);
                            _                 =>  ();
                        esac;
                    end;
            end;


    };          #  button_base 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext