X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=b9d13160dccac4bce3695d60fb0922e657d3393f;hb=2eee3eb546a25305d548fcb331769be84fd3a38f;hp=90e85816e0ae17f31df2b3b64142f39b3d143c5b;hpb=31270934f62a3dbaefdf717d559195016e3385d0;p=gacela.git diff --git a/src/gacela.scm b/src/gacela.scm index 90e8581..b9d1316 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -49,15 +49,15 @@ define-mob lambda-mob define-checking-mobs) - #:re-export (translate - get-frame-time + #:re-export (get-frame-time 3d-mode?)) ;;; Main Loop -(define loop-flag #f) +(define game-loop-flag #f) (define game-loop-thread #f) +(define game-loop-procedure #f) (define-macro (run-in-game-loop proc) (let ((pgl (string->symbol (string-concatenate (list (symbol->string proc) "-in-game-loop")))) @@ -87,48 +87,66 @@ (run-in-game-loop resize-screen) (define-macro (game . code) - (if (null? code) - #f - `(call-with-new-thread (lambda () ,@code)))) + `(set! game-loop-procedure + ,(if (null? code) + `#f + `(lambda (game-elements) ,@code)))) (define (init-gacela) - (hide-all-mobs) +; (hide-all-mobs) (cond ((not game-loop-thread) (set! game-loop-thread (call-with-new-thread (lambda () (cond ((not (game-running?)) (game-loop)))))))) - (while (not loop-flag)) + (while (not game-loop-flag)) #t) (define (quit-gacela) - (hide-all-mobs) +; (hide-all-mobs) (set! game-loop-thread #f) - (set! loop-flag #f)) + (set! game-loop-flag #f) + (quit-video)) (define (game-loop) - (refresh-active-mobs) +; (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) + (set! game-loop-flag #t) + (let loop ((game-elements '())) + (cond (game-loop-flag + (init-frame-time) ; (check-connections) - (process-events) - (cond ((quit-signal?) - (quit-gacela)) - (else - (clear-screen) - (to-origin) - (refresh-active-mobs) - (run-mobs) - (run-extensions) - (flip-screen) - (delay-frame)))) - (quit-video)) - -(define (gacela-script args) - (while loop-flag (sleep 1))) + (process-events) + (cond ((quit-signal?) + (quit-gacela)) + (else + (clear-screen) + (to-origin) +; (refresh-active-mobs) +; (run-mobs) +; (run-extensions) + (if game-loop-procedure + (catch #t + (lambda () (set! game-elements (game-loop-procedure game-elements))) + (lambda (key . args) #f))) + (process-game-elements game-elements) + (flip-screen) + (delay-frame) + (loop game-elements))))))) (define (game-running?) - loop-flag) + game-loop-flag) + +(define (process-game-elements elements) + (cond ((not (list? elements)) + (process-game-elements (list elements))) + (else + (draw-meshes (filter (lambda (e) (mesh? e)) elements))))) +(define (draw-meshes meshes) + (cond ((null? meshes) #t) + (else + (catch #t + (lambda () (mesh-draw (car meshes))) + (lambda (key . args) #f)) + (draw-meshes (cdr meshes))))) ;;; Extensions to main loop