## colormixer-app.pkg
#
# One way to run this app from the base-directory commandline is:
#
# linux% my
# eval: make "src/lib/x-kit/tut/colormixer/colormixer-app.lib";
# eval: colormixer_app::do_it ();
# Compiled by:
# src/lib/x-kit/tut/colormixer/colormixer-app.libstipulate
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 fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package bdr = border; # border is from src/lib/x-kit/widget/old/wrapper/border.pkg package sld = slider; # slider is from src/lib/x-kit/widget/old/leaf/slider.pkg package lbl = label; # label is from src/lib/x-kit/widget/old/leaf/label.pkg package top = hostwindow; # hostwindow is from src/lib/x-kit/widget/old/basic/hostwindow.pkg package rw = root_window_old; # root_window_old is from src/lib/x-kit/widget/old/basic/root-window-old.pkg package rx = run_in_x_window_old; # run_in_x_window_old is from src/lib/x-kit/widget/old/lib/run-in-x-window-old.pkg package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package wa = widget_attribute_old; # widget_attribute_old is from src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg package wy = widget_style_old; # widget_style_old is from src/lib/x-kit/widget/old/lib/widget-style-old.pkg #
package cs = color_state;
package low = line_of_widgets; # line_of_widgets is from src/lib/x-kit/widget/old/layout/line-of-widgets.pkg package sz = size_preference_wrapper; # size_preference_wrapper is from src/lib/x-kit/widget/old/wrapper/size-preference-wrapper.pkg package tgl = toggleswitches; # toggleswitches is from src/lib/x-kit/widget/old/leaf/toggleswitches.pkg package ts = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg #
package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
tracefile = "colormixer-app.trace.log";
tracing = logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "mixer_app::tracing", default => TRUE };
trace = xtr::log_if tracing 0; # Conditionally write strings to tracing.log or whatever.
#
# To debug via tracelogging, annotate the code with lines like
#
# trace {. sprintf "foo/top: bar d=%d" bar; };
#
# and then set write_tracelog = TRUE; below.
herein
package colormixer_app: api {
do_it': (List( String ), String) -> Void;
do_it: Void -> Void;
main: (List(String), X) -> Void;
selfcheck: Void -> { passed: Int,
failed: Int
};
}{
write_tracelog = TRUE;
app_task = REF (NULL: Null_Or( Apptask ));
run_selfcheck = REF FALSE;
stipulate
selfcheck_tests_passed = REF 0;
selfcheck_tests_failed = REF 0;
herein
fun reset_global_mutable_state () # Reset above state variables to load-time values.
= # This will be needed if (say) we get run multiple times interactively without being reloaded.
{ run_selfcheck := FALSE;
#
app_task := NULL;
#
selfcheck_tests_passed := 0;
selfcheck_tests_failed := 0;
};
fun test_passed () = selfcheck_tests_passed := *selfcheck_tests_passed + 1;
fun test_failed () = selfcheck_tests_failed := *selfcheck_tests_failed + 1;
#
fun assert bool = if bool test_passed ();
else test_failed ();
fi;
#
fun test_stats ()
=
{ passed => *selfcheck_tests_passed,
failed => *selfcheck_tests_failed
};
fun kill_colormixer_app ()
=
{
kill_task { success => TRUE, task => (the *app_task) };
};
fun wait_for_app_task_done ()
=
{
task = the *app_task;
#
task_finished' = task_done__mailop task;
block_until_mailop_fires task_finished';
assert (get_task's_state task == state::SUCCESS);
};
end;
resources = ["*background: gray"];
maxcolor = 0u65535;
midcolor = maxcolor / 0u2;
mincolor = 0u0;
border_thickness = 4;
slider_width = 20;
hue_box_dim = 25;
big_spot_height = 400;
big_spot_width = 150;
horizontal_spacer = low::SPACER { min_size=>5, best_size=>5, max_size=>THE 5 };
vertical_spacer = low::SPACER { min_size=>1, best_size=>5, max_size=>NULL };
redc = xc::rgb_from_unts (midcolor, 0u0, 0u0 );
greenc = xc::rgb_from_unts (0u0, midcolor, 0u0 );
bluec = xc::rgb_from_unts (0u0, 0u0, midcolor );
blackc = xc::rgb_from_unts (0u0, 0u0, 0u0 );
fun make_red n = xc::rgb_from_unts (n, mincolor, mincolor );
fun make_green n = xc::rgb_from_unts (mincolor, n, mincolor );
fun make_blue n = xc::rgb_from_unts (mincolor, mincolor, n );
fun make_mixer (root_window, view)
=
{ white = xc::white;
selfcheck_colorchange_watcher
=
REF (NULL: Null_Or( Mailqueue( xc::Rgb ) ));
fun quit ()
=
{ fun q ()
=
{ sleep_for 0.5;
#
rw::delete_root_window root_window;
kill_colormixer_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success;
};
make_thread "mixer" q;
();
};
switch = tgl::make_rocker_toggleswitch'
(root_window, view,[])
(\\ _ = quit ());
switch_line
=
low::HZ_CENTER
[
vertical_spacer,
low::WIDGET (tgl::as_widget switch),
horizontal_spacer
];
fun make_display_box color w
=
{ args = [ (wa::background, wa::COLOR_VAL color),
(wa::border_thickness, wa::INT_VAL border_thickness)
];
display
=
bdr::border
(root_window, view, args)
(sz::make_tight_size_preference_wrapper w);
low::HZ_CENTER
[ vertical_spacer,
low::WIDGET (bdr::as_widget display),
vertical_spacer
];
};
fun paint_spot spot color
=
spot::set_spot spot color
except
_ = { fil::print "out of color cells\n";
quit();
};
spot = spot::make_spot
(root_window, view)
{ color => blackc,
high => big_spot_height,
wide => big_spot_width
};
paint = paint_spot spot;
color_screen
=
make_display_box white (spot::as_widget spot);
colorstate = cs::make_color_state blackc;
change_color = cs::change_color colorstate;
colorchange' = cs::colorchange'_of colorstate;
fun paint_loop ()
=
for (;;) {
#
new_color = block_until_mailop_fires colorchange';
paint new_color;
#
case *selfcheck_colorchange_watcher
#
THE mailqueue
=>
put_in_mailqueue (mailqueue, new_color);
NULL => ();
esac;
};
# Construct a control row consisting of
#
# o A color patch.
# o A slider.
# o A numeric readout.
#
# The colormixer app uses one such
# control row each for red, green and blue:
#
fun make_color_control_row
rgb # One of: redc, greenc, bluec.
make_color # One of: make_red, make_green, make_blue.
mkmsg # One of: cs::CHANGE_R, cs::CHANGE_G, cs::CHANGE_B.
=
(line, printer_loop, slider) # Slider is returned only for selfcheck support.
where
(xc::rgb_to_unts rgb)
->
(red, green, blue);
rgb_color = xc::get_color (xc::CMS_RGB { red, green, blue });
l_args = [ (wa::label, wa::STRING_VAL " 0"),
(wa::background, wa::COLOR_VAL rgb_color)
];
label = lbl::make_label' (root_window, view, l_args);
display = make_display_box rgb_color (lbl::as_widget label);
s_args = [ (wa::is_vertical, wa::BOOL_VAL FALSE),
(wa::background, wa::STRING_VAL "gray"),
(wa::width, wa::INT_VAL slider_width),
(wa::from_value, wa::INT_VAL 0),
(wa::to_value, wa::INT_VAL (unt::to_int_x maxcolor))
];
slider = sld::make_slider (root_window, view, s_args);
spot = spot::make_spot
#
(root_window, view)
#
{ color => blackc,
high => hue_box_dim,
wide => hue_box_dim
};
hue_box = make_display_box white (spot::as_widget spot);
line = low::HZ_CENTER
[
horizontal_spacer,
hue_box,
horizontal_spacer,
low::WIDGET (sld::as_widget slider),
horizontal_spacer,
display,
horizontal_spacer
];
set = lbl::set_label label;
slider_motion'
=
sld::slider_motion'_of slider
==>
unt::from_int;
paint = paint_spot spot;
fun printer_loop ()
=
loop 0u0
where
# The first loop is just to
# initialize the display;
# subsequent loops respond to
# user mouse motions:
#
fun loop n
=
{ set (lbl::TEXT (unt::format number_string::DECIMAL n));
paint (make_color n);
change_color (mkmsg n);
loop (block_until_mailop_fires slider_motion');
};
end;
end;
my (red_line, red_printer_loop, red_slider) = make_color_control_row redc make_red cs::CHANGE_R;
my (green_line, green_printer_loop, green_slider) = make_color_control_row greenc make_green cs::CHANGE_G;
my (blue_line, blue_printer_loop, blue_slider) = make_color_control_row bluec make_blue cs::CHANGE_B;
make_thread "mixer red" red_printer_loop;
make_thread "mixer green" green_printer_loop;
make_thread "mixer blue" blue_printer_loop ;
make_thread "mixer painter" paint_loop;
( low::as_widget
(low::make_line_of_widgets root_window
(low::VT_CENTER
[ vertical_spacer,
color_screen, vertical_spacer,
switch_line, vertical_spacer,
red_line, vertical_spacer,
green_line, vertical_spacer,
blue_line, vertical_spacer
]
) ),
{ red_slider, green_slider, blue_slider, selfcheck_colorchange_watcher }
);
}; # fun make_mixer
# Thread to exercise the app by simulating user
# mouse-drags of the colormixer sliders and
# verifying their effects:
#
fun make_selfcheck_thread { hostwindow, widgettree, selfcheck_api => { red_slider, green_slider, blue_slider, selfcheck_colorchange_watcher } }
=
xtr::make_thread "colormixer-app selfcheck'" selfcheck'
where
# Convert a pair of 0.0 -> 1.0 window X coordinates into
# a corresponding series of pixel-coordinate points:
#
fun window_x_points (window, start, stop)
=
{
# Get size of slider window:
#
(xc::get_window_site window)
->
{ row, col, high, wide };
start_col = f8b::round ((f8b::from_int wide) * start);
stop_col = f8b::round ((f8b::from_int wide) * stop);
cols = (start_col + 1)..(stop_col - 1);
row = row + high/2;
fun col_to_point col
=
{ col, row };
( col_to_point start_col,
map col_to_point cols,
col_to_point stop_col
);
};
fun slider_window slider
=
{
trace {. "slider_window/AAA -- colormixer-app.pkg"; };
widget = slider::as_widget slider;
trace {. "slider_window/BBB -- colormixer-app.pkg"; };
#
window = widget::window_of widget;
trace {. "slider_window/ZZZ -- colormixer-app.pkg"; };
window;
};
fun slider_site slider
=
# xc::get_window_site (slider_window slider); # -> { row, col, high, wide };
{
trace {. "slider_site/AAA -- colormixer-app.pkg"; };
window = slider_window slider;
trace {. "slider_site/BBB -- colormixer-app.pkg"; };
result = xc::get_window_site window;
trace {. "slider_site/ZZZ -- colormixer-app.pkg"; };
result;
};
# Simulate a mousedrag of slider
#
fun drag_slider (slider, start, stop) # Start, stop are floats in range 0.0 -> 1.0
=
{ button = xc::MOUSEBUTTON 1;
#
window = slider_window slider;
(window_x_points (window, start, stop))
->
(start_point, midpoints, stop_point);
xc::send_fake_mousebutton_press_xevent { window, button, point => start_point };
apply drag midpoints
where
fun drag point
=
{ xc::send_fake_mouse_motion_xevent
{
window,
point,
buttons => [ button ]
};
sleep_for 0.05;
#
# Without this sleep we lose events, resulting in the below
# assert (changes == mailqueue_entries);
# failing. I'm ignoring this for now because I am assuming
# that this is due to the X server dropping events when they
# come too quickly, or possibly an issue in xkit, and for the
# moment I'm really only interested in threadkit. -- 2012-09-15 CrT
};
end;
xc::send_fake_mousebutton_release_xevent { window, button, point => stop_point };
(list::length midpoints) + 2; # Number of color changes.
};
fun selfcheck' ()
=
{
trace {. "selfcheck'/AAA -- colormixer-app.pkg"; };
# Wait until the widgettree is realized and running:
#
get_from_oneshot (wg::get_''gui_startup_complete''_oneshot_of widgettree);
trace {. "selfcheck'/BBB -- colormixer-app.pkg"; };
sleep_for 0.25; # Shouldn't be needed, but preceding doesn't eliminate race conditions as intended... :-(
trace {. "selfcheck'/CCC -- colormixer-app.pkg"; };
mailqueue = make_mailqueue (get_current_microthread()): Mailqueue( xc::Rgb );
trace {. "selfcheck'/DDD -- colormixer-app.pkg"; };
selfcheck_colorchange_watcher := THE mailqueue;
trace {. "selfcheck'/EEE1 -- colormixer-app.pkg"; };
(slider_site red_slider) -> { row => red_row, col => red_col, high => red_high, wide => red_wide };
trace {. "selfcheck'/EEE2 -- colormixer-app.pkg"; };
(slider_site green_slider) -> { row => green_row, col => green_col, high => green_high, wide => green_wide };
trace {. "selfcheck'/EEE3 -- colormixer-app.pkg"; };
(slider_site blue_slider) -> { row => blue_row, col => blue_col, high => blue_high, wide => blue_wide };
trace {. "selfcheck'/FFF -- colormixer-app.pkg"; };
changes = 0;
changes += drag_slider ( red_slider, 0.4, 0.6);
changes += drag_slider (green_slider, 0.4, 0.6);
changes += drag_slider ( blue_slider, 0.4, 0.6);
trace {. "selfcheck'/GGG -- colormixer-app.pkg"; };
mailqueue_entries = get_mailqueue_length mailqueue;
# The number of mailqueue entries we get back varies erratically depending on
# number of log::notes compiled into the code and such. I suspect this is
# an xkit or possibly xserver issue, and currently I'm really only interested
# in catching regressions in threadkit, so I'm commenting out the warning message
# in time-honored fashion here: :-) -- 2012-09-16 CrT
# if (changes != mailqueue_entries + 2) printf "colormixer_app::selfcheck': changes %d != mailqueue_entries %d +2\n" changes mailqueue_entries; fi;
# assert (changes == mailqueue_entries + 2);
#
# I have no idea where the "+ 2" is coming from above,
# but at the moment I'm only interested in exercising
# the thread-scheduler and mailops, not in debugging
# x-kit much less colormixer-app, so as long as the +2
# is consistent I'm happy. -- 2012-09-15 CrT
for (i = 0, last_red = 0, last_green = 0, last_blue = 0; i < mailqueue_entries; ++i) {
#
new_color = take_from_mailqueue mailqueue;
#
(xc::rgb_to_unts new_color) -> (red, green, blue);
#
red = unt::to_int red;
green = unt::to_int green;
blue = unt::to_int blue;
#
assert ( red >= last_red );
assert (green >= last_green);
assert ( blue >= last_blue );
#
last_red = red;
last_green = green;
last_blue = blue;
};
selfcheck_colorchange_watcher := NULL;
sleep_for 0.250;
# All done -- shut everything down:
#
(xc::xsession_of_window (wg::window_of widgettree)) -> xsession;
xc::close_xsession xsession;
sleep_for 0.2; # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.
kill_colormixer_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success;
};
end; # fun make_selfcheck_thread
fun start_up_colormixer_app_threads root_window
=
{
trace {. "start_up_colormixer_app_threads/AAA -- colormixer-app.pkg"; };
style = wg::style_from_strings (root_window, resources);
trace {. "start_up_colormixer_app_threads/BBB -- colormixer-app.pkg"; };
name = wy::make_view
{ name => wy::style_name [],
aliases => [ wy::style_name [] ]
};
trace {. "start_up_colormixer_app_threads/CCC -- colormixer-app.pkg"; };
view = (name, style);
trace {. "start_up_colormixer_app_threads/DDD -- colormixer-app.pkg"; };
(make_mixer (root_window, view))
->
(widgettree, selfcheck_api);
trace {. "start_up_colormixer_app_threads/EEE -- colormixer-app.pkg"; };
args = [ (wa::title, wa::STRING_VAL "RGB Mixer"),
(wa::icon_name, wa::STRING_VAL "MIX")
];
trace {. "start_up_colormixer_app_threads/FFF -- colormixer-app.pkg"; };
hostwindow = top::hostwindow (root_window, view, args) widgettree;
trace {. "start_up_colormixer_app_threads/GGG -- colormixer-app.pkg"; };
top::start_widgettree_running_in_hostwindow hostwindow;
trace {. "start_up_colormixer_app_threads/HHH -- colormixer-app.pkg"; };
if *run_selfcheck
#
make_selfcheck_thread { hostwindow, widgettree, selfcheck_api };
();
fi;
trace {. "start_up_colormixer_app_threads/ZZZ -- colormixer-app.pkg"; };
();
};
fun set_up_tracing ()
=
{ # Open tracelog file and select tracing level.
# We don't need to truncate any existing file
# because that is already done by the logic in
# src/lib/std/src/posix/winix-text-file-io-driver-for-posix--premicrothread.pkg #
include package logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg #
set_logger_to (fil::LOG_TO_FILE tracefile);
# enable xtr::io_logging;
# enable xtr::xsocket_to_hostwindow_router_tracing;
# enable fil::all_logging; # Gross overkill.
};
fun set_up_colormixer_app_task root_window
=
# Here we arrange that all the threads
# for the application run as a task "colormixer app",
# so that later we can shut them all down with
# a simple kill_task(). We explicitly create one
# root thread within the task; the rest then implicitly
# inherit task membership:
#
{ colormixer_app_task = (the *app_task);
#
xtr::make_thread' [ THREAD_NAME "colormixer app",
THREAD_TASK colormixer_app_task
]
start_up_colormixer_app_threads
root_window;
();
};
fun do_it' (debug_flags, server)
=
{ xlogger::init debug_flags;
#
if write_tracelog set_up_tracing (); fi;
colormixer_app_task = make_task "colormixer app" [];
app_task := THE colormixer_app_task;
rx::run_in_x_window_old' set_up_colormixer_app_task [ rx::DISPLAY server ];
wait_for_app_task_done ();
};
fun do_it ()
=
{ if write_tracelog set_up_tracing (); fi;
#
trace {. "do_it/AAA -- colormixer-app.pkg"; };
colormixer_app_task = make_task "colormixer app" [];
trace {. "do_it/BBB -- colormixer-app.pkg"; };
app_task := THE colormixer_app_task;
trace {. "do_it/CCC -- colormixer-app.pkg"; };
rx::run_in_x_window_old set_up_colormixer_app_task;
trace {. "do_it/DDD -- colormixer-app.pkg"; };
result=
wait_for_app_task_done ();
trace {. "do_it/ZZZ -- colormixer-app.pkg"; };
result;
};
fun selfcheck ()
=
{
trace {. "selfcheck/AAA -- colormixer-app.pkg"; };
reset_global_mutable_state ();
trace {. "selfcheck/BBB -- colormixer-app.pkg"; };
run_selfcheck := TRUE;
trace {. "selfcheck/CCC -- colormixer-app.pkg"; };
do_it ();
trace {. "selfcheck/DDD -- colormixer-app.pkg"; };
result =
test_stats ();
trace {. "selfcheck/ZZZ -- colormixer-app.pkg"; };
result;
};
fun main (program ! server ! _, _)
=>
do_it' ([], server);
main _
=>
do_it ();
end;
}; # package colormixer_app
end;