(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 (on-exit) (setf (game-is-active *game*) nil))) (: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)