From 5e6b7a1248e175e8c550ce9feed7745292f17bfe Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Fri, 10 Oct 2025 07:13:19 +0300 Subject: Add a helper reply-message function --- src/main.lisp | 237 +++++++++++++++++----------------------------------------- 1 file changed, 68 insertions(+), 169 deletions(-) (limited to 'src/main.lisp') diff --git a/src/main.lisp b/src/main.lisp index af88fe6..419bb67 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -3,7 +3,7 @@ (defpackage :ukkoclot/main (:nicknames :ukkoclot) (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/log :ukkoclot/tg-types) - (:import-from :anaphora :aand :awhen :it) + (:import-from :anaphora :acond :awhen :it) (:import-from :ukkoclot/bot :make-bot :bot-power-on) (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case) @@ -105,15 +105,10 @@ ;; TODO: Rule 10 have fun and enjoy your time on user entry (if (= (user-id new-member) (bot-id bot)) nil - (send-message bot - :chat-id (message-chat-id msg) - :text (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") - :parse-mode "HTML" - :reply-parameters - (make-reply-parameters - :allow-sending-without-reply t - :message-id (message-id msg) - :chat-id (message-chat-id msg))))) + (reply-message bot msg + (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") + :parse-mode "HTML" + :allow-sending-without-reply t))) (defun is-bad-text (text) ;; TODO: @@ -140,144 +135,68 @@ do (on-text-command bot msg text (message-entity-extract entity text)))) (cond ((equal text ":3") - (send-message bot :chat-id (message-chat-id msg) - :text ">:3" - :reply-parameters (make-reply-parameters :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg ">:3")) ((equal text ">:3") - (send-message bot :chat-id (message-chat-id msg) - :text ">:3" - :parse-mode "HTML" - :reply-parameters (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg ">:3" :parse-mode "HTML")) ((starts-with-ignore-case text "big ") (let ((the-text (subseq text 4))) (unless (is-tg-whitespace-str the-text) - (send-message bot - :chat-id (message-chat-id msg) - :text (concatenate 'string - "" - (escape-xml (string-upcase the-text)) - "") - :parse-mode "HTML" - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))))) + (reply-message bot msg + (concatenate 'string + "" + (escape-xml (string-upcase the-text)) + "") + :parse-mode "HTML")))) ((string-equal text "dio cane") - (let ((reply-msg-id (message-id msg)) - (reply-chat-id (message-chat-id msg))) - (awhen (message-reply-to-message msg) - (setf reply-msg-id (message-id it)) - (setf reply-chat-id (message-chat-id it))) - (send-message bot - :chat-id (message-chat-id msg) - :text "porco dio" - :reply-parameters - (make-reply-parameters - :message-id reply-msg-id - :chat-id reply-chat-id)))) + (reply-message bot + (or (message-reply-to-message msg) msg) + "porco dio")) ((string-equal text "forgor") - (send-message bot - :chat-id (message-chat-id msg) - :text "💀" - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg "💀")) ((string-equal text "huh") - (send-message bot - :chat-id (message-chat-id msg) - :text "idgi" - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg "idgi")) ((string= text "H") - (send-message bot - :chat-id (message-chat-id msg) - :text "Randomly selected reminder that h > H." - :parse-mode "HTML" - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg "Randomly selected reminder that h > H." :parse-mode "HTML")) ((string-equal text "porco dio") - (let ((reply-msg-id (message-id msg)) - (reply-chat-id (message-chat-id msg))) - (awhen (message-reply-to-message msg) - (setf reply-msg-id (message-id it)) - (setf reply-chat-id (message-chat-id it))) - (send-message bot - :chat-id (message-chat-id msg) - :text "dio cane" - :reply-parameters - (make-reply-parameters - :message-id reply-msg-id - :chat-id reply-chat-id)))) + (reply-message bot + (or (message-reply-to-message msg) msg) + "dio cane")) ((starts-with-ignore-case text "say ") (let ((the-text (subseq text 4))) (unless (is-tg-whitespace-str the-text) - (send-message bot - :chat-id (message-chat-id msg) - :text the-text - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))))) + (reply-message bot msg the-text)))) ((string-equal text "uwu") - (send-message bot - :chat-id (message-chat-id msg) - :text "OwO" - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg "OwO")) ((string-equal text "waow") - (let ((reply-msg-id (message-id msg)) - (reply-chat-id (message-chat-id msg))) - (awhen (message-reply-to-message msg) - (setf reply-msg-id (message-id it)) - (setf reply-chat-id (message-chat-id it))) - (send-message bot - :chat-id (message-chat-id msg) - :text "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED" - :reply-parameters - (make-reply-parameters - :message-id reply-msg-id - :chat-id reply-chat-id)))) + (reply-message bot + (or (message-reply-to-message msg) msg) + "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED")) ((string-equal text "what") - (send-message bot - :chat-id (message-chat-id msg) - :text (with-output-to-string (s) - (if (char= (elt text 0) #\w) - (write-char #\g s) - (write-char #\G s)) - (if (char= (elt text 1) #\h) - (write-string "ood " s) - (write-string "OOD " s)) - (if (char= (elt text 2) #\a) - (write-string "gir" s) - (write-string "GIR" s)) - (if (char= (elt text 3) #\t) - (write-char #\l s) - (write-char #\L s))) - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (reply-message bot msg + (with-output-to-string (s) + (if (char= (elt text 0) #\w) + (write-char #\g s) + (write-char #\G s)) + (if (char= (elt text 1) #\h) + (write-string "ood " s) + (write-string "OOD " s)) + (if (char= (elt text 2) #\a) + (write-string "gir" s) + (write-string "GIR" s)) + (if (char= (elt text 3) #\t) + (write-char #\l s) + (write-char #\L s))))) ))) (defun simplify-cmd (bot cmd) @@ -293,53 +212,33 @@ (defun on-text-command (bot msg text cmd) (let ((simple-cmd (simplify-cmd bot cmd))) (log-debug "text-command: ~A AKA ~A" cmd simple-cmd) - (cond ((equal simple-cmd "chatid") - (send-message bot :chat-id (message-chat-id msg) - :text (format nil "~A" (message-chat-id msg)) - :parse-mode "HTML" - :reply-parameters (make-reply-parameters :message-id (message-id msg) - :chat-id (message-chat-id msg)))) - - ((equal simple-cmd "msginfo") - (aand (message-reply-to-message msg) - (send-message bot :chat-id (message-chat-id msg) - ;; TODO: Text needs lot more massaging - :text (jzon:stringify (arg-encode it)) - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg))))) - - ((equal simple-cmd "ping") - (let* ((start-time (get-internal-real-time)) - (reply (send-message bot - :chat-id (message-chat-id msg) - :text "Pong! -Send time: ..." - :reply-parameters - (make-reply-parameters - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) - (end-time (get-internal-real-time)) - (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) - 1000))) - (edit-message-text bot - :chat-id (message-chat-id msg) - :message-id (message-id reply) - :text (format nil "Pong!~2%Send time: ~Gms" time-elapsed)))) - - ((and (equal simple-cmd "shutdown") - (message-from msg) - (= (user-id (message-from msg)) (config-owner (bot-config bot)))) - (setf (bot-power-on bot) nil) - (send-message bot - :chat-id (message-chat-id msg) - :text "Initialising shutdown..." - :reply-parameters - (make-reply-parameters - :allow-sending-without-reply t - :message-id (message-id msg) - :chat-id (message-chat-id msg)))) + (acond + ((equal simple-cmd "chatid") + (reply-message bot msg (format nil "~A" (message-chat-id msg)) :parse-mode "HTML")) + + ((and (equal simple-cmd "msginfo") + (message-reply-to-message msg)) + (reply-message bot it + ;; TODO: Text needs lot more massaging lol + (jzon:stringify (arg-encode it)))) + + ((equal simple-cmd "ping") + (let* ((start-time (get-internal-real-time)) + (reply (reply-message bot msg "Pong! +Send time: ...")) + (end-time (get-internal-real-time)) + (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) + 1000))) + (edit-message-text bot + :chat-id (message-chat-id reply) + :message-id (message-id reply) + :text (format nil "Pong!~2%Send time: ~Gms" time-elapsed)))) + + ((and (equal simple-cmd "shutdown") + (message-from msg) + (= (user-id (message-from msg)) (config-owner (bot-config bot)))) + (setf (bot-power-on bot) nil) + (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t)) ))) -- cgit v1.2.3