## button-look-from-shape-g.pkg
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib# Generic for producing simple shape button views.
### "[By the end of the 20th Century there will be a generation]
### to whom it will not be injurious to read a dozen quire
### of newspapers daily, to be constantly called to the telephone
### [and] to live half their time in a railway carriage
### or in a flying machine."
###
### -- Max Nordau 1895
stipulate
package bst = button_shape_types; # button_shape_types is from src/lib/x-kit/widget/leaf/button-shape-types.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.pkgherein
generic package button_look_from_shape_g (
s: Button_Shape # Button_Shape is from src/lib/x-kit/widget/leaf/button-shape.api )
: (weak) Button_Look # Button_Look is from src/lib/x-kit/widget/leaf/button-look.api {
attributes
= (wa::border_thickness, wa::INT, wa::INT_VAL 2)
! (wa::width, wa::INT, wa::INT_VAL 30)
! (wa::height, wa::INT, wa::NO_VAL)
! (wa::background, wa::COLOR, wa::STRING_VAL "white")
! (wa::color, wa::COLOR, wa::NO_VAL)
! (wa::ready_color, wa::COLOR, wa::NO_VAL)
! (wa::foreground, wa::COLOR, wa::NO_VAL)
! s::attributes
;
Button_Look
=
BUTTON_LOOK
{
bw: Int,
shades: wg::Shades,
rshades: wg::Shades,
stipple: xc::Ro_Pixmap,
drawfn: bst::Drawfn,
fg: Null_Or( xc::Rgb ),
bg: xc::Rgb,
size: wg::Widget_Size_Preference
};
fun make_button_look (root, view, args)
=
{ attributes
=
wg::find_attribute (wg::attributes (view, attributes, args));
my (sizefn, drawfn)
=
s::config attributes;
stipple = wg::ro_pixmap root "gray";
wide = wa::get_int (attributes wa::width);
high = wa::get_int_opt (attributes wa::height);
foreground_color = wa::get_color_opt (attributes wa::foreground);
background_color = wa::get_color (attributes wa::background);
color = case (wa::get_color_opt (attributes wa::color))
#
THE color => color;
_ => background_color;
esac;
readyc = case (wa::get_color_opt (attributes wa::ready_color))
#
THE color => color;
_ => color;
esac;
bwid = wa::get_int (attributes wa::border_thickness);
shades = wg::shades root color;
BUTTON_LOOK
{
bg => background_color,
fg => foreground_color,
bw => bwid,
stipple,
shades,
rshades => (xc::same_rgb (color, readyc))
?? shades
:: wg::shades root readyc,
drawfn,
size => sizefn (wide, high)
};
};
fun config (BUTTON_LOOK v, window, size)
=
{ dr = xc::drawable_of_window window;
v -> { fg, bw, drawfn, shades, rshades, ... };
draw = drawfn (dr, size, bw);
fun add_stipple p
=
xc::clone_pen
( p,
[ xc::p::FILL_STYLE_STIPPLED,
xc::p::STIPPLE v.stipple
]
);
shades -> { light, base, dark };
rshades -> { light=>rlight, base=>rbase, dark=>rdark };
ilight = add_stipple light;
idark = add_stipple dark;
ibase = add_stipple base;
my (fore, ifore)
=
case fg
#
NULL => (base, ibase);
#
THE c => { forepen = xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb c) ];
(forepen, add_stipple forepen);
};
esac;
fun setf { button_state => wt::INACTIVE TRUE, ... }
=>
draw (ibase, idark, ilight);
setf { button_state => wt::INACTIVE FALSE, ... }
=>
draw (ibase, ilight, idark);
setf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => FALSE }
=>
if has_mouse_focus draw (rbase, rlight, rdark);
else draw ( base, light, dark);
fi;
setf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => TRUE }
=>
if has_mouse_focus draw (rbase, rdark, rlight);
else draw ( base, dark, light);
fi;
setf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => FALSE }
=>
if has_mouse_focus draw (rbase, rdark, rlight);
else draw ( base, dark, light);
fi;
setf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => TRUE }
=>
if has_mouse_focus draw (rbase, rdark, rlight);
else draw ( base, dark, light);
fi;
end;
fun fsetf { button_state => wt::INACTIVE TRUE, ... }
=>
draw (ifore, ilight, idark);
fsetf { button_state => wt::INACTIVE FALSE, ... }
=>
draw (ibase, ilight, idark);
fsetf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => FALSE }
=>
if has_mouse_focus draw (rbase, rlight, rdark);
else draw ( base, light, dark);
fi;
fsetf { button_state => wt::ACTIVE FALSE, has_mouse_focus, mousebutton_is_down => TRUE }
=>
if has_mouse_focus draw (rbase, rdark, rlight);
else draw ( base, dark, light);
fi;
fsetf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => FALSE }
=>
if has_mouse_focus draw (fore, rlight, rdark);
else draw (fore, light, dark);
fi;
fsetf { button_state => wt::ACTIVE TRUE, has_mouse_focus, mousebutton_is_down => TRUE }
=>
if has_mouse_focus draw (fore, rdark, rlight);
else draw (fore, dark, light);
fi;
end;
case fg
#
NULL => setf;
_ => fsetf;
esac;
};
fun bounds (BUTTON_LOOK { size, ... } )
=
size;
fun window_args (BUTTON_LOOK { bg, ... } )
=
{ background => THE bg };
}; # generic package button_look_from_shape_g
end;