From 739e884086c71d990d35939d2006a5b04c39fefb Mon Sep 17 00:00:00 2001 From: jsancho Date: Thu, 22 Dec 2011 06:42:44 +0000 Subject: [PATCH] Gacela as Guile modules: main loop in a thread --- src/gacela.scm | 167 +++++++++++++------------- src/{gacela_server.scm => server.scm} | 6 + src/video.scm | 36 +++--- 3 files changed, 107 insertions(+), 102 deletions(-) rename src/{gacela_server.scm => server.scm} (96%) diff --git a/src/gacela.scm b/src/gacela.scm index d5a7c6e..d6515ec 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -21,7 +21,13 @@ #:use-module (gacela audio) #:use-module (ice-9 optargs) #:export (load-texture - load-font) + load-font + init-gacela + quit-gacela + game-loop + game-running? + set-game-code) + #:export-syntax (game) #:re-export (get-current-color set-current-color with-color @@ -39,9 +45,7 @@ add-light set-camera camera-look - render-text - init-video - quit-video)) + render-text)) ;;; Default values for Gacela @@ -58,17 +62,11 @@ (define resources-cache (make-weak-value-hash-table)) -(define from-cache #f) -(define into-cache #f) +(define (from-cache key) + (hash-ref resources-cache key)) -(let () - (set! from-cache - (lambda (key) - (hash-ref resources-cache key))) - - (set! into-cache - (lambda (key res) - (hash-set! resources-cache key res)))) +(define (into-cache key res) + (hash-set! resources-cache key res)) (define-macro (use-cache-with module proc) (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache"))))) @@ -88,84 +86,85 @@ (use-cache-with (gacela video) load-font) -;;; GaCeLa Functions +;;; Game Properties (define set-game-properties! #f) (define get-game-properties #f) -(let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*)) - (set! set-game-properties! - (lambda* (#:key title width height bpp fps mode) -; (init-video-mode) - (if title - (begin - (set! ptitle title) - (if (video-mode-on?) (SDL_WM_SetCaption title "")))) - (if (or width height bpp) - (begin - (if width (set! pwidth width)) - (if height (set! pheight height)) - (if bpp (set! pbpp bpp)) - (if (video-mode-on?) (resize-screen pwidth pheight pbpp)))) - (if fps - (begin - (set! pfps fps) - (set-frames-per-second fps))) - (if mode - (begin - (set! pmode mode) - (if (video-mode-on?) - (if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))) - (get-game-properties))) - - (set! get-game-properties - (lambda () - `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode))))) - - -(define-macro (run-game . code) +;; (let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*)) +;; (set! set-game-properties! +;; (lambda* (#:key title width height bpp fps mode) +;; ; (init-video-mode) +;; (if title +;; (begin +;; (set! ptitle title) +;; (if (video-mode-on?) (SDL_WM_SetCaption title "")))) +;; (if (or width height bpp) +;; (begin +;; (if width (set! pwidth width)) +;; (if height (set! pheight height)) +;; (if bpp (set! pbpp bpp)) +;; (if (video-mode-on?) (resize-screen pwidth pheight pbpp)))) +;; (if fps +;; (begin +;; (set! pfps fps) +;; (set-frames-per-second fps))) +;; (if mode +;; (begin +;; (set! pmode mode) +;; (if (video-mode-on?) +;; (if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))) +;; (get-game-properties))) + +;; (set! get-game-properties +;; (lambda () +;; `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode))))) + + +;;; Main Loop + +(define loop-flag #f) +(define game-code #f) + +(define-macro (game . code) `(let ((game-function ,(if (null? code) `(lambda () #f) `(lambda () ,@code)))) - (init-video-mode) (set-game-code game-function) (cond ((not (game-running?)) (game-loop))))) -(define game-loop #f) -(define game-running? #f) -(define set-game-code #f) - -(let ((running #f) (game-code #f)) - (set! game-loop - (lambda () - (refresh-active-mobs) - (set! running #t) - (quit! #f) - (do () ((quit?)) - (init-frame-time) - (check-connections) - (eval-from-clients) - (process-events) - (cond ((not (quit?)) - (cond ((video-mode-on?) - (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) - (to-origin))) - (refresh-active-mobs) - (if (procedure? game-code) - (catch #t - (lambda () (game-code)) - (lambda (key . args) #f))) - (cond ((video-mode-on?) - (run-mobs) - (SDL_GL_SwapBuffers))) - (delay-frame)))) - (set! running #f))) - - (set! game-running? - (lambda () - running)) - - (set! set-game-code - (lambda (game-function) - (set! game-code game-function)))) +(define (init-gacela) + (call-with-new-thread (lambda () (game)))) + +(define (quit-gacela) + (set! loop-flag #f)) + +(define (game-loop) +; (refresh-active-mobs) + (set! loop-flag #t) + (init-video 640 480 32) +; (quit! #f) + (while loop-flag +; (init-frame-time) +; (check-connections) + (process-events) + (cond ((not (quit?)) + (clear-screen) + (to-origin) +; (refresh-active-mobs) + (if (procedure? game-code) + (catch #t + (lambda () (game-code)) + (lambda (key . args) #f))) +; (run-mobs) + (flip-screen) +; (delay-frame)))) + ))) + (quit-video)) + +(define (game-running?) + loop-flag) + +(define (set-game-code game-function) + (set! game-code game-function)) diff --git a/src/gacela_server.scm b/src/server.scm similarity index 96% rename from src/gacela_server.scm rename to src/server.scm index 8c45b20..1e54001 100644 --- a/src/gacela_server.scm +++ b/src/server.scm @@ -15,6 +15,11 @@ ;;; along with this program. If not, see . +(define-module (gacela server) + #:use-module (ice-9 optargs) + #:export (eval-from-client)) + + (define start-server #f) (define check-connections #f) (define clean-closed-connections #f) @@ -75,6 +80,7 @@ (cond ((char-ready? rec-channel) (catch #t (lambda () + (display "leido")(newline) (let ((exp (read rec-channel))) (cond ((eof-object? exp) (close rec-channel)) diff --git a/src/video.scm b/src/video.scm index e0aa94f..9d558be 100644 --- a/src/video.scm +++ b/src/video.scm @@ -167,24 +167,24 @@ (define get-frame-time #f) (define delay-frame #f) -(let ((time 0) (time-per-frame (/ 1000.0 *frames-per-second*))) - (set! set-frames-per-second - (lambda (fps) - (set! time-per-frame (/ 1000.0 fps)))) - - (set! init-frame-time - (lambda () - (set! time (SDL_GetTicks)))) - - (set! get-frame-time - (lambda () - time)) - - (set! delay-frame - (lambda () - (let ((frame-time (- (SDL_GetTicks) time))) - (cond ((< frame-time time-per-frame) - (SDL_Delay (- time-per-frame frame-time)))))))) +;; (let ((time 0) (time-per-frame (/ 1000.0 *frames-per-second*))) +;; (set! set-frames-per-second +;; (lambda (fps) +;; (set! time-per-frame (/ 1000.0 fps)))) + +;; (set! init-frame-time +;; (lambda () +;; (set! time (SDL_GetTicks)))) + +;; (set! get-frame-time +;; (lambda () +;; time)) + +;; (set! delay-frame +;; (lambda () +;; (let ((frame-time (- (SDL_GetTicks) time))) +;; (cond ((< frame-time time-per-frame) +;; (SDL_Delay (- time-per-frame frame-time)))))))) ;;; Drawing -- 2.39.5