X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=gacela.lisp;h=d94e4685246edaa305112488eeca66ed7aa1cf29;hb=713dfecf4536609800aa869bc1218b2dccc4d970;hp=5d6eae05a4c8a96b5a288e8c6db34a99ae83eb13;hpb=ca6a66c5bbd26fb490b563189bd292a7c7f5f8a0;p=gacela.git diff --git a/gacela.lisp b/gacela.lisp index 5d6eae0..d94e468 100644 --- a/gacela.lisp +++ b/gacela.lisp @@ -206,34 +206,25 @@ ;;; Gacela Server for development mode (let (socket clients) - (defun server-running? () - (if socket t nil)) - (defun start-server (port) - (setq socket (si::socket port :server #'eval-from-client))) + (when (null socket) (setq socket (si::socket port :server #'eval-from-clients)))) (defun check-server-connections () - (when (si::listen socket) (push (si:accept socket) clients))) + (when (and socket (si::listen socket)) (push (si:accept socket) clients))) (defun eval-from-clients () - (dolist (cli clients) (when (si::listen cli) (eval (read cli)))))) + (dolist (cli clients) + (when (si::listen cli) + (secure-block cli (eval (read cli)))))) + (defun stop-server () + (when socket + (dolist (cli clients) (si::close cli)) + (si::close socket) + (setq socket nil clients nil)))) -;;; GaCeLa Functions -(let (commands) - (defun prog-command (command) - (setq commands (cons command commands))) - - (defun run-commands () - (cond (commands - (let (running) - (setq running commands) - (setq commands nil) - (labels ((run-com (comlst) - (cond (comlst (run-com (cdr comlst)) - (eval (read-from-string (concatenate 'string "(progn " (car comlst) ")"))))))) - (run-com running))))))) +;;; GaCeLa Functions (let (time (time-per-frame (/ 1000.0 *frames-per-second*))) (defun set-frames-per-second (fps) (setq time-per-frame (/ 1000.0 fps))) @@ -252,6 +243,8 @@ (init-video-mode) (SDL_WM_SetCaption ,title "") (init-frame-time) + (check-server-connections) + (eval-from-clients) (refresh-running-mobs) (process-events) (do () ((quit?)) @@ -263,6 +256,8 @@ (SDL_GL_SwapBuffers) (delay-frame) (init-frame-time) + (check-server-connections) + (eval-from-clients) (refresh-running-mobs) (process-events) (setq running nil))))