X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=1a5a0d96fff0662c449c52e356200005b61b3df9;hb=65b948c4b2b72bbf86304e9e2d84e0527b69b97f;hp=6719f82aa471e93502aa21bf6af3032cf6f6859f;hpb=d93e90690ad41aae3203e93ba01cf8fa658203b3;p=gacela.git diff --git a/src/gacela.scm b/src/gacela.scm index 6719f82..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-views) - (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,33 +359,6 @@ ,@body)) -;;; Views Factory - -(define active-views (make-hash-table)) - -(define* (draw-views #:optional (views (hash-map->list (lambda (k v) v) active-views))) - (cond ((not (null? views)) - (catch #t - (lambda* () ((car views))) - (lambda (key . args) #f)) - (draw-views (cdr views))))) - -(define-macro (define-view name content) - `(begin - (hash-set! active-views ',name (lambda () (glmatrix-block ,content))) - ',name)) - - -;;; Views Primitives - -(define-macro (translate x y view-or-z . view) - (let* ((z (if (null? view) 0 view-or-z)) - (view (if (null? view) view-or-z (car view)))) - `(begin - (gltranslate ,x ,y ,z) - ,view))) - - (module-map (lambda (sym var) (if (not (eq? sym '%module-public-interface)) (module-export! (current-module) (list sym))))