# scroll-viewer.pkg
#
# An ML viewer with scroll bars.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublibstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
package bdr = border; # border is from src/lib/x-kit/widget/old/wrapper/border.pkg package dvd = divider; # divider is from src/lib/x-kit/widget/old/leaf/divider.pkg package low = line_of_widgets; # line_of_widgets is from src/lib/x-kit/widget/old/layout/line-of-widgets.pkg package sb = scrollbar; # scrollbar is from src/lib/x-kit/widget/old/leaf/scrollbar.pkg package sl = widget_with_scrollbars; # widget_with_scrollbars is from src/lib/x-kit/widget/old/layout/widget-with-scrollbars.pkg package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg #
package v = ml_source_code_viewer; # ml_source_code_viewer is from src/lib/x-kit/widget/old/fancy/graphviz/text/ml-source-code-viewer.pkgherein
package scroll_viewer {
fun make_viewer
root
(view, init_loc)
=
{
is_bw = case (xc::display_class_of_screen (wg::screen_of root))
#
xc::STATIC_GRAY => TRUE;
xc::GRAY_SCALE => TRUE;
_ => FALSE;
esac;
vsb = sb::make_vertical_scrollbar root
{ color => NULL,
size => 10
};
vsb_widget # "vsb" == "vertical scroll bar".
=
bdr::as_widget
(bdr::make_border
{
color => NULL,
width => 1,
child => sb::as_widget vsb
}
);
view_wid = v::as_widget view;
fun init_sb ()
=
{ (v::view_of view)
->
{ view_start, view_ht, nlines };
r_ht = float view_ht;
r_nlines
=
nlines == 0 ?? r_ht
:: float nlines;
sb::set_scrollbar_thumb vsb
{
size => THE (r_ht / r_nlines),
top => THE (f8b::from_int view_start / r_nlines)
};
};
horizontal_scrollbar_change'
=
sb::scrollbar_change'_of vsb;
fun set_top (new_top, nlines)
=
{ v::scroll_view (view, new_top);
#
(v::view_of view)
->
{ view_start, nlines, ... };
sb::set_scrollbar_thumb vsb
{
size => NULL,
top => nlines == 0 ?? THE 0.0
:: THE (f8b::from_int view_start / float nlines)
};
};
fun smooth r
=
{ timeout' = timeout_in' 0.05;
#
(v::view_of view)
->
{ view_start, nlines, ... };
r_nlines = float nlines;
top = floor (r * float nlines);
fun do_scrollbar_change i
=
\\ mailop
=
case mailop
#
sb::SCROLL_MOVE r
=>
{ top' = floor (r * r_nlines);
#
if (top' != top) sm (i+1, top');
else sm (i, top);
fi;
};
sb::SCROLL_END r
=>
{ top' = floor (r * r_nlines);
#
v::scroll_view (view, top');
};
_ => sm (i, top);
esac
also
fun sm (0, top)
=>
do_scrollbar_change 0 (block_until_mailop_fires horizontal_scrollbar_change');
sm (7, top)
=>
{ v::scroll_view (view, top);
sm (0, top);
};
sm (i, top)
=>
do_one_mailop [
#
horizontal_scrollbar_change'
==>
do_scrollbar_change i,
timeout'
==>
{. v::scroll_view (view, top);
sm (0, top);
}
];
end;
if (top != view_start)
#
v::scroll_view (view, top);
sm (0, top);
else
sm (0, view_start);
fi;
};
fun scroller ()
=
for (;;) {
#
case (block_until_mailop_fires horizontal_scrollbar_change')
#
sb::SCROLL_UP r
=>
{ # Move selected line to top:
#
(v::view_of view)
->
{ view_start, view_ht, nlines };
set_top (view_start + floor (float view_ht * r), nlines);
};
sb::SCROLL_DOWN r
=>
{ # Move top to selected line:
#
(v::view_of view)
->
{ view_start, view_ht, nlines };
set_top (view_start - floor (float view_ht * r), nlines);
};
sb::SCROLL_START r
=>
smooth r;
sb::SCROLL_MOVE r
=>
raise exception lib_base::IMPOSSIBLE "scroller: move before start";
sb::SCROLL_END r
=>
raise exception lib_base::IMPOSSIBLE "scroller: end before start";
esac;
};
fun scroll_server ()
=
{ v::scroll_view (view, init_loc);
init_sb ();
scroller ();
};
layout = if is_bw
#
low::make_line_of_widgets root
(low::HZ_CENTER
[
low::WIDGET vsb_widget,
low::WIDGET
(dvd::make_vertical_divider root
{
color => NULL,
width => 1
}
),
low::WIDGET view_wid
]
);
else
sl::make_widget_with_scrollbars root
{
scrolled_widget => view_wid,
horizontal_scrollbar => NULL,
vertical_scrollbar
=>
THE { scrollbar => vsb_widget,
pad => 0,
left => TRUE
}
};
fi;
xtr::make_thread "scroll_viewer::scroller" scroll_server;
low::as_widget layout;
};
}; # package scroll_viewer
end;