- (defun set-resource (key plist constructor destructor &key static)
- (expire-resources)
- (setf (gethash key resources-table)
- (make-resource :plist plist
- :constructor constructor
- :destructor destructor
- :time (if static t (SDL_GetTicks)))))
-
- (defun get-resource (key)
- (cond ((null (gethash key resources-table)) nil)
- (t (let ((time (get-rtime key)))
- (cond ((null time) (funcall (get-rconstructor key)))
- ((numberp time) (setf (get-rtime key) (SDL_GetTicks))))
- (get-rplist key)))))
-
- (defun free-resource (key)
- (funcall (get-rdestructor key))
- (setf (get-rtime key) nil))
-
- (defun expire-resource (key &optional (now (SDL_GetTicks)))
- (let ((time (get-rtime key)))
- (cond ((and (numberp time) (> (- now time) expiration-time)) (free-resource key)))))
-
- (defun expire-resources ()
- (maphash (lambda (key res) (expire-resource key)) resources-table))
-
- (defun free-all-resources ()
- (maphash (lambda (key res) (free-resource key)) resources-table)))
-
-
-;;; Connection with Gacela Clients
-(let (server-socket clients)
- (defun start-server (port)
- (cond ((null server-socket) (setq server-socket (si::socket port :server #'check-connections)))))
-
- (defun check-connections ()
- (cond ((and server-socket (listen server-socket)) (setq clients (cons (si::accept server-socket) clients)))))
-
- (defun eval-from-clients ()
- (labels ((eval-clients (cli-socks)
- (cond (cli-socks
- (let ((cli (car cli-socks)))
- (cond ((si::listen cli)
- (secure-block cli (eval (read cli)))
- (si::close cli)
- (eval-clients (cdr cli-socks)))
- (t
- (cons cli (eval-clients (cdr cli-socks))))))))))
- (setq clients (eval-clients clients))))
-
- (defun stop-server ()
- (cond (server-socket (si::close server-socket) (setq server-socket nil)))
- (cond (clients
- (labels ((close-clients (cli-socks)
- (si::close (car cli-socks))
- (close-clients (cdr cli-socks))))
- (close-clients clients))
- (setq clients nil)))))