Commit a2fd20bc authored by Christian Persch's avatar Christian Persch

guile: Add set-lambda!

Add a set-lambda! that takes (name, func). Use this in the games that
derive from other games, instead of having to call set-lambda again
with all the other lambdas.
parent 67c4dbad
......@@ -45,7 +45,7 @@
(make-standard-deck)
(shuffle-deck)
(add-normal-slot DECK 'stock)
(if deal-three
......@@ -82,4 +82,6 @@
(define (apply-options options)
(set! deal-three (cadar options)))
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable? dealable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -81,4 +81,6 @@
(define (apply-options options)
#f)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable? dealable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -29,5 +29,3 @@
(define (max-auto-black)
13
)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable?)
......@@ -66,4 +66,6 @@
(define (apply-options options) #f)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable? dealable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -82,4 +82,6 @@
(define (apply-options options)
(set! deal-three (cadar options)))
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable? dealable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -85,4 +85,6 @@
(define (apply-options options) #f)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -61,4 +61,6 @@
(define (apply-options options) #f)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -61,4 +61,6 @@
(define (apply-options options) #f)
(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable?)
(set-lambda! 'new-game new-game)
(set-lambda! 'get-options get-options)
(set-lambda! 'apply-options apply-options)
......@@ -54,7 +54,7 @@ struct _AisleriotGameClass
};
enum {
START_GAME_LAMBDA,
NEW_GAME_LAMBDA,
BUTTON_PRESSED_LAMBDA,
BUTTON_RELEASED_LAMBDA,
BUTTON_CLICKED_LAMBDA,
......@@ -71,6 +71,22 @@ enum {
LAST_MANDATORY_LAMBDA = TIMEOUT_LAMBDA
};
static const char lambda_names[] = {
"new-game\0"
"button-pressed\0"
"button-released\0"
"button-clicked\0"
"button-double-clicked\0"
"game-over\0"
"winning-game\0"
"hint\0"
"get-options\0"
"apply-options\0"
"timeout\0"
"droppable\0"
"dealable\0"
};
struct _AisleriotGame
{
GObject parent_instance;
......@@ -897,7 +913,7 @@ scm_set_lambda (SCM start_game_lambda,
{
AisleriotGame *game = app_game;
game->lambdas[START_GAME_LAMBDA] = start_game_lambda;
game->lambdas[NEW_GAME_LAMBDA] = start_game_lambda;
game->lambdas[BUTTON_PRESSED_LAMBDA] = pressed_lambda;
game->lambdas[BUTTON_RELEASED_LAMBDA] = released_lambda;
game->lambdas[BUTTON_CLICKED_LAMBDA] = clicked_lambda;
......@@ -932,6 +948,28 @@ scm_set_lambda (SCM start_game_lambda,
return SCM_EOL;
}
static SCM
scm_set_lambda_x (SCM symbol,
SCM lambda)
{
AisleriotGame *game = app_game;
const char *lambda_name;
int i;
lambda_name = lambda_names;
for (i = 0; i < N_LAMBDAS; ++i) {
if (scm_is_true (scm_equal_p (symbol, scm_from_locale_symbol (lambda_name)))) {
game->lambdas[i] = lambda;
return SCM_EOL;
}
lambda_name += strlen (lambda_name) + 1;
}
return scm_throw (scm_from_locale_symbol ("aisleriot-invalid-call"),
scm_list_1 (scm_from_locale_string ("Unknown lambda name in set-lambda!")));
}
static SCM
scm_myrandom (SCM range)
{
......@@ -1072,6 +1110,7 @@ cscm_init (void *data G_GNUC_UNUSED)
scm_c_define_gsubr ("set-slot-x-expansion!", 2, 0, 0,
scm_set_slot_x_expansion);
scm_c_define_gsubr ("set-lambda", 8, 0, 1, scm_set_lambda);
scm_c_define_gsubr ("set-lambda!", 2, 0, 0, scm_set_lambda_x);
scm_c_define_gsubr ("aisleriot-random", 1, 0, 0, scm_myrandom);
scm_c_define_gsubr ("click-to-move?", 0, 0, 0, scm_click_to_move_p);
scm_c_define_gsubr ("get-score", 0, 0, 0, scm_get_score);
......@@ -1095,6 +1134,7 @@ cscm_init (void *data G_GNUC_UNUSED)
"set-slot-y-expansion!",
"set-slot-x-expansion!",
"set-lambda",
"set-lambda!",
"aisleriot-random",
"click-to-move?",
"get-score",
......@@ -1793,7 +1833,7 @@ game_scm_new_game (void *user_data)
g_rand_free (game->saved_rand);
game->saved_rand = g_rand_copy (game->rand);
size = scm_call_0 (game->lambdas[START_GAME_LAMBDA]);
size = scm_call_0 (game->lambdas[NEW_GAME_LAMBDA]);
game->width = scm_to_double (SCM_CAR (size));
game->height = scm_to_double (SCM_CADR (size));
scm_remember_upto_here_1 (size);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment