X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_server.scm;h=1d926fd5fe531be4cd9139fc6bcdaf46fb873d25;hb=cd001a2c183f65f0894500569fea2ffcf7362f30;hp=548488efcb637ed8517931f44f0f48883711e8c2;hpb=71acfe50145894e950d1d9deb656fb36132b5de3;p=gacela.git diff --git a/src/gacela_server.scm b/src/gacela_server.scm index 548488e..1d926fd 100644 --- a/src/gacela_server.scm +++ b/src/gacela_server.scm @@ -17,23 +17,67 @@ (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 '())) (set! start-server (lambda (port) (set! server-socket (socket PF_INET SOCK_STREAM 0)) - (fcntl server-socket F_SETFL (logior O_NONBLOCK (fcntl server-socket F_GETFL))) (setsockopt server-socket SOL_SOCKET SO_REUSEADDR 1) (bind server-socket AF_INET INADDR_ANY port) - (listen server-socket 5))) + (listen server-socket 5) + (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 () (set! clients (cons (accept server-socket) clients))) + (lambda () + (cond ((char-ready? server-socket) + (set! clients (cons (accept server-socket) clients))))) (lambda (key . args) #f)))) + (set! eval-from-clients + (lambda () + (for-each + (lambda (cli) + (let ((sock (car cli))) + (cond ((char-ready? sock) + (catch #t + (lambda () + (let ((exp (read sock))) + (format #t "~a~%" exp) + (cond ((eof-object? exp) + (close sock)) + (else + (format #t "~a~%" (primitive-eval (car exp))) + (format sock "~a" (primitive-eval (car exp))))))) + (lambda (key . args) + (let ((fmt (string-concatenate (list (cadr args) "~%"))) + (params (caddr args))) + (if params + (apply format (cons sock (cons fmt params))) + (format sock fmt))))))))) + clients))) + (set! stop-server (lambda () - (cond (server-socket (close server-socket) (set! server-socket #f))) \ No newline at end of file + (cond (server-socket + (close server-socket) + (set! server-socket #f))) + (for-each (lambda (cli) (close (car cli))) clients) + (set! clients '()))))