:components ((:file "package")
(:file "util"
:depends-on ("package"))
+ (:file "locked-queue"
+ :depends-on ("package"))
(:file "web"
- :depends-on ("package"))
+ :depends-on ("package" "locked-queue"))
(:file "empire"
:depends-on ("util"))))
--- /dev/null
+(in-package :locked-queue)
+
+(declaim (optimize (space 0) (speed 0) (safety 3) (debug 3)))
+
+(defclass locked-queue ()
+ ((queue :initform nil)
+ (mutex :initform (sb-thread:make-mutex :name "queue lock"))
+ (waitq :initform (make-waitqueue))))
+
+(defun create ()
+ (make-instance 'locked-queue))
+
+(defmethod dequeue ((q locked-queue))
+ (with-slots (queue mutex waitq) q
+ (with-mutex (mutex)
+ (if (or (null queue)
+ (null (first queue)))
+ (condition-wait waitq mutex))
+ (prog1 (first (car queue))
+ (setf (car queue)
+ (rest (car queue)))))))
+
+(defmethod enqueue ((q locked-queue) value)
+ (with-slots (queue mutex waitq) q
+ (with-mutex (mutex)
+ (let ((last (list value)))
+ (if (null (first queue))
+ (progn
+ (setf queue (cons last last))
+ (condition-notify waitq))
+ (progn
+ (setf (rest (cdr queue))
+ last
+ (cdr queue) last)
+ (cons (car queue) last)))))))
(:export :read-message-loop
:read-message
:make-connection))
+ (defpackage :locked-queue
+ (:use :cl :sb-thread)
+ (:export :create :enqueue :dequeue))
(defpackage :empire-web
(:use :cl :hunchentoot)
(:export :start)))
function hello() {
dojo.xhrGet( {
// The following URL must match that used to test the server.
- url: "/eow/static/ajax.txt",
+ url: "/eow/update",
handleAs: "javascript",
+ //handleAs: "text",
timeout: 5000, // Time in milliseconds
(fullname (concatenate 'string +static-files-root+ fname)))
(handle-static-file fullname)))
+(defvar *update-queue* (locked-queue:create))
+
+(defun update ()
+ "Send stream of updates to client"
+ (locked-queue:dequeue *update-queue*))
+
(defun dispatch (request)
(let ((script-name (script-name request)))
(cond
((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request
+ ((string= script-name "/eow/update") 'update)
((or (string-equal script-name +web-root-base+)
(string-equal script-name +web-root+)) (redirect +root-url+)) ; go to the start page
((string-starts-with script-name +static-web-root+) 'serve-static)))) ; serve static file