From 364a8728f17c1ab5c37486685cf3b848eee178c6 Mon Sep 17 00:00:00 2001 From: jsancho Date: Tue, 31 May 2011 17:12:59 +0000 Subject: [PATCH] --- src/gacela_mobs.scm | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm index 09e296a..c0037f1 100755 --- a/src/gacela_mobs.scm +++ b/src/gacela_mobs.scm @@ -17,12 +17,16 @@ (use-modules (srfi srfi-1)) +;;; Actions for mobs + + + ;;; Mob Factory (define-macro (makemob name . methods) `(define* (,name . args) (let ((option (car args))) - ,(union + ,(lset-union eq? `(case option (:on (mob-on ',name)) (:off (mob-off ',name))) @@ -32,6 +36,20 @@ (else (cons (list option `(apply ,body (cdr args))) (options (cddr m))))))) (options methods))))) +(define-macro (makemob name . methods) + (define (options m) + (cond ((null? m) '((else #f))) + (else + (let ((option (caar m)) (body (cadar m))) + (cons `((,option) (apply ,body (cdr args))) (options (cdr m))))))) + (let ((m (options methods))) + `(define (,name . args) + (let ((option (car args))) + (case option + ((#:on) (mob-on ',name)) + ((#:off) (mob-off ',name)) + ,@m))))) + (define mob-on #f) (define run-mobs #f) @@ -51,7 +69,8 @@ (else (cond (function (function))) (catch #t (lambda () (apply (car mobs) (cons option args))) (lambda (key . args) #f)) - (or #t (run-mobs-rec (cdr mobs)))))))) + (or #t (run-mobs-rec (cdr mobs)))))) + (run-mobs-rec running-mobs))) (set! mob-off (lambda (mob) @@ -61,7 +80,7 @@ (lambda () (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null? mob)) (push mob running-mobs) - (secure-block nil (mob #:init))) + (catch #t (lambda () (mob #:init)) (lambda (key . args) #f))) (set! running-mobs (reverse (lset-difference eq? running-mobs mobs-to-quit))) (set! mobs-to-quit '()))) -- 2.39.2