|
|
@@ -0,0 +1,168 @@
|
|
|
+(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"))
|
|
|
+
|
|
|
+(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)
|
|
|
+ (loop
|
|
|
+ with last-pos = (file-position s)
|
|
|
+ for line = (read-line s nil nil)
|
|
|
+ when line do (progn
|
|
|
+ (funcall thunk line)
|
|
|
+ (setf last-pos (file-position s)))
|
|
|
+ else do (progn
|
|
|
+ (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*))
|
|
|
+ (sort (loop for player across (game-players game)
|
|
|
+ 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)
|
|
|
+ (dolist (*chat-id* (lists-get :q3a))
|
|
|
+ (bot-send-message words))))
|
|
|
+
|
|
|
+(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 ()
|
|
|
+ (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)) :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)))
|
|
|
+
|
|
|
+(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)
|
