## 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 package 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/old/basic/widget.pkg package wt = widget_types; # widget_types is from src/lib/x-kit/widget/old/basic/widget-types.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.pkgherein
# This package is referenced in:
#
# src/lib/x-kit/widget/old/leaf/pushbutton-behavior-g.pkg # src/lib/x-kit/widget/old/leaf/toggleswitch-behavior-g.pkg # src/lib/x-kit/widget/old/leaf/toggle-type.pkg #
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/old/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 SUCKO 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: g2d::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::get_contents_of_envelope (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::get_contents_of_envelope (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;