opfez
/
anna
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

qotd, better abstractions, add impure bindings to !eval

master
opfez 2021-08-18 10:38:18 +00:00
parent 0a952a173c
commit 8f0c0d2083
1 changed files with 66 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
anna.scm
View File

@ -53,7 +53,7 @@
(intersperse sep (cdr lst))))))) (intersperse sep (cdr lst)))))))
(define (make-connection host port) (define (make-connection host port)
"Connect to irc server on host:port, returns a socket for reading and writing." "Connect to server on host:port, returns a socket for reading and writing."
(let* ((sock (socket PF_INET SOCK_STREAM 0)) (let* ((sock (socket PF_INET SOCK_STREAM 0))
(con (connect sock (con (connect sock
AF_INET AF_INET
@ -115,7 +115,8 @@
(guard (ex (guard (ex
(else (begin (display "error encountered!\n") (else (begin (display "error encountered!\n")
'error))) ;; << this gets printed in chat 'error))) ;; << this gets printed in chat
(eval-in-sandbox (read (open-input-string str))))) (eval-in-sandbox (read (open-input-string str))
#:bindings all-pure-and-impure-bindings)))
(define (find-documentation language search) (define (find-documentation language search)
"Find documentation for different programming languages." "Find documentation for different programming languages."
@ -247,10 +248,20 @@
(define (diceware file) (define (diceware file)
(fold-right (lambda (x y) (string-append x " " y)) (fold-right (lambda (x y) (string-append x " " y))
"" ""
(n-func-results 5 (lambda () (diceware-one-word (if (equal? file "eff") (n-func-results 6 (lambda () (diceware-one-word (if (equal? file "eff")
"diceware_eff.txt" "diceware_eff.txt"
"diceware_words.txt")))))) "diceware_words.txt"))))))
(define (qotd stream channel)
(let ((s (make-connection "127.0.0.1" 1717)))
(define (send-quote)
(let ((line (read-line s)))
(unless (eof-object? line)
(send-message stream channel line)
(send-quote))))
(send-quote)
(close-port s)))
(define (main-loop stream) (define (main-loop stream)
(let* ((inl (read-line stream)) (let* ((inl (read-line stream))
(data (string-tokenize inl)) (data (string-tokenize inl))
@ -258,56 +269,59 @@
(filtered-data (map input-filter data))) (filtered-data (map input-filter data)))
;; debug print ;; debug print
(format #t "~s~%" data) (format #t "~s~%" data)
(cond (let ((command (slist-ref data 3)))
((equal? (car data) "PING") (cond
(pong stream)) ((equal? (car data) "PING")
((or (equal? ":!rollcall" (slist-ref data 3)) (pong stream))
(equal? ":!anna" (slist-ref data 3))) ((or (equal? ":!rollcall" command)
(send-message stream chn "Hello! I respond to !anna, !tz <optionally user>, !greets, !lgreets <optionally user>, !rgreets <optionally user>, !dw <optionally \"eff\"> and !eval <s-expr>. My source code is available at https://git.tilde.town/opfez/anna")) (equal? ":!anna" command))
((equal? ":!eval" (slist-ref data 3)) (send-message stream chn "Hello! I respond to !anna, !tz <optionally user>, !greets, !lgreets <optionally user>, !rgreets <optionally user>, !dw <optionally \"eff\"> and !eval <s-expr>. My source code is available at https://git.tilde.town/opfez/anna"))
(let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data)))))) ((equal? ":!eval" command)
(send-message stream chn (evaluate expr)))) (let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data))))))
((equal? ":!doc" (slist-ref data 3)) (send-message stream chn (evaluate expr))))
(let ((lang (slist-ref data 4)) ((equal? ":!doc" command)
(search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data))))))) (let ((lang (slist-ref data 4))
(send-message stream chn (find-documentation (string->symbol lang) search)))) (search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data)))))))
((equal? ":!tz" (slist-ref data 3)) (send-message stream chn (find-documentation (string->symbol lang) search))))
(send-message stream chn (if (= 4 (length data)) ((equal? ":!tz" command)
(timezone (get-username (car data))) (send-message stream chn (if (= 4 (length data))
(timezone (slist-ref data 4))))) (timezone (get-username (car data)))
((equal? ":!lgreets" (slist-ref data 3)) (timezone (slist-ref data 4)))))
(format #t "~s~%" *left-greets*) ((equal? ":!lgreets" command)
(send-message stream chn (if (= 4 (length data)) (format #t "~s~%" *left-greets*)
(greets *left-greets* (get-username (car data))) (send-message stream chn (if (= 4 (length data))
(greets *left-greets* (slist-ref data 4))))) (greets *left-greets* (get-username (car data)))
((equal? ":!rgreets" (slist-ref data 3)) (greets *left-greets* (slist-ref data 4)))))
(format #t "~s~%" *right-greets*) ((equal? ":!rgreets" command)
(send-message stream chn (if (= 4 (length data)) (format #t "~s~%" *right-greets*)
(greets *right-greets* (get-username (car data))) (send-message stream chn (if (= 4 (length data))
(greets *right-greets* (slist-ref data 4))))) (greets *right-greets* (get-username (car data)))
((equal? ":!greets" (slist-ref data 3)) (greets *right-greets* (slist-ref data 4)))))
(send-message stream chn (string-append "o/ - " ((equal? ":!greets" command)
(number->string (all-greets *right-greets*)) (send-message stream chn (string-append "o/ - "
" vs \\o - " (number->string (all-greets *right-greets*))
(number->string (all-greets *left-greets*))))) " vs \\o - "
((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o/") (number->string (all-greets *left-greets*)))))
#f) ((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o/")
((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o") #f)
((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o")
(inc-left-greets (get-username (car data))) (inc-left-greets (get-username (car data)))
(write-greets)) (write-greets))
((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/") ((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/")
(inc-right-greets (get-username (car data))) (inc-right-greets (get-username (car data)))
(write-greets)) (write-greets))
((equal? ":!kirby" (slist-ref data 3)) ((equal? ":!kirby" command)
(send-message stream chn "13●0ミ8☆")) (send-message stream chn "13●0ミ8☆"))
((equal? ":!dw" (slist-ref data 3)) ((equal? ":!dw" command)
(send-message stream chn (diceware (slist-ref data 4)))) (send-message stream chn (diceware (slist-ref data 4))))
((and (= 7 (length data)) ((equal? ":!qotd" command)
(equal? (list-tail data 4) '("ACTION" "shoots" "anna"))) (qotd stream chn))
(send-action stream chn "dies") ((and (= 7 (length data))
(close-port stream) (equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
(exit))) (send-action stream chn "dies")
(close-port stream)
(exit))))
(main-loop stream))) (main-loop stream)))
(let* ((io (make-connection "127.0.0.1" 6667))) (let* ((io (make-connection "127.0.0.1" 6667)))