X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela_server.scm;h=1d926fd5fe531be4cd9139fc6bcdaf46fb873d25;hb=cd001a2c183f65f0894500569fea2ffcf7362f30;hp=a95ec9d50d4497e707a62bdb0228c3cd64981bf8;hpb=39b00720d1fbe4762abb8bd5aab37572a31028f2;p=gacela.git diff --git a/src/gacela_server.scm b/src/gacela_server.scm index a95ec9d..1d926fd 100644 --- a/src/gacela_server.scm +++ b/src/gacela_server.scm @@ -17,6 +17,7 @@ (define start-server #f) (define check-connections #f) +(define clean-closed-connections #f) (define eval-from-clients #f) (define stop-server #f) @@ -24,15 +25,30 @@ (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 @@ -42,8 +58,20 @@ (let ((sock (car cli))) (cond ((char-ready? sock) (catch #t - (lambda () (eval (read sock))) - (lambda (key . args) #f)))))) + (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