aboutsummaryrefslogtreecommitdiff
path: root/example/slideshow.scm
blob: 6ef012fca288acac94189cf56acdfa240965161a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
(use shell)
(require-extension telebot
                   (prefix telebot telebot:))

(define admin "$user_id")
(define sorry "I'm sorry Dave, I'm afraid I can't do that.")
(define greeting "Greetings human. I am a software demon enabling you to control the slideshow displayed on my creator's laptop.")

(define (resolve-query query tree)
  (fold (lambda (x y) (alist-ref x y))
        tree
        query))

(define (make-sender token chat_id)
  (lambda (text)
    (print chat_id " <- \"" text "\"")
    (telebot:sendMessage token
                         chat_id: chat_id
                         text:    text)))

(define (make-slideshow-closure send)
  (let* ((state #f))
    (lambda ()
      (if state
        (begin (set! state #f)
               (run "geeqie --remote --slideshow-stop")
               (send "Slideshow stopped."))
        (begin (set! state #t)
               (run "geeqie --remote --delay=6")
               (run "geeqie --remote --slideshow-start")
               (send "Slideshow started."))))))

(define (make-conversation token chat_id)
  (let* ((chat_id (number->string chat_id))
         (send    (make-sender token chat_id))
         (slideshow (make-slideshow-closure send)))
    (send greeting)
    (lambda (update)
      (let* ((text  (resolve-query '(message text) update)))
        (print chat_id " -> \"" text "\"")
        (if (and (string? text)
                 (string=? chat_id admin))
          (cond ((string=? text "n")     (run "geeqie --remote --next"))
                ((string=? text "p")     (run "geeqie --remote --back"))
                ((string=? text "s")     (slideshow))
                (else                    (send sorry)))
          (send sorry))))))

(let* ((token    (car (command-line-arguments)))
       (converse (telebot:make-conversation-manager token
                                                    make-conversation)))
  (telebot:poll-updates token converse))