## message.pkg
#
# Text message widget.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "A computer shall not harm your work nor,
### through inaction, allow your work to come to harm."
###
### -- Jef Raskin
stipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package d3 = three_d; # three_d is from src/lib/x-kit/widget/lib/three-d.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.pkg #
package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkgherein
package message
: (weak) Message # Message is from src/lib/x-kit/widget/leaf/message.api {
Plea_Mail
= SET_TEXT String
| GET_TEXT Oneshot_Maildrop( String )
| GET_SIZE_CONSTRAINT Oneshot_Maildrop( wg::Widget_Size_Preference )
#
| DO_REALIZE { kidplug: xc::Kidplug,
window: xc::Window,
window_size: xg::Size
}
;
Message
=
MESSAGE
{ widget: wg::Widget,
plea_slot: Mailslot( Plea_Mail )
};
Textinfo = { text: String,
text_wide: Int,
text_high: Int
};
fun get_line (font, text, starti, maxx)
=
loop (starti, 0, starti, 0)
where
char_info = xc::char_info_of font;
endi = size text;
fun loop (i, curx, end_word, end_word_x)
=
if (endi == i)
#
(i, curx);
else
c = string::get (text, i);
if (c == '\n' )
#
(i, curx);
else
my xc::CHAR_INFO { char_width, ... }
=
char_info (char::to_int c);
nextx = curx+char_width;
if (nextx > maxx)
#
if (end_word > starti)
#
(end_word, end_word_x);
else
if (i > starti) (i, curx);
else (i+1, nextx);
fi;
fi;
else
my (end_word, end_word_x)
=
if (char::is_space c)
#
(i+1, nextx);
else
(end_word, end_word_x);
fi;
loop (i+1, nextx, end_word, end_word_x);
fi;
fi;
fi;
end;
fun make_text_info (root, aspect, text, width, fontinfo, bw, padx, pady)
=
{ text, text_wide, text_high }
where
fontinfo -> (font, font_ascent, font_descent);
font_high = font_ascent + font_descent;
xdelta = 2*(bw + padx);
ydelta = 2*(bw + pady);
aspect_delta = int::max (5, aspect / 10);
lower_bound = aspect - aspect_delta;
upper_bound = aspect + aspect_delta;
my xg::SIZE { wide=>screen_width, ... }
=
xc::size_of_screen (wg::screen_of root);
wi = if (width > 0)
(width, 0);
else
width = screen_width / 2;
(width, width / 2);
fi;
endi = size text;
fun get_size (i, maxw, txtht, width)
=
if (i == endi)
(maxw, txtht);
elif (string::get (text, i) == '\n' )
get_size (i+1, maxw, txtht+font_high, width);
else
my (nexti, linex)
=
get_line (font, text, i, width);
maxw = int::max (linex, maxw);
fun skip_ws i
=
{ c = string::get (text, i);
if (c == '\n') i+1;
elif (char::is_space c) skip_ws (i+1);
else i;
fi;
};
get_size
( (skip_ws nexti) except _ = nexti,
maxw,
txtht + font_high,
width
);
fi;
fun do_layout (width, inc)
=
{ my answer as (text_wide, text_high)
=
get_size (0, 0, 0, width);
if (inc <= 2)
answer;
else
aspect = (100*(text_wide + xdelta)) / (text_high + ydelta);
if (aspect < lower_bound )
do_layout (width+inc, inc / 2);
elif (aspect > upper_bound )
do_layout (width-inc, inc / 2);
else
answer;
fi;
fi;
};
my (text_wide, text_high)
=
do_layout wi;
end;
Fontinfo = (xc::Font, Int, Int);
fun make_font_info font
=
{ my { ascent=>font_ascent, descent=>font_descent }
=
xc::font_high font;
(font, font_ascent, font_descent);
};
attributes
=
[ (wa::aspect, wa::INT, wa::INT_VAL 150),
(wa::background, wa::COLOR, wa::STRING_VAL "white"),
(wa::border_thickness, wa::INT, wa::INT_VAL 2),
(wa::font, wa::FONT, wa::STRING_VAL "8x13"),
(wa::foreground, wa::COLOR, wa::STRING_VAL "black"),
(wa::gravity, wa::GRAVITY, wa::GRAVITY_VAL wt::CENTER),
(wa::halign, wa::HALIGN, wa::HALIGN_VAL wt::HLEFT),
(wa::padx, wa::INT, wa::NO_VAL),
(wa::pady, wa::INT, wa::NO_VAL),
(wa::relief, wa::RELIEF, wa::RELIEF_VAL wg::FLAT),
(wa::text, wa::STRING, wa::STRING_VAL " "),
(wa::width, wa::INT, wa::INT_VAL 0)
];
Result = { aspect: Int,
bg: xc::Rgb,
fg: xc::Rgb,
border_thickness: Int,
fontinfo: Fontinfo,
gravity: wt::Gravity,
justify: wt::Horizontal_Alignment,
padx: Int,
pady: Int,
relief: wg::Relief,
shades: wg::Shades,
textinfo: Ref( Textinfo ),
width: Int
};
fun get_resources (root, attributes) : Result
=
{ aspect = wa::get_int (attributes wa::aspect );
bg = wa::get_color (attributes wa::background);
font = wa::get_font (attributes wa::font );
my fontinfo as (_, font_ascent, _)
=
make_font_info font;
padx = case (wa::get_int_opt (attributes wa::padx))
#
THE i => i;
NULL => font_ascent / 2;
esac;
pady = case (wa::get_int_opt (attributes wa::pady))
#
THE i => i;
NULL => font_ascent / 4;
esac;
text = wa::get_string (attributes wa::text);
width = wa::get_int (attributes wa::width);
border_thickness = wa::get_int (attributes wa::border_thickness);
{ aspect,
bg,
border_thickness,
fontinfo,
fg => wa::get_color (attributes wa::foreground),
gravity => wa::get_gravity (attributes wa::gravity),
justify => wa::get_halign (attributes wa::halign),
padx,
pady,
relief => wa::get_relief (attributes wa::relief),
shades => wg::shades root bg,
textinfo => REF (make_text_info (root, aspect, text, width, fontinfo,
border_thickness, padx, pady)),
width
};
};
fun size_preference_thunk_of ( { textinfo, padx, pady, border_thickness, ... } : Result)
=
{ (*textinfo) -> { text_high, text_wide, ... };
x = text_wide + 2*(border_thickness + padx);
y = text_high + 2*(border_thickness + pady);
{ col_preference => wg::loose_preference x,
row_preference => wg::loose_preference y
};
};
fun drawf
( d,
size as xg::SIZE { wide, high },
result: Result
)
=
{ result -> { border_thickness=>bw, pady, padx, ... };
result.fontinfo -> (font, font_ascent, font_descent);
my { text, text_high, text_wide }
=
*result.textinfo;
y = case result.gravity
#
(wt::NORTH_WEST | wt::NORTH | wt::NORTH_EAST) => bw + pady;
(wt::WEST | wt::CENTER | wt::EAST) => (high - text_high) / 2;
_ => high - bw - pady - text_high;
esac
+
font_ascent;
r = xg::box::make (xg::point::zero, size);
font_high = font_ascent + font_descent;
txt_pen = xc::make_pen [ xc::p::FOREGROUND (xc::rgb8_from_rgb result.fg) ];
fun do_text (y, i)
=
if (string::get (text, i) == '\n')
#
do_text (y+font_high, i+1);
else
my (nexti, linewid)
=
get_line (font, text, i, text_wide);
x = case result.gravity
#
(wt::NORTH_WEST | wt::WEST | wt::SOUTH_WEST) => bw + result.padx;
(wt::NORTH | wt::CENTER | wt::SOUTH) => (wide - text_wide) / 2;
_ => wide - bw - padx - text_wide;
esac;
x = case result.justify
#
wt::HCENTER => x + (text_wide - linewid) / 2;
wt::HRIGHT => x + (text_wide - linewid);
wt::HLEFT => x;
esac;
fun skip_ws i
=
{ c = string::get (text, i);
if (c == '\n') i+1;
elif (char::is_space c) skip_ws (i+1);
else i;
fi;
};
xc::draw_transparent_string d txt_pen font
(xg::POINT { col=>x, row=>y }, substring (text, i, nexti-i));
do_text (y+font_high, skip_ws nexti);
fi;
fn () = { do_text (y, 0)
except
_ = ();
case result.relief
#
wg::FLAT => ();
relief => d3::draw_box d { width=>bw, relief, box=>r } result.shades;
esac;
};
};
fun get_text ( { textinfo, ... } : Result)
=
{ my { text, ... } = *textinfo;
text;
};
fun realize (root, { kidplug, window, window_size }, result, plea_slot)
=
{
d = xc::drawable_of_window window;
plea' = take_from_mailslot' plea_slot;
my xc::KIDPLUG { from_other', to_mom, ... }
=
xc::ignore_mouse_and_keyboard kidplug;
fun do_mom (xc::ETC_REDRAW _, state as (draw, _))
=>
{ draw ();
state;
};
do_mom (xc::ETC_RESIZE (xg::BOX { wide, high, ... } ), _)
=>
{ size = xg::SIZE { wide, high };
xc::clear_drawable d;
(drawf (d, size, result), size);
};
do_mom (_, state)
=>
state;
end;
fun do_plea (SET_TEXT t, (draw, size))
=>
{ ti = make_text_info (root, result.aspect, t, result.width, result.fontinfo,
result.border_thickness, result.padx, result.pady);
result -> { textinfo, ... };
textinfo := ti;
xc::clear_drawable d;
block_until_mailop_fires (to_mom xc::REQ_RESIZE);
draw = drawf (d, size, result);
draw();
(draw, size);
};
do_plea (GET_TEXT reply_1shot, state)
=>
{ put_in_oneshot (reply_1shot, get_text result);
state;
};
do_plea (GET_SIZE_CONSTRAINT reply_1shot, state)
=>
{ put_in_oneshot (reply_1shot, size_preference_thunk_of result);
state;
};
do_plea (_, state)
=>
state;
end;
fun loop state
=
do_one_mailop [
plea' ==> (fn plea = loop (do_plea (plea, state))),
from_other' ==> (fn envelope = loop (do_mom (xc::envelope_contents envelope, state)))
];
loop (drawf (d, window_size, result), window_size);
}; # fun realize
fun init (root, result as { textinfo, ... } : Result, plea_slot)
=
loop ()
where
fun do_plea (SET_TEXT t)
=>
{ ti = make_text_info (root, result.aspect, t, result.width, result.fontinfo,
result.border_thickness, result.padx, result.pady);
textinfo := ti;
};
do_plea (GET_TEXT reply_1shot) => put_in_oneshot (reply_1shot, get_text result);
do_plea (GET_SIZE_CONSTRAINT reply_1shot) => put_in_oneshot (reply_1shot, size_preference_thunk_of result);
do_plea (DO_REALIZE arg ) => realize (root, arg, result, plea_slot);
end;
fun loop ()
=
for (;;) {
do_plea (take_from_mailslot plea_slot);
};
end;
fun message (root_window, view, args)
=
{ attributes = wg::find_attribute (wg::attributes (view, attributes, args));
result = get_resources (root_window, attributes);
plea_slot = make_mailslot ();
fun size_preference_thunk_of ()
=
{ reply_1shot = make_oneshot_maildrop ();
put_in_mailslot (plea_slot, GET_SIZE_CONSTRAINT reply_1shot);
take_from_oneshot reply_1shot;
};
make_thread "message" .{
#
init (root_window, result, plea_slot);
};
MESSAGE
{
plea_slot,
widget
=>
wg::make_widget
{
#
root_window,
size_preference_thunk_of,
#
args => fn () = { background => THE result.bg },
#
realize => fn arg = put_in_mailslot (plea_slot, DO_REALIZE arg)
}
};
};
fun as_widget (MESSAGE { widget, ... } )
=
widget;
fun set_text (MESSAGE { plea_slot, ... }, v)
=
put_in_mailslot (plea_slot, SET_TEXT v);
fun get_text (MESSAGE { plea_slot, ... } )
=
{ reply_1shot = make_oneshot_maildrop ();
put_in_mailslot (plea_slot, GET_TEXT reply_1shot);
take_from_oneshot reply_1shot;
};
}; # Message
end;