## badbricks-game-app.pkg
#
# See this directory's README for a description of the game.
#
# One way to run this app from the base-directory commandline is:
#
# linux% my
# eval: make "src/lib/x-kit/tut/badbricks-game/badbricks-game-app.lib";
# eval: badbricks_game_app::do_it "";
#
# From this directory it may be run via:
#
# linux% my
# eval: make "badbricks-game-app.lib";
# eval: badbricks_game_app::do_it "";
# Compiled by:
# src/lib/x-kit/tut/badbricks-game/badbricks-game-app.libstipulate
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 f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.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 wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package dv = 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 sz = size_preference_wrapper; # size_preference_wrapper is from src/lib/x-kit/widget/old/wrapper/size-preference-wrapper.pkg package pd = pulldown_menu_button; # pulldown_menu_button is from src/lib/x-kit/widget/old/menu/pulldown-menu-button.pkg package pu = popup_menu; # popup_menu is from src/lib/x-kit/widget/old/menu/popup-menu.pkg package tw = hostwindow; # hostwindow is from src/lib/x-kit/widget/old/menu/popup-menu.pkg #
package bj = brick_junk; # brick_junk is from src/lib/x-kit/tut/badbricks-game/brick-junk.pkg package bk = brick; # brick is from src/lib/x-kit/tut/badbricks-game/brick.pkg package wl = wall; # wall is from src/lib/x-kit/tut/badbricks-game/wall.pkg #
package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
tracefile = "badbricks-game.trace.log";
tracing = logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "badbricks_game_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 badbricks_game_app
: Badbricks_Game_App # Badbricks_Game_App is from src/lib/x-kit/tut/badbricks-game/badbricks-game-app.api {
write_tracelog = FALSE;
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 fil::all_logging; # Gross overkill.
};
stipulate
selfcheck_tests_passed = REF 0;
selfcheck_tests_failed = REF 0;
herein
run_selfcheck = REF FALSE;
app_task = REF (NULL: Null_Or( Apptask ));
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_badbricks_game_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;
x_size = 10;
y_size = 30;
# Thread to exercise the app by simulating user
# mouseclicks and verifying their effects:
#
fun make_selfcheck_thread
{
hostwindow,
widgettree,
xsession,
wall
}
=
xtr::make_thread "badbricks-game-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);
};
# Convert coordinate from from
# scale-independent 0.0 -> 1.0 space
# coordinates to X pixel space:
#
fun convert_coordinate_from_abstract_to_pixel_space (window, x, y)
=
{
# Get size of window:
#
(xc::get_window_site window)
->
{ row, col, high, wide };
{ col => f8b::round (f8b::from_int wide * x),
row => f8b::round (f8b::from_int high * y)
};
};
# # Simulate a mouseclick in window.
# # The (x,y) coordinates are in an
# # abstract space in which window
# # width and height both run 0.0 -> 1.0
# #
# fun click_in_window_at (window, x, y, dx, dy)
# =
# { button = xc::MOUSEBUTTON 1;
#
# point1 = convert_coordinate_from_abstract_to_pixel_space (window, x, y);
# point1 -> { row, col };
# point2 = { row => row+dx, col=>col+dy };
#
# xc::send_fake_mousebutton_press_xevent { window, button, point => point1 };
# sleep_for 0.1;
# xc::send_fake_mousebutton_release_xevent { window, button, point => point2 };
# };
fun click_random_brick ()
=
{
brick = wall::get_random_brick wall;
good = bk::is_good brick;
# shown = bk::is_shown brick;
# state = bk::state_of brick;
widget = bk::as_widget brick;
window = wg::window_of widget;
if (not good)
#
xc::send_fake_mousebutton_press_xevent
{ window,
button => xc::MOUSEBUTTON 1,
point => { row => 1, col => 1 }
};
#
sleep_for 0.05; # X seems to dislike events which come too quickly.
xc::send_fake_mousebutton_release_xevent
{ window,
button => xc::MOUSEBUTTON 1,
point => { row => 1, col => 1 }
};
sleep_for 0.05;
fi;
# This locks us up, I dunno why: XXX BUGGO FIXME
# (I also dunno why the red bricks don't draw first time around.
# The colormixer has a similar problem.)
# (xc::get_window_site window)
# ->
# { row, col, high, wide };
};
fun selfcheck' ()
=
{
# Wait until the widgettree is realized and running:
#
get_from_oneshot (wg::get_''gui_startup_complete''_oneshot_of widgettree); # This idea doesn't seem to be working at present anyhow.
sleep_for 2.0;
window = wg::window_of widgettree;
for (i = 0; i < 10; ++i) {
#
click_random_brick();
};
# Fetch from X server the center pixels
# over which we are about to draw:
#
(midwindow window) -> (_, window_midbox);
#
# antedraw_window_image
# =
# xc::make_clientside_pixmap_from_window (window_midbox, window);
# Re-fetch center pixels, verify
# that new result differs from original result.
#
# This is dreadfully sloppy, but seems to be
# good enough to verify that there is something
# happening in the window:
#
# postdraw_window_image
# =
# xc::make_clientside_pixmap_from_window (window_midbox, window);
#
# assert (not (xc::same_cs_pixmap (antedraw_window_image, postdraw_window_image)));
sleep_for 2.0; # Just to let the user watch it.
# All done -- shut everything down:
#
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_badbricks_game_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success; # We did this prior to 6.3
();
};
end; # fun make_selfcheck_thread
fun bad_bricks (xdisplay, xauthentication)
=
for (;;) {
#
(block_until_mailop_fires game_menu_mailop) ();
}
where
root_window = wg::make_root_window (xdisplay, xauthentication);
screen = wg::screen_of root_window;
xsession = xc::xsession_of_screen screen;
wall = wl::make_wall root_window (x_size, y_size);
# fun clean_heap () = system::unsafe::mythryl_callable_c_library_interface::gc 2;
fun quit_game ()
=
{
wg::delete_root_window root_window;
sleep_for 0.2; # In the hope previous call will complete. Need something cleaner here. XXX SUCKO FIXME.
kill_badbricks_game_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success; # We did this prior to 6.3
};
fun do_short_range ()
=
{
wl::set_range (wall, bj::SHORT);
};
fun do_long_range ()
=
{
if (bj::cmp_difficulty (wl::difficulty_of wall, bj::HARD) > 0)
#
wl::set_range (wall, bj::LONG);
fi;
};
fun do_game difficulty
=
{
wl::start_game (wall, difficulty);
# if d > Hard then activate sensor_menu
();
};
fun game_menu ()
=
{ fun make_item difficulty
=
{
pu::POPUP_MENU_ITEM (bj::difficulty_name difficulty, \\ () = do_game difficulty);
};
# pu::POPUP_MENU((map make_item bj::difficulty_list) @ [POPUP_MENU_ITEM("CLEANING", do_gc), POPUP_MENU_ITEM("Quit", quit_game)]) ;
pu::POPUP_MENU ( (map make_item bj::difficulty_list)
@
[pu::POPUP_MENU_ITEM ("Quit", quit_game)]
);
};
fun sensor_menu ()
=
{
pu::POPUP_MENU [
pu::POPUP_MENU_ITEM("Short range", do_short_range),
pu::POPUP_MENU_ITEM("Long range", do_long_range)
];
};
my (game_menu_button, game_menu_mailop)
=
pd::make_pulldown_menu_button
#
root_window
#
("Game", game_menu());
layout
=
low::make_line_of_widgets root_window
(low::VT_CENTER
[
low::HZ_TOP
[
low::WIDGET (sz::make_tight_size_preference_wrapper game_menu_button),
low::SPACER { min_size=>0, best_size=>0, max_size=>NULL }
],
low::WIDGET (dv::make_horizontal_divider root_window { color=>NULL, width=>1 } ),
low::WIDGET (wl::as_widget wall)
]
);
hostwindow
=
tw::make_hostwindow
( low::as_widget layout,
NULL,
{ window_name => THE "Bad Bricks",
icon_name => THE "Bad Bricks"
}
);
tw::start_widgettree_running_in_hostwindow hostwindow;
wl::start_game (wall, bj::NORMAL);
if *run_selfcheck
#
make_selfcheck_thread
{
hostwindow,
widgettree => low::as_widget layout,
xsession,
wall
};
();
fi;
end;
fun start_up_badbricks_game_app_threads display_name
=
{ display_name' = case display_name "" => NULL;
_ => THE display_name;
esac;
(xc::get_xdisplay_string_and_xauthentication display_name')
->
( xdisplay, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xc::Xauthentication) # Typically from ~/.Xauthority
);
xlogger::make_thread "bad_bricks" {. bad_bricks (xdisplay, xauthentication); };
();
};
fun set_up_badbricks_game_app_task display_name
=
# Here we arrange that all the threads
# for the application run as a task "badbricks game 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:
#
{
badbricks_game_app_task = make_task "badbricks game app" [];
app_task := THE badbricks_game_app_task;
#
xtr::make_thread' [ THREAD_NAME "badbricks game app",
THREAD_TASK badbricks_game_app_task
]
start_up_badbricks_game_app_threads
display_name;
();
};
fun do_it' (flgs, display_name)
=
{ xlogger::init flgs;
#
if write_tracelog set_up_tracing (); fi;
set_up_badbricks_game_app_task display_name;
wait_for_app_task_done ();
winix__premicrothread::process::success;
};
fun do_it s
=
do_it' ([], s);
fun main (program, "-display" ! 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 bad_bricks_game_app
end;
## COPYRIGHT (c) 1996 AT&T Research.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.