X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=1a5a0d96fff0662c449c52e356200005b61b3df9;hb=65b948c4b2b72bbf86304e9e2d84e0527b69b97f;hp=2b9a19ed975e43a2053c49ee78885552b3e19bc3;hpb=3bd2b76b06df2cae29900e213924b02b46ffcd3e;p=gacela.git diff --git a/src/gacela.scm b/src/gacela.scm index 2b9a19e..1a5a0d9 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -18,7 +18,6 @@ (define-module (gacela gacela) #:use-module (gacela events) #:use-module (gacela video) - #:use-module ((gacela video) #:renamer (symbol-prefix-proc 'video:)) #:use-module (gacela audio) #:use-module (ice-9 optargs) #:export (*title* @@ -50,8 +49,7 @@ define-mob lambda-mob define-checking-mobs) - #:re-export (translate - get-frame-time + #:re-export (get-frame-time 3d-mode?)) @@ -102,27 +100,29 @@ (define (quit-gacela) (hide-all-mobs) (set! game-loop-thread #f) - (set! loop-flag #f)) + (set! loop-flag #f) + (quit-video)) (define (game-loop) (refresh-active-mobs) (init-video *width-screen* *height-screen* *bpp-screen* #:title *title* #:mode *mode* #:fps *frames-per-second*) (set! loop-flag #t) - (while loop-flag - (init-frame-time) + (let loop () + (cond (loop-flag + (init-frame-time) ; (check-connections) - (process-events) - (cond ((quit-signal?) - (quit-gacela)) - (else - (clear-screen) - (to-origin) - (refresh-active-mobs) - (run-mobs) - (draw-bricks) - (flip-screen) - (delay-frame)))) - (quit-video)) + (process-events) + (cond ((quit-signal?) + (quit-gacela)) + (else + (clear-screen) + (to-origin) + (refresh-active-mobs) + (run-mobs) + (run-extensions) + (flip-screen) + (delay-frame) + (loop))))))) (define (gacela-script args) (while loop-flag (sleep 1))) @@ -131,6 +131,26 @@ loop-flag) +;;; Extensions to main loop + +(define extensions '()) + +(define (add-extension! proc pri) + "Add an extension with a priority to the main loop" + (set! extensions + (sort (assoc-set! extensions proc pri) + (lambda (a b) + (< (cdr a) (cdr b)))))) + +(define (remove-extension! proc) + "Remove an extension from the main loop" + (set! extensions + (assoc-remove! extensions proc))) + +(define (run-extensions) + (for-each (lambda (x) ((car x))) extensions)) + + ;;; Game Properties (define *title* "Gacela") @@ -339,35 +359,6 @@ ,@body)) -;;; Bricks Factory - -(define active-bricks '()) - -(define* (draw-bricks #:optional (bricks active-bricks)) - (cond ((not (null? bricks)) - ((car bricks)) - (draw-bricks (cdr bricks))))) - -(define-macro (show-brick brick-name) - `(set! active-bricks (cons (lambda () (,brick-name)) active-bricks))) - -(define-macro (simple-brick brick-code) - (let ((name (gensym))) - `(begin - (define (,name) - ,brick-code) - (show-brick ,name) - ,name))) - - -;;; Primitive bricks - -(define-macro (draw-square . args) - `(simple-brick (apply video:draw-square ',args))) - -(re-export video:draw-square) - - (module-map (lambda (sym var) (if (not (eq? sym '%module-public-interface)) (module-export! (current-module) (list sym))))