chatikbot/plugins/q3a.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.q3a
  (:use :cl :chatikbot.common :alexandria))
(in-package :chatikbot.plugins.q3a)

(defsetting *server-log* "/home/gamer/.q3a/baseq3/server.log" "Path to Q3Arena server log file to watch")
(defvar *watcher* nil "Log watcher thread if set")
(defvar *lock-game* (bordeaux-threads:make-recursive-lock "Q3A lock"))

(defvar *first-read*)
(defun watch-file (filespec thunk &optional (start-at :end))
  "This will block forever, waiting for new data"
  (with-open-file (s filespec)
    (file-position s start-at)
    (setf *first-read* t)
    (loop
       with last-pos = (file-position s)
       for line = (read-line s nil nil)
       when line do (unwind-protect
                         (handler-case (funcall thunk line)
                           (error (e) (log:error e)))
                      (setf last-pos (file-position s)))
       else do (progn
                 (setf *first-read* nil)
                 (sleep 0.1)
                 (when (> last-pos (file-length s))
                   (file-position s :start))))))

(defun parse-bslash-list (str)
  (loop for (key val) on
       (loop for pos = 0 then (1+ next-pos)
          for next-pos = (position #\\ str :start pos)
          collect (subseq str pos next-pos)
          while next-pos) by 'cddr
       collect (cons key val)))

(defstruct game info players last-time is-active)
(defstruct player name info kills began)
(defstruct kill whom how)

(defvar *game* (make-game) "Currently active game")
(defun max-players (&optional (game *game*))
  (length (game-players game)))

(defun map-name (&optional (game *game*))
  (agets (game-info game) "mapname"))

(defun suicidep (player kill)
  (or (null (kill-whom kill))
      (equal (kill-whom kill) player)))

(defun player-score (player)
  (loop for kill in (player-kills player)
     when (suicidep player kill) sum -1 else sum 1))

(defun get-rankings (&optional (game *game*))
  (when-let (players (game-players game))
    (sort (loop for player across players
             when (player-began player)
             collect (cons (player-score player) player))
          #'> :key #'car)))

(defun game-status (&optional (game *game*))
  (let ((ranks (get-rankings)))
    (if ranks
        (format nil (if (game-is-active game)
                        "[[Q3]] Match *~A* is on for ~A~%~{~A~^~%~}"
                        "[[Q3]] Match *~A* has ended after ~A~%~{~A~^~%~}")
                (map-name) (game-last-time *game*)
                (loop for (score . player) in ranks
                   collect (format nil "*~A* ~A" score (player-name player))))
        "[[Q3]] War awaits")))

(defun say (fmt &rest args)
  (let ((words (apply #'format nil fmt args)))
    (write words) (terpri)
    (unless *first-read*
      (dolist (*chat-id* (lists-get :q3a))
        (bot-send-message words :parse-mode "Markdown")))))

(defun weapon (kill)
  (kill-how kill))

(defun on-init ())

(defun on-begin (player)
  (unless (player-began player)
    (say "[[Q3]] ~A joined the server on ~A" (player-name player) (map-name))))

;; (defun on-kill (player kill)
;;   (let* ((name (player-name player))
;;          (who (kill-whom kill)))
;;     (if (suicidep player kill)
;;         (say "[[Q3]] ~A suicides with score ~A" name (player-score player))
;;         (say "[[Q3]] ~A frags ~A with score ~A" name (player-name who) (player-score player)))))
(defun on-kill (player kill)
  (declare (ignorable player kill)))

(defun on-disconnect (player)
  (when (player-began player)
    (say "[[Q3]] ~A has left the match with ~A frags" (player-name player) (player-score player))))

(defun on-exit ()
  (when (get-rankings)
    (say (game-status))))

(defun process-log (line)
  (bordeaux-threads:with-recursive-lock-held (*lock-game*)
    (let* ((time (subseq line 0 7))
           (sep (position #\: line :start 7))
           (action (keyify (subseq line 7 sep)))
           (args (when (and sep (> (length line) (+ 2 sep))) (subseq line (+ 2 sep))))
           (client (when args (parse-integer args :junk-allowed t)))
           (player (when (and client (<= 0 client (1- (max-players))))
             (elt (game-players *game*) client))))
      (setf (game-last-time *game*) (trim-nil time))
      (case action
        (:initgame (with-slots (info players is-active) *game*
                     (setf info (parse-bslash-list (subseq args 1))
                           is-active t
                           players (or players
                                       (let ((count (parse-integer (agets info "sv_maxclients"))))
                                         (make-array count :element-type 'player
                                                     :initial-contents (loop for i below count collect (make-player))))))
                     (on-init)))
        (:clientuserinfochanged (with-slots (info name) player
                                  (setf info (parse-bslash-list
                                              (subseq args (1+ (position #\Space args))))
                                        name (agets info "n"))))
        (:clientbegin (progn
                        (on-begin player)
                        (setf (player-began player) t)))
        (:clientdisconnect (progn
                             (on-disconnect player)
                             (setf (player-began player) nil)))
        (:kill (destructuring-bind (a1 a2 how)
                   (mapcar 'parse-integer (split-sequence:split-sequence
                                           #\Space (subseq args 0 (position #\: args))))
                 (let* ((killee (when (<= a1 (max-players))
                                  (elt (game-players *game*) a2)))
                        (killer (elt (game-players *game*) (if killee a1 a2)))
                        (kill (make-kill :whom killee :how how)))
                   (push kill (player-kills killer))
                   (on-kill killer kill))))
        (:exit (progn
                 (setf (game-is-active *game*) nil)
                 (on-exit)))
        (:shutdowngame (loop for player across (game-players *game*)
                          do (setf (player-kills player) nil))))))
  (values))

(defun ensure-watcher ()
  (bt:with-recursive-lock-held (*lock-game*)
    (if (lists-get :q3a)
        (unless *watcher*
          (setf *watcher* (bt:make-thread (lambda () (watch-file *server-log* #'process-log :start))
                                          :name "q3a watch")))
        (when *watcher*
          (bt:destroy-thread *watcher*)
          (setf *watcher* nil))))
  (values))

(defun handle-set-watch (enable)
  (lists-set-entry :q3a *chat-id* enable)
  (ensure-watcher)
  (bot-send-message (if enable "[[Q3]] Шлём войну!" "[[Q3]] Миру-мир!")))

(defun handle-active ()
  (bot-send-message (game-status) :parse-mode "Markdown"))

(def-message-cmd-handler handle-cmd-q3a (:q3a)
  (cond
    ((= 1 (length *args*))
     (handle-set-watch (equal "on" (car *args*))))
    (:otherwise (handle-active))))

(add-hook :starting #'ensure-watcher)