(in-package :cl-user) (ql:quickload :address-formatting) (defpackage chatikbot.plugins.checkins (:use :cl :chatikbot.common :address-formatting)) (in-package :chatikbot.plugins.checkins) (def-db-init (db-execute "create table if not exists checkins_chats (from_id, chat_id, primary key (from_id, chat_id)) without rowid") (db-execute "create table if not exists checkins_history (ts, from_id, lat, lon, place_id, place_name)")) (defun db/get-chats (from-id) (mapcar #'car (db-select "select chat_id from checkins_chats where from_id = ?" from-id))) (defun db/add-chat (from-id chat-id) (db-execute "insert into checkins_chats (from_id, chat_id) values (?, ?)" from-id chat-id)) (defun db/del-chat (from-id chat-id) (db-execute "delete from checkins_chats where from_id = ? and chat_id = ?" from-id chat-id)) (defun db/add-checkin (from-id lat lon place-id place-name) (db-execute "insert into checkins_history (ts, from_id, lat, lon, place_id, place_name) values (?, ?, ?, ?, ?, ?)" (local-time:timestamp-to-unix (local-time:now)) from-id lat lon place-id place-name)) (defun get-icon (res) (let ((cat (keyify (aget "category" res))) (type (keyify (aget "type" res))) (sport (keyify (aget "sport" res)))) (case sport (:soccer "⚽️") (:tennis "🎾") (:basketball "🏀") (:baseball "⚾️") (:multi "🏆") (:swimming "🏊") (:golf "🏌️") (:equestrian "🏇") (:billiards "🎱") (:running "🏃") (:fitnes "🤸") (:athletics "🏋️") (:table-tennis "🏓") (:beachvolleyball "🏐") (:climbing "🧗") (:volleyball "🏐") (:skateboard "🛹") (:boules "🎳") (:american-football "🏈") (:motor "🏎") (:bowls "🎳") (:shooting "🎯") (:cricket "🏏") (:netball "🥍") (:horse-racing "🏇") (:cycling "🚴") (:motocross "🏍") (:rugby-union "🏉") (:skiing "⛷") (:gymnastics "🤸") (:karting "🏎") (:handball "🏉") (:badminton "🏸") (:ice-hockey "🏒") (:field-hockey "🏑") (t (case cat (:amenity (case type (:atm "🏧") (:bank "🏦") (:restaurant "🍽") (:cafe "☕️") (:fast-food "🌯") (:pharmacy "💊") (:kindergarten "🧸") (:bar "🍸") (:hospital "🏥") (:post-office "📯") (:pub "🍺") (:library "📚") )) (:leisure (case type (:pitch))) ))))) (defvar *revgeo-format* "http://osmnames-search/r/~,6f/~,6f.js?count=10") (defun get-places (lat lon) (handler-case (loop for res in (agets (json-request (format nil *revgeo-format* lon lat)) "results") collect (list (cons :id (agets res "id")) (cons :name (agets res "name")) (cons :icon (get-icon res)) (cons :address (format-address res :one-line t)))) (error (e) (log:error e) `(((:id . 0) (:name . "Не нашлось")))))) (defun add-place (name lat lon from-id) `((:name . ,name) (:id . ,from-id) (:lat . ,lat) (:lon . ,lon))) (defun get-name (from) (let ((username (agets from "username")) (first-name (agets from "first_name")) (last-name (agets from "last_name"))) (if username (format nil "@~a" username) (format nil "~a ~a" first-name last-name)))) (defun checkin (from place lat lon) (let* ((from-id (agets from "id")) (place-id (agets place :id)) (place-name (agets place :name)) (place-icon (agets place :icon)) (place-address (agets place :address)) (message (format nil "~a ~@[~A~]~@[ в ~A~]~@[ (~A)~]" (or place-icon "📍") (get-name from) place-name place-address))) (db/add-checkin from-id lat lon place-id place-name) (loop for chat-id in (db/get-chats from-id) do (telegram-send-venue chat-id lat lon (format nil "~a ~@[~A~]~@[ в ~A~]" (or place-icon "📍") (get-name from) place-name) place-address) ;;do (bot-send-message message :chat-id chat-id :parse-mode "markdown") ) (telegram-edit-message-reply-markup nil :chat-id *source-chat-id* :message-id *source-message-id*))) (defparameter +button-columns+ 2) (def-message-handler handle-location (10) (alexandria:when-let ((location (aget "location" *message*))) (alexandria:when-let ((chats (db/get-chats *from-id*)) (lat (agets location "latitude")) (lon (agets location "longitude"))) (log:info "handler-location" *from-id* location) (let ((places (get-places lat lon))) (log:info places) (bot-send-message (if places "Выбери место" "Не нашлось ничего :(") :reply-markup (get-inline-keyboard (append (let* ((buttons (loop for place in places for idx from 0 collect (cons idx (let ((this-place place)) (inline-button ((format nil "~@[~a ~]~a" (agets place :icon) (agets place :name))) (checkin *from* this-place lat lon)))))) (groups (group-by buttons (lambda (p) (truncate (car p) +button-columns+))))) (loop for (i . pairs) in (reverse groups) collect (mapcar #'cdr pairs))) (list (list (inline-button ("+") (bot-send-message "Введи название") (let ((source-chat-id *source-chat-id*) (source-message-id *source-message-id*)) (on-next-message (let ((*source-chat-id* source-chat-id) (*source-message-id* source-message-id)) (checkin *from* (add-place *text* lat lon *from-id*) lat lon))))))))))) t))) (def-message-cmd-handler handler-checkins (:checkins) (let ((chats (db/get-chats *from-id*))) (if (member *chat-id* chats) (progn (db/del-chat *from-id* *chat-id*) (bot-send-message (format nil "Больше сюда не шлём чекины ~a" (get-name *from*)))) (progn (db/add-chat *from-id* *chat-id*) (bot-send-message (format nil "Теперь шлём сюда чекины ~a" (get-name *from*))))))) (def-message-cmd-handler handler-checkin (:checkin) (if (equal "private" (agets *message* "chat" "type")) (bot-send-message "Отправь локейшн" :reply-markup (telegram-reply-keyboard-markup '(((:request-location t :text "Послать координаты"))) :resize-keyboard t :one-time-keyboard t)) (bot-send-message "Нужно в личку" :reply-markup (telegram-inline-keyboard-markup `(((:text "Перейти" :url ,(format nil "tg://user?id=~a" *bot-user-id*))))))))