From: jsancho Date: Thu, 22 Dec 2011 06:42:44 +0000 (+0000) Subject: Gacela as Guile modules: main loop in a thread X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=commitdiff_plain;h=739e884086c71d990d35939d2006a5b04c39fefb Gacela as Guile modules: main loop in a thread --- 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/gacela_server.scm deleted file mode 100644 index 8c45b20..0000000 --- a/src/gacela_server.scm +++ /dev/null @@ -1,96 +0,0 @@ -;;; Gacela, a GNU Guile extension for fast games development -;;; Copyright (C) 2009 by Javier Sancho Fernandez -;;; -;;; This program is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see . - - -(define start-server #f) -(define check-connections #f) -(define clean-closed-connections #f) -(define eval-from-clients #f) -(define stop-server #f) - -(let ((server-socket #f) (clients '()) - (server-pipes #f)) - (set! start-server - (lambda* (#:key (port #f) (pipes #f)) - (cond (port - (set! server-socket (socket PF_INET SOCK_STREAM 0)) - (setsockopt server-socket SOL_SOCKET SO_REUSEADDR 1) - (bind server-socket AF_INET INADDR_ANY port) - (listen server-socket 5)) - (pipes - (set! server-pipes pipes))) - (cond ((not (game-running?)) - (game-loop))))) - - - (set! clean-closed-connections - (lambda (conns) - (cond ((null? conns) '()) - (else - (let* ((cli (car conns)) (sock (car cli))) - (cond ((port-closed? sock) - (clean-closed-connections (cdr conns))) - (else - (cons cli (clean-closed-connections (cdr conns)))))))))) - - (set! check-connections - (lambda () - (set! clients (clean-closed-connections clients)) - (catch #t - (lambda () - (cond ((char-ready? server-socket) - (set! clients (cons (accept server-socket) clients))))) - (lambda (key . args) #f)))) - - (set! eval-from-clients - (lambda () - (cond (server-pipes - (eval-from-client (car server-pipes) (cdr server-pipes)))) - (for-each - (lambda (cli) (eval-from-client (car cli) (car cli))) - clients))) - - (set! stop-server - (lambda () - (cond (server-socket - (close server-socket) - (set! server-socket #f))) - (for-each (lambda (cli) (close (car cli))) clients) - (set! clients '())))) - -(define (eval-from-client rec-channel send-channel) - (cond ((char-ready? rec-channel) - (catch #t - (lambda () - (let ((exp (read rec-channel))) - (cond ((eof-object? exp) - (close rec-channel)) - (else - (let ((result (eval-string exp))) - (write (if (eq? result *unspecified*) "" (format #f "~a" result)) send-channel)))))) - (lambda (key . args) - (let ((fmt (string-concatenate (list (cadr args) "~%"))) - (params (caddr args))) - (write - (if params - (apply format (cons #f (cons fmt params))) - (format #f fmt)) - send-channel)))) - (force-output send-channel)))) - - -(define (connect-to-server client-socket hostname port) - (connect client-socket AF_INET (car (hostent:addr-list (gethost hostname))) port)) diff --git a/src/server.scm b/src/server.scm new file mode 100644 index 0000000..1e54001 --- /dev/null +++ b/src/server.scm @@ -0,0 +1,102 @@ +;;; Gacela, a GNU Guile extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; 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) +(define eval-from-clients #f) +(define stop-server #f) + +(let ((server-socket #f) (clients '()) + (server-pipes #f)) + (set! start-server + (lambda* (#:key (port #f) (pipes #f)) + (cond (port + (set! server-socket (socket PF_INET SOCK_STREAM 0)) + (setsockopt server-socket SOL_SOCKET SO_REUSEADDR 1) + (bind server-socket AF_INET INADDR_ANY port) + (listen server-socket 5)) + (pipes + (set! server-pipes pipes))) + (cond ((not (game-running?)) + (game-loop))))) + + + (set! clean-closed-connections + (lambda (conns) + (cond ((null? conns) '()) + (else + (let* ((cli (car conns)) (sock (car cli))) + (cond ((port-closed? sock) + (clean-closed-connections (cdr conns))) + (else + (cons cli (clean-closed-connections (cdr conns)))))))))) + + (set! check-connections + (lambda () + (set! clients (clean-closed-connections clients)) + (catch #t + (lambda () + (cond ((char-ready? server-socket) + (set! clients (cons (accept server-socket) clients))))) + (lambda (key . args) #f)))) + + (set! eval-from-clients + (lambda () + (cond (server-pipes + (eval-from-client (car server-pipes) (cdr server-pipes)))) + (for-each + (lambda (cli) (eval-from-client (car cli) (car cli))) + clients))) + + (set! stop-server + (lambda () + (cond (server-socket + (close server-socket) + (set! server-socket #f))) + (for-each (lambda (cli) (close (car cli))) clients) + (set! clients '())))) + +(define (eval-from-client rec-channel send-channel) + (cond ((char-ready? rec-channel) + (catch #t + (lambda () + (display "leido")(newline) + (let ((exp (read rec-channel))) + (cond ((eof-object? exp) + (close rec-channel)) + (else + (let ((result (eval-string exp))) + (write (if (eq? result *unspecified*) "" (format #f "~a" result)) send-channel)))))) + (lambda (key . args) + (let ((fmt (string-concatenate (list (cadr args) "~%"))) + (params (caddr args))) + (write + (if params + (apply format (cons #f (cons fmt params))) + (format #f fmt)) + send-channel)))) + (force-output send-channel)))) + + +(define (connect-to-server client-socket hostname port) + (connect client-socket AF_INET (car (hostent:addr-list (gethost hostname))) port)) 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