## calculation-pane.pkg
#
# App widget which displays a pane showing
# the user an arithmetic problem like
#
# 25
# + 36
# ----
#
# Compiled by:
#
src/lib/x-kit/tut/arithmetic-game/arithmetic-game-app.libstipulate
include package threadkit; # threadkit is from
src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.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 dv = divider; # divider is from
src/lib/x-kit/widget/old/leaf/divider.pkg package lbl = label; # label is from
src/lib/x-kit/widget/old/leaf/label.pkg package wg = widget; # widget is from
src/lib/x-kit/widget/old/basic/widget.pkg package wt = widget_types; # widget_types is from
src/lib/x-kit/widget/old/basic/widget-types.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 ad = answer_dialog_factory; # answer_dialog_factory is from
src/lib/x-kit/tut/arithmetic-game/answer-dialog-factory.pkgherein
package calculation_pane
: Calculation_Pane # Calculation_Pan is from
src/lib/x-kit/tut/arithmetic-game/calculation-pane.api
{
Difficulty = SINGLE
| EASY | MEDIUM | HARD;
# Should we use one- two- three- or four-digit numbers for user's problem?
Math_Op = ADD
| SUBTRACT | MULTIPLY;
# What type of arithmetic problem should we ask the user to solve?
Right_Or_Wrong = RIGHT
| WRONG;
Plea_Mail = START (Difficulty, Math_Op)
| RESET
;
Calculation_Pane
=
CALCULATION_PANE
{ widget: wg::Widget,
plea_slot: Mailslot( Plea_Mail ),
right_or_wrong': Mailop( Right_Or_Wrong )
};
fun wrap_widget_to_get_window_oneshot (widget: wg::Widget) # A little wrapper for given widget which returns a window oneshot
= # which will tell us the widget's window when it is realized.
(widget', window_oneshot) #
where
window_oneshot
=
make_oneshot_maildrop (): Oneshot_Maildrop( xc::Window );
realize_widget' = wg::realize_widget widget; # wg::realize_widget is curried, so this doesn't actually
# realize 'w', but rather returns a fn which will do so.
fun realize_widget (arg as { window, ... } )
=
{ put_in_oneshot (window_oneshot, window);
#
realize_widget' arg;
};
widget' = wg::make_widget
{
root_window => wg::root_window_of widget,
#
realize_widget,
size_preference_thunk_of
=>
wg::size_preference_thunk_of widget,
# I added the following line, cribbed randomly
# from the other examples, to get this to
# compile. Apparently the 'args' element was
# added after this example was written and it
# was never updated (I checked the raw SML/NJ 110.58 source.)
# -- 2009-11-30 CrT
#
# args => \\ () = { background => NULL }
args => wg::args_fn widget # Replaced above with this, which looks more apropos. -- 2014-07-20 CrT
};
end;
fontname = "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1";
#
# "-sony-fixed-medium-r-normal--24-170-100-100-c-120-iso8859-1"
# This fn is currently unused:
#
# fun difficulty_to_string EASY => "Easy";
# difficulty_to_string MEDIUM => "Medium";
# difficulty_to_string HARD => "Hard";
# difficulty_to_string SINGLE => "Single";
# end;
fun math_op_to_string ADD => " +";
math_op_to_string SUBTRACT => " -";
math_op_to_string MULTIPLY => " x";
end;
fun math_op_to_fn ADD => multiword_int::(+);
math_op_to_fn SUBTRACT => multiword_int::(-);
math_op_to_fn MULTIPLY => multiword_int::(*);
end;
# List supported arithmetic ops
# for user problems. We use this
# list to construct a menu:
#
math_ops
=
[ (ADD, TRUE ), # TRUE == by default we do addition problems.
(SUBTRACT, FALSE), #
(MULTIPLY, FALSE) #
];
fun fix_vert widget
=
{ (wg::preferred_size widget)
->
{ high, ... };
ydim = wg::tight_preference high;
fun size_preference_fn size_preference_thunk_of
=
size_preference_thunk_of ();
sz::make_size_preference_wrapper
{
child => widget,
resize_fn => \\ _ = TRUE,
size_preference_fn
};
};
fun get_seed ()
=
{ tagged_unt::from_multiword_int
(time::to_seconds
(time::get_current_time_utc ()
) );
};
# Generate a pair of integers for
# user to add, subtract or multiply:
#
fun generate_pseudorandom_operands (random, difficulty)
=
gen
where
fun gen ()
=
{ v1 = rand::range (1, maxrange) (random());
v2 = rand::range (1, maxrange) (random());
v1 < v2 ?? (v2, v1)
:: (v1, v2);
}
where
maxrange
=
case difficulty
#
SINGLE => 9;
EASY => 99;
MEDIUM => 999;
HARD => 9999;
esac;
end;
end;
# The calculator pane is driven by two threads,
# a keyboard reader to handle keystrokes, and
# a plea thread to respond to external thread requests.
#
# This is the keystroke thread loop:
#
fun keyboard_reader
( low_keyboard_eventstream_filtering_hook', # Access to keystrokes from line of widgets. ("low" == "line of widgets").
answer_label,
reset_answer_slot
)
=
{ to_ascii
=
xc::translate_keysym_to_ascii
xc::default_keysym_to_ascii_mapping;
fun is_erase c
=
c == '\^H';
fun is_newline c
=
c == '\^M' or
c == '\^J';
fun add_digit (c, s)
=
{ s' = string::from_char c + s;
lbl::set_label answer_label (lbl::TEXT s');
s';
};
fun erase "" => "";
erase s
=>
{ s' = substring (s, 1, size s - 1);
lbl::set_label answer_label (lbl::TEXT s');
s';
};
end;
my (low_from_keyboard', _)
=
block_until_mailop_fires low_keyboard_eventstream_filtering_hook';
fun restart answer_oneshot
=
{
lbl::set_label answer_label (lbl::TEXT "");
loop "";
}
where
# Loop reading the user's answer-string
# for the current arithmetic problem:
#
fun loop s # "s" is the user's answer-string so far.
=
do_one_mailop [
take_from_mailslot' reset_answer_slot
==>
restart,
low_from_keyboard'
==>
(\\ k = loop (do_keyboard (xc::get_contents_of_envelope k, s)))
]
where
fun do_keyboard (xc::KEY_PRESS key, s)
=>
{ c = string::get_byte_as_char (to_ascii key, 0);
#
if (is_erase c)
#
erase s;
#
elif (is_newline c and size s > 0)
#
put_in_oneshot (answer_oneshot, the (int::from_string s))
except
_ = put_in_oneshot (answer_oneshot, 0);
init_loop ();
elif (char::is_digit c)
add_digit (c, s);
else
s;
fi;
}
except
_ = s;
do_keyboard (_, s)
=>
{
s;
};
end;
end;
end # fun restart
also
fun init_loop ()
=
do_one_mailop [
take_from_mailslot' reset_answer_slot
==>
restart,
low_from_keyboard'
==>
(\\ _ = { print "calc.pkg: init_loop: Ignoring keyboard input"; init_loop (); })
];
init_loop ();
();
}; # fun keyboard_reader
# The calculator pane is driven by two threads,
# a keyboard reader to handle keystrokes, and
# a plea thread to respond to external thread requests.
#
# This is the plea thread. It has two modes,
# represented by separate recursive loops:
#
# o One used between games.
# o One used during a game.
#
fun make_calculation_pane (root_window: wg::Root_Window, null_or_correct_answer_slot)
=
{ plea_slot = make_mailslot (); # The main application uses this to start games and reset us.
right_or_wrong_slot = make_mailslot (); # We use this to tell the main application whether user answer was right or wrong.
reset_answer_slot = make_mailslot (); # Our plea thread uses this to reset our keyboard reader thread.
seed = get_seed ();
random = rand::make_random seed;
answer_dialog_factory
=
ad::make_answer_dialog_factory (root_window, fontname);
operand1_label # This displays the first of the two numbers the user is to add/subtract/multiply.
=
lbl::make_label root_window
{
align => wt::HRIGHT,
font => THE fontname,
label => "",
#
foreground => NULL,
background => NULL
};
operand2_label # This displays the second of the two numbers the user is to add/subtract/multiply.
=
lbl::make_label root_window
{
align => wt::HRIGHT,
font => THE fontname,
label => "",
#
foreground => NULL,
background => NULL
};
math_op_label # This tells the user whether to add, subtract or multiply.
=
lbl::make_label root_window
{
align => wt::HRIGHT,
font => THE fontname,
label => " ",
#
foreground => NULL,
background => NULL
};
answer_label # As the user types an answer, we display it in this label.
=
lbl::make_label root_window
{
align => wt::HRIGHT,
font => THE fontname,
label => "",
#
foreground => NULL,
background => NULL
};
pane_layout
=
low::make_line_of_widgets root_window
(low::HZ_CENTER
[
low::SPACER { min_size=>10, best_size=>10, max_size=>THE 20 },
low::VT_CENTER
[
low::WIDGET (fix_vert (lbl::as_widget operand1_label)),
low::HZ_CENTER
[
low::WIDGET (sz::make_tight_size_preference_wrapper (lbl::as_widget math_op_label)),
low::WIDGET (fix_vert (lbl::as_widget operand2_label))
],
low::WIDGET (dv::make_horizontal_divider root_window { color=>NULL, width=>2 } ),
low::WIDGET (fix_vert (lbl::as_widget answer_label))
],
low::SPACER { min_size=>10, best_size=>10, max_size=>THE 20 }
]
);
# Grab control of the keystroke eventstream for the layout:
#
(wg::filter_keyboard (low::as_widget pane_layout))
->
(pane_layout, low_keyboard_eventstream_filtering_hook');
(wrap_widget_to_get_window_oneshot pane_layout)
->
(pane_layout, layout_pane_window_oneshot); # Once pane_layout is realized we can get its window from layout_pane_window_oneshot.
fun reset_answer user_answer_oneshot
=
put_in_mailslot (reset_answer_slot, user_answer_oneshot);
fun close_any_open_answer_dialog (THE close_answer_dialog_oneshot)
=>
put_in_oneshot (close_answer_dialog_oneshot, ());
close_any_open_answer_dialog NULL
=>
();
end;
debug_tracing = ad::debug_tracing;
log_if = logger::log_if;
fun start_game (difficulty, math_op)
=
game_round_loop ()
where
generate_pseudorandom_operands = generate_pseudorandom_operands (random, difficulty);
arithmetic_fn = math_op_to_fn math_op;
op_string = math_op_to_string math_op;
fun do_plea (START difficulty) => start_game difficulty;
do_plea RESET => pregame_loop NULL;
end;
# Loop executing game rounds.
#
# Each round consists of generating
# a random arithmetic problem, reading
# the user answer, comparing to the correct
# answer, and giving appropriate feedback:
#
fun game_round_loop ()
=
{ (generate_pseudorandom_operands ())
->
(operand1, operand2);
user_answer_oneshot = make_oneshot_maildrop ();
correct_answer = multiword_int::to_int (arithmetic_fn (multiword_int::from_int operand1, multiword_int::from_int operand2));
# Selfcheck suppport:
#
case null_or_correct_answer_slot
#
THE slot => put_in_mailslot (slot, correct_answer);
NULL => ();
esac;
fun check_user_answer user_answer
=
if (user_answer == correct_answer)
#
put_in_mailslot (right_or_wrong_slot, RIGHT);
game_round_loop ();
else
layout_pane_window = get_from_oneshot layout_pane_window_oneshot;
log_if debug_tracing 0 {. "game_round_loop show answer"; };
close_answer_dialog_oneshot
=
ad::make_answer_dialog (answer_dialog_factory, layout_pane_window, operand1, operand2, op_string, correct_answer);
log_if debug_tracing 0 {. "answer up"; };
put_in_mailslot (right_or_wrong_slot, WRONG);
pregame_loop (THE close_answer_dialog_oneshot);
fi;
lbl::set_label operand1_label (lbl::TEXT (int::to_string operand1));
lbl::set_label operand2_label (lbl::TEXT (int::to_string operand2));
reset_answer user_answer_oneshot;
do_one_mailop [
take_from_mailslot' plea_slot ==> do_plea,
get_from_oneshot' user_answer_oneshot ==> check_user_answer
];
};
lbl::set_label math_op_label (lbl::TEXT op_string);
end # fun start_game
also
fun pregame_loop null_or_close_answer_dialog_oneshot
=
{ fun plea_loop ()
=
case (take_from_mailslot plea_slot)
#
START d
=>
{ log_if debug_tracing 0 {. "close_correct_answer_window_if_any"; };
close_any_open_answer_dialog null_or_close_answer_dialog_oneshot;
start_game d;
};
RESET
=>
plea_loop ();
esac;
lbl::set_label operand1_label (lbl::TEXT "");
lbl::set_label operand2_label (lbl::TEXT "");
lbl::set_label answer_label (lbl::TEXT "");
plea_loop ();
};
# logger::enable ad::debug_tracing;
make_thread "calc-pane kbd thread" {.
#
keyboard_reader (low_keyboard_eventstream_filtering_hook', answer_label, reset_answer_slot);
};
make_thread "calc-pane plea thread" {.
#
pregame_loop NULL;
};
CALCULATION_PANE
{
plea_slot,
widget => pane_layout,
right_or_wrong' => take_from_mailslot' right_or_wrong_slot
};
}; # fun make_calculation_pane
fun start_game (CALCULATION_PANE { plea_slot, ... }) d
=
put_in_mailslot (plea_slot, START d);
fun reset (CALCULATION_PANE { plea_slot, ... } )
=
put_in_mailslot (plea_slot, RESET);
fun as_widget (CALCULATION_PANE { widget, ... } )
=
widget;
fun right_or_wrong'_of (CALCULATION_PANE { right_or_wrong', ... } )
=
right_or_wrong';
}; # package calc
end;