## calculator-app.pkg
#
# One way to run this app from the base-directory commandline is:
#
# linux% my
# eval: make "src/lib/x-kit/tut/calculator/calculator-app.lib";
# eval: calculator_app::do_it ();
# Compiled by:
# src/lib/x-kit/tut/calculator/calculator-app.lib# This is a test driver for the calculator.
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package mps = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.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 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 top = hostwindow; # hostwindow is from src/lib/x-kit/widget/old/basic/hostwindow.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 cal = calculator; # calculator is from src/lib/x-kit/tut/calculator/calculator.pkg #
package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
tracefile = "calculator-app.trace.log";
tracing = logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "calculator_app::tracing", default => FALSE };
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 calculator_app {
#
write_tracelog = FALSE;
#
######## Begin mutable selfcheck globals ########
#
app_task = REF (NULL: Null_Or( Apptask ));
# selfcheck_thread = REF (NULL: Null_Or( Microthread ));
# accumulator_thread = REF (NULL: Null_Or( Microthread )); # Gets created in src/lib/x-kit/tut/calculator/accumulator.pkg# printer_thread = REF (NULL: Null_Or( Microthread )); # Gets created in src/lib/x-kit/tut/calculator/calculator.pkg selfcheck_tests_passed = REF 0;
selfcheck_tests_failed = REF 0;
run_selfcheck = REF FALSE;
#
######## End mutable selfcheck globals ########
# all_app_threads = [ accumulator_thread,
# printer_thread
# ];
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;
#
# apply' all_app_threads
# (\\ thread = thread := NULL);
# #
# selfcheck_thread := 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_calculator_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);
};
# Thread to exercise the app by simulating user
# mouseclicks and verifying their effects:
#
fun make_selfcheck_thread
{ hostwindow,
widgettree,
selfcheck_interface => { buttons, display_update' }
}
=
xtr::make_thread "calculator-app selfcheck" selfcheck
where
# Figure midpoint of window and also
# a small box centered on the midpoint:
#
fun midwindow window
=
{
# Get size of drawing window:
#
(xc::get_window_site window)
->
{ row, col, high, wide };
# Define midpoint of drawing window,
# and a 9x9 box enclosing it:
#
stipulate
row = high / 2;
col = wide / 2;
herein
midpoint = { row, col };
midbox = { row => row - 4, col => col - 4, high => 9, wide => 9 };
end;
(midpoint, midbox);
};
# Figure points just outside and inside window:
#
fun bordering_points window
=
{
# Get size of drawing window:
#
(xc::get_window_site window)
->
{ row => in_row, col => in_col, ... };
stipulate
out_row = in_row - 1;
out_col = in_col - 1;
herein
inpoint = { row => in_row, col => in_col };
outpoint = { row => out_row, col => out_col };
end;
{ inpoint, outpoint };
};
# Simulate a mouseclick in center of window:
#
fun click_window window
=
{ button = xc::MOUSEBUTTON 1;
(midwindow window) -> ( midpoint, _);
(bordering_points window) -> { inpoint, outpoint };
xc::send_fake_''mouse_enter''_xevent { window, point => inpoint };
xc::send_fake_mousebutton_press_xevent { window, button, point => midpoint };
xc::send_fake_mousebutton_release_xevent { window, button, point => midpoint };
xc::send_fake_''mouse_leave''_xevent { window, point => outpoint };
};
fun press_button button_name
=
{
case (string_map::get (buttons, button_name))
#
NULL => test_failed (); # No button by that name -- major oops.
#
THE button
=>
{ test_passed (); # We at least found the button as expected. ;-)
widget = pushbuttons::as_widget button;
window = widget::window_of widget;
click_window window;
};
esac;
};
fun selfcheck ()
=
{ # Wait until the widgettree is realized and running:
#
get_from_oneshot (wg::get_''gui_startup_complete''_oneshot_of widgettree);
# Evidently the above is not really sufficient;
# without the following sleep_for, the selfcheck
# run locks up about half the time with '0' showing
# on the calculator. Presumably some initialization
# race condition. This needs to be root-caused and XXX BUGGO FIXME
# fixed, but for now just sleeping a bit suffices
# as a workaround:
#
sleep_for 0.25;
# Set up access to the accumulator window contents:
#
from_display_mailqueue = make_mailqueue (get_current_microthread())
: Mailqueue(String);
display_update' := THE from_display_mailqueue;
fun calculator_window ()
=
{ result = take_from_mailqueue from_display_mailqueue;
result;
};
press_button "6"; assert (calculator_window() == "6");
press_button "5"; assert (calculator_window() == "65");
press_button "4"; assert (calculator_window() == "654");
press_button "+"; assert (calculator_window() == "0");
press_button "1"; assert (calculator_window() == "1");
press_button "2"; assert (calculator_window() == "12");
press_button "3"; assert (calculator_window() == "123");
press_button "="; assert (calculator_window() == "777");
# Tell calculator.pkg that we are
# done with display mailqueue:
#
display_update' := NULL; # Not really necessary, but let's be clean.
# 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_calculator_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success;
};
end; # fun make_selfcheck_thread
resources
=
[ "*background: gray" ];
fun start_up_calculator_app_threads root_window
=
{ fun quit ()
=
{ wg::delete_root_window root_window;
# shut_down_thread_scheduler winix__premicrothread::process::success;
};
style = wg::style_from_strings (root_window, resources);
name = wy::make_view
{
name => wy::style_name [],
aliases => [ wy::style_name [] ]
};
view = (name, style);
(cal::make_calculator (root_window, view, []))
->
{ widgettree, selfcheck_interface };
hostwindow_args
=
[ (wa::title, wa::STRING_VAL "calculator"),
(wa::icon_name, wa::STRING_VAL "calculator")
];
hostwindow = top::hostwindow (root_window, view, hostwindow_args) widgettree;
top::start_widgettree_running_in_hostwindow hostwindow;
if *run_selfcheck
#
make_selfcheck_thread { hostwindow, widgettree, selfcheck_interface };
#
();
fi;
();
};
fun set_up_calculator_app_task root_window
=
# Here we arrange that all the threads
# for the application run as a task "calculator 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:
#
{ calculator_app_task = (the *app_task);
#
xtr::make_thread' [ THREAD_NAME "calculator app",
THREAD_TASK calculator_app_task
]
start_up_calculator_app_threads
root_window;
();
};
fun do_it' (debug_flags, server)
=
{ xlogger::init debug_flags;
#
calculator_app_task = make_task "calculator app" [];
app_task := THE calculator_app_task;
rx::run_in_x_window_old' set_up_calculator_app_task [ rx::DISPLAY server ];
wait_for_app_task_done ();
};
fun do_it ()
=
{ if write_tracelog
#
# 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 fil::all_logging; # Gross overkill.
fi;
calculator_app_task = make_task "calculator app" [];
app_task := THE calculator_app_task;
rx::run_in_x_window_old set_up_calculator_app_task;
wait_for_app_task_done ();
};
fun main (program, server ! _) => do_it' ([], server);
main _ => do_it ();
end;
fun selfcheck ()
=
{
reset_global_mutable_state (); # Don't depend on load-time state initialization -- we might get run multiple times interactively, say.
run_selfcheck := TRUE;
do_it ();
test_stats ();
};
}; # package calc_test
end;
## COPYRIGHT (c) 1991 by AT&T Bell Laboratories. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.