## scrollable-string-editor.pkg
#
# String edit widget with arrow buttons for scrolling.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "You are what you read."
###
### -- Bert Schoenfeld
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package mr = xevent_mail_router; # xevent_mail_router is from src/lib/x-kit/widget/old/basic/xevent-mail-router.pkg package pb = pushbuttons; # pushbuttons is from src/lib/x-kit/widget/old/leaf/pushbuttons.pkg package se = string_editor; # string_editor is from src/lib/x-kit/widget/old/text/string-editor.pkg package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package g2d= geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkgherein
package scrollable_string_editor
: (weak) Scrollable_String_Editor # Scrollable_String_Editor is from src/lib/x-kit/widget/old/text/scrollable-string-editor.api {
Scrollable_String_Editor
=
SCROLLABLE_STRING_EDITOR
( wg::Widget,
(Void -> String),
(String -> Void)
);
fun make_scrollable_string_editor root_window (arg as { foreground, background, initial_string, min_length } ) # Invoked only in (unmaintained) package src/lib/x-kit/demo/tactic-tree/src/manager-g.pkg =
{ screen = wg::screen_of root_window;
#
stredit = se::make_string_editor root_window arg;
cwidget = se::as_widget stredit;
cbnds = wg::size_preference_thunk_of cwidget;
c_realize = wg::realize_widget cwidget;
(cbnds ()) -> { row_preference, ... };
naty = wg::preferred_length row_preference;
shift = se::shift_window stredit;
lefta = pb::make_arrow_pushbutton root_window { direction=>pb::ARROW_LEFT, size=>naty, foreground, background };
leftw = pb::as_widget lefta;
lbnds = wg::size_preference_thunk_of leftw;
l_realize = wg::realize_widget leftw;
leftevt = pb::button_transition'_of lefta;
righta = pb::make_arrow_pushbutton root_window { direction=>pb::ARROW_RIGHT, size=>naty, foreground, background };
rightw = pb::as_widget righta;
rbnds = wg::size_preference_thunk_of rightw;
r_realize = wg::realize_widget rightw;
rightevt = pb::button_transition'_of righta;
fun sizer ()
=
{ (cbnds ()) -> { col_preference, row_preference };
wg::make_tight_size_preference
( (wg::preferred_length col_preference) + 4,
(wg::preferred_length row_preference)
);
};
fun wont_fit ({ wide, ... }: g2d::Size)
=
{ (cbnds ()) -> { col_preference, ... };
#
wg::preferred_length col_preference > wide;
};
fun layout (size as { wide, high } )
=
{ (cbnds ()) -> { col_preference, ... };
(lbnds ()) -> { col_preference=>ldim, ... };
(rbnds ()) -> { col_preference=>rdim, ... };
lx = wg::preferred_length ldim;
rx = wg::preferred_length rdim;
if (wg::preferred_length col_preference <= wide)
#
(
FALSE,
{ col=>0, row=>0, wide=>lx, high },
{ col=>0, row=>0, wide, high },
{ col=>wide-rx, row=>0, wide=>rx, high }
);
else
( TRUE,
{ col=>0, row=>0, wide=>lx, high },
{ col=>lx, row=>0, wide=>int::max (1, wide-lx-rx), high },
{ col=>wide-rx, row=>0, wide=>rx, high }
);
fi;
};
fun listener mailop action
=
{ timeout' = timeout_in' 0.05;
#
fun down_loop ()
=
{ block_until_mailop_fires timeout';
#
case (block_until_mailop_fires mailop)
#
pb::BUTTON_DOWN _
=>
{ action ();
down_loop ();
};
_ => ();
esac;
};
fun loop ()
=
loop { block_until_mailop_fires mailop;
action ();
down_loop ();
};
loop ();
};
pr = \\ _ = ();
fun realize_widget { kidplug, window, window_size }
=
{ (layout window_size)
->
lo as (active, lrect, crect, rrect);
lwin = wg::make_child_window (window, lrect, wg::args_of leftw);
cwin = wg::make_child_window (window, crect, wg::args_of cwidget);
rwin = wg::make_child_window (window, rrect, wg::args_of rightw);
(xc::make_widget_cable ()) -> { kidplug => lkidplug, momplug => lmomplug as xc::MOMPLUG { from_kid'=>lco, ... } };
(xc::make_widget_cable ()) -> { kidplug => ckidplug, momplug => cmomplug as xc::MOMPLUG { from_kid'=>cco, ... } };
(xc::make_widget_cable ()) -> { kidplug => rkidplug, momplug => rmomplug as xc::MOMPLUG { from_kid'=>rco, ... } };
(xc::make_widget_cable ())
->
{ kidplug => my_kidplug,
momplug => my_momplug
};
my_kidplug
->
xc::KIDPLUG { from_other' => myci,
from_mouse' => mym,
from_keyboard' => myk,
...
};
router = mr::make_xevent_mail_router (kidplug, my_momplug, []);
childco = wg::wrap_queue cco;
fun do_layout ((a, lr, cr, rr), (a', lr', cr', rr'))
=
{ if (a' != a)
#
if a'
xc::show_window lwin;
xc::show_window rwin;
else
xc::hide_window lwin;
xc::hide_window rwin;
fi;
fi;
if (lr' != lr) xc::move_and_resize_window lwin lr'; fi;
if (cr' != cr) pr "resize stredit\n"; xc::move_and_resize_window cwin cr'; fi;
if (rr' != rr) xc::move_and_resize_window rwin rr'; fi;
};
fun main window_size lo
=
loop lo
where
fun loop lo
=
loop (
do_one_mailop [
myci ==> {. do_mom (xc::get_contents_of_envelope #mailop, lo); },
myk ==> {. do_keyboard (xc::get_contents_of_envelope #mailop, lo); },
mym ==> {. do_mouse (xc::get_contents_of_envelope #mailop, lo); },
childco ==> {. handle_c (#mailop, lo); },
lco ==> (\\ _ = lo),
rco ==> (\\ _ = lo)
]
)
where
fun do_mom (xc::ETC_RESIZE ({ col, row, wide, high } ), lo)
=>
{ window_size' = { wide, high };
lo' = layout window_size';
do_layout (lo, lo');
main window_size' lo';
};
do_mom (_, lo)
=>
lo;
end;
fun handle_c (xc::REQ_RESIZE, lo as (a, _, _, _))
=>
{ pr "resize plea\n";
a' = wont_fit window_size;
if (a == a' )
#
lo;
else
lo' = layout window_size;
pr "newlayout\n";
do_layout (lo, lo');
lo';
fi;
};
handle_c (xc::REQ_DESTRUCTION, lo)
=>
lo;
end;
fun do_keyboard ((xc::KEY_PRESS _), lo)
=>
{ (fil::print " [field-edit received KEY_PRESS]\n"); lo; };
do_keyboard ((_), lo)
=>
lo;
end;
fun do_mouse ((xc::MOUSE_ENTER _), lo)
=>
{ a = xc::grab_keyboard cwin;
#
# (fil::print (" [field-edit received xc::MOUSE_ENTER: "$(int::to_string (a))$"]\n"))
lo;
};
do_mouse ((_), lo)
=>
lo;
end;
end;
end;
mr::add_child router (lwin, lmomplug);
mr::add_child router (cwin, cmomplug);
mr::add_child router (rwin, rmomplug);
make_thread "scrollable_string_editor left" {. listener leftevt {. shift -1; }; };
make_thread "scrollable_string_editor right" {. listener rightevt {. shift 1; }; };
make_thread "scrollable_string_editor" {.
#
main window_size (active, lrect, crect, rrect);
();
};
l_realize { kidplug=>lkidplug, window=>lwin, window_size=>g2d::box::size lrect };
c_realize { kidplug=>ckidplug, window=>cwin, window_size=>g2d::box::size crect };
r_realize { kidplug=>rkidplug, window=>rwin, window_size=>g2d::box::size rrect };
if active
#
xc::show_window lwin;
xc::show_window rwin;
fi;
xc::show_window cwin;
};
SCROLLABLE_STRING_EDITOR
(
wg::make_widget
{
root_window,
args=> \\ () = { background => NULL },
size_preference_thunk_of => sizer,
realize_widget
},
\\ () = se::get_string stredit,
se::set_string stredit
);
};
fun as_widget (SCROLLABLE_STRING_EDITOR (w, _, _)) = w;
fun get_string (SCROLLABLE_STRING_EDITOR (w, g, _)) = g ();
fun set_string (SCROLLABLE_STRING_EDITOR (_, _, s)) = s;
}; # scrollable_string_editor
end;