|
|
@@ -0,0 +1,186 @@
|
|
|
+(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*))))))))
|
