[aisleriot] guile: Add set-lambda!

[Christian Persch <chpe src gnome org>]

commit a2fd20bcd147af631cf2570bc6d311678b22c337
Author: Christian Persch <chpe gnome org>
Date:   Fri Dec 2 23:07:29 2011 +0100

    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.

 games/athena.scm             |    6 +++-
 games/aunt-mary.scm          |    4 ++-
 games/bakers-game.scm        |    2 -
 games/gold-mine.scm          |    4 ++-
 games/saratoga.scm           |    4 ++-
 games/spider-three-decks.scm |    4 ++-
 games/spiderette.scm         |    4 ++-
 games/will-o-the-wisp.scm    |    4 ++-
 src/game.c                   |   46 +++++++++++++++++++++++++++++++++++++++--
 9 files changed, 65 insertions(+), 13 deletions(-)
---
diff --git a/games/athena.scm b/games/athena.scm
index 0d306e1..f9ee71d 100644
--- a/games/athena.scm
+++ b/games/athena.scm
@@ -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)
diff --git a/games/aunt-mary.scm b/games/aunt-mary.scm
index f0a0425..5504f0b 100644
--- a/games/aunt-mary.scm
+++ b/games/aunt-mary.scm
@@ -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)
diff --git a/games/bakers-game.scm b/games/bakers-game.scm
index c160cc2..19f0d60 100644
--- a/games/bakers-game.scm
+++ b/games/bakers-game.scm
@@ -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?)
diff --git a/games/gold-mine.scm b/games/gold-mine.scm
index a12539f..717fdc5 100644
--- a/games/gold-mine.scm
+++ b/games/gold-mine.scm
@@ -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)
diff --git a/games/saratoga.scm b/games/saratoga.scm
index b7edac5..c8ed305 100644
--- a/games/saratoga.scm
+++ b/games/saratoga.scm
@@ -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)
diff --git a/games/spider-three-decks.scm b/games/spider-three-decks.scm
index f423451..6039a59 100644
--- a/games/spider-three-decks.scm
+++ b/games/spider-three-decks.scm
@@ -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)
diff --git a/games/spiderette.scm b/games/spiderette.scm
index 16352fe..e8a110c 100644
--- a/games/spiderette.scm
+++ b/games/spiderette.scm
@@ -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)
diff --git a/games/will-o-the-wisp.scm b/games/will-o-the-wisp.scm
index 1416f54..ed857cd 100644
--- a/games/will-o-the-wisp.scm
+++ b/games/will-o-the-wisp.scm
@@ -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)
diff --git a/src/game.c b/src/game.c
index 30b0e75..e733481 100644
--- a/src/game.c
+++ b/src/game.c
@@ -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;
@@ -933,6 +949,28 @@ scm_set_lambda (SCM start_game_lambda,
 }
 
 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)
 {
   AisleriotGame *game = app_game;
@@ -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);