gamao-obsoleto/scratch.lisp

(in-package #:event)



(ql:quickload "backgammon")
  
(progn
  (setf hunchentoot:*session-max-time* 86400)
  (defvar *id* 0)

  (defvar *guest-id* 0)

  (defun ensure-user (&optional (session hunchentoot:*session*))
    (when (null (hunchentoot:session-value :user session))
      (setf (hunchentoot:session-value :user session) (make-instance 'ui::guest-user :id (decf *guest-id*)))))

  (defclass server (hunchensocket:websocket-acceptor
                     hunchentoot:easy-acceptor)
    ())

  (defvar *server* (make-instance 'server :port 4242))

  (setf (hunchentoot:acceptor-document-root *server*) (namestring (merge-pathnames "lisp/backgammon/" (user-homedir-pathname))))

  (defvar *tables* (make-hash-table))

  (defun find-table (id)
    (gethash id *tables*))

  (defun register-table (table)
    (setf (gethash (table-id table) *tables*) table))
  ;; todo more options
  (defun set-up-table (id &key limit)
    (let ((table (if limit
                     (make-instance 'match-table :id id :limit limit)
                     (make-instance 'money-session-table :id id))))
      (register-table table)
      (game::start-new-game (session table))
      table))

  #+nil (defvar *connections* (make-hash-table :test 'eq))

  #+nil (defmethod ui::connection-user ((connection user))
          (gethash connection *connections*))

  (defun create-new-table (limit)
    (let* ((*event-queue* (make-event-queue))
           (table (set-up-table (incf *id*) :limit (if (zerop limit) nil limit))))
      (setf (event-queue table) *event-queue*)
      (bt:make-thread (lambda ()
                        (setf *random-state* (make-random-state t))
                        (table-loop table))
                      :name (format nil "table ~A" *id*))
      *id*))


  ;; todo newmatch -> tables
  (hunchentoot:define-easy-handler (new-match :uri "/newmatch") (limit)
    (hunchentoot:start-session)
    (ensure-user)
    (if limit
        (hunchentoot:redirect (format nil "/tables/~A" (create-new-table (parse-integer limit :junk-allowed t))))
        (hunchentoot:handle-static-file "new-match.html")))


  (defun table-info (table)
    (let* ((session (session table))
           (info `(:limit ,(if (typep session 'game::match) (game::limit session) nil)
                   :score ,(game::score session))))
      (dolist (player '(:white :black) info)
        (let ((user (ui::player-user player (ui table))))
          (when user
            (setf info (list* player (ui::name user) info)))))))


  (hunchentoot:start *server*)

  (defun table-gui-dispatcher ()
    (hunchentoot:start-session)
    (ensure-user)
    (let ((script-name (hunchentoot:script-name* hunchentoot:*request*)))
      (if (member script-name
                  '("/tables" "/tables/")
                  :test #'string=)
          (new-match :limit nil)
          (let* ((table-no (parse-integer (subseq script-name 8)))
                 (table (gethash table-no *tables*)))
            (if (and table
                     (ui::player-user :white (ui table))
                     (null (ui::player-user :black (ui table))))
                (hunchentoot:redirect (format nil "/proposal?table=~A" table-no))
                (hunchentoot:handle-static-file "backgammon.html"))))))


  (hunchentoot:define-easy-handler (welcome :uri "/tables") ()
    (hunchentoot:start-session)
    (ensure-user)
    (new-match :limit nil))

  (push (hunchentoot:create-prefix-dispatcher "/tables/" 'table-gui-dispatcher) hunchentoot:*dispatch-table*)

  (defvar *tables* (make-hash-table :test 'equal))



  (defun table-dispatcher (request)
    (let ((uri (hunchentoot:script-name* request)))
      (if (> (length uri) (length "/tables/"))
          (find-table (parse-integer (subseq uri (length "/tables/")) :junk-allowed t))
          nil)))

  (setf hunchensocket:*websocket-dispatch-table* '(table-dispatcher))

  (defun table-uri (id)
    (format nil "/tables/~A" id))

  (hunchentoot:define-easy-handler (tables-info :uri "/tables-info") ()
    (setf (hunchentoot:content-type*) "application/json")
    (jonathan:to-json (mapcar #'rest (append (sort (loop for id being the hash-keys in *tables*
                                                         using (hash-value table)
                                                         when (and (not (game::finished-p (session table)))
                                                                   (null (ui::player-user :black (ui table))))
                                                         collect (list* id :uri (table-uri id) (table-info table)))
                                                   #'<
                                                   :key #'first
                                                   )
                                             (sort (loop for id being the hash-keys in *tables*
                                                         using (hash-value table)
                                                         when (and (not (game::finished-p (session table)))
                                                                   (ui::player-user :black (ui table)))
                                                         collect (list* id :uri (table-uri id) (table-info table)))
                                                   #'<
                                                   :key #'first
                                                   )
                                             )

                              )))

  )

(hunchentoot:define-easy-handler (proposal-web-handler :uri "/proposal") (table)
  (hunchentoot:handle-static-file "proposal.html")
  )

(hunchentoot:stop *server*)



;; todo lock


(defvar *table*)
(set-up-table 1)
(setf *event-queue* (make-event-queue))
(setf *table* (set-up-table 1))
(setf  hunchensocket:*websocket-dispatch-table* (list (constantly (progn (hunchentoot:start-session) *table*))))
(table-loop *table*) 

(let ((*event-queue* (make-event-queue)))
  (setf *table* (set-up-table 1))
  (setf (event-queue *table*) *event-queue*)
  (setf  hunchensocket:*websocket-dispatch-table* (list (lambda (request)
                                                          (when (string= (hunchentoot:script-name* request) "/table")
                                                            *table*))))
  (table-loop *table*) 
  )

(let* ((*event-queue* (make-event-queue))
       (table (set-up-table (incf *id*))))
  (setf (event-queue table) *event-queue*)
  (setf  hunchensocket:*websocket-dispatch-table* '(table-dispatcher))
  (bt:make-thread (lambda () (table-loop table)) :name (format nil "table ~A" *id*)))