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)))))))
(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))
(con (connect sock
AF_INET
@ -115,7 +115,8 @@
(guard (ex
(else (begin (display "error encountered!\n")
'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)
"Find documentation for different programming languages."
@ -247,10 +248,20 @@
(define (diceware file)
(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_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)
(let* ((inl (read-line stream))
(data (string-tokenize inl))
@ -258,56 +269,59 @@
(filtered-data (map input-filter data)))
;; debug print
(format #t "~s~%" data)
(cond
((equal? (car data) "PING")
(pong stream))
((or (equal? ":!rollcall" (slist-ref data 3))
(equal? ":!anna" (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"))
((equal? ":!eval" (slist-ref data 3))
(let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data))))))
(send-message stream chn (evaluate expr))))
((equal? ":!doc" (slist-ref data 3))
(let ((lang (slist-ref data 4))
(search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data)))))))
(send-message stream chn (find-documentation (string->symbol lang) search))))
((equal? ":!tz" (slist-ref data 3))
(send-message stream chn (if (= 4 (length data))
(timezone (get-username (car data)))
(timezone (slist-ref data 4)))))
((equal? ":!lgreets" (slist-ref data 3))
(format #t "~s~%" *left-greets*)
(send-message stream chn (if (= 4 (length data))
(greets *left-greets* (get-username (car data)))
(greets *left-greets* (slist-ref data 4)))))
((equal? ":!rgreets" (slist-ref data 3))
(format #t "~s~%" *right-greets*)
(send-message stream chn (if (= 4 (length data))
(greets *right-greets* (get-username (car data)))
(greets *right-greets* (slist-ref data 4)))))
((equal? ":!greets" (slist-ref data 3))
(send-message stream chn (string-append "o/ - "
(number->string (all-greets *right-greets*))
" vs \\o - "
(number->string (all-greets *left-greets*)))))
((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")
(let ((command (slist-ref data 3)))
(cond
((equal? (car data) "PING")
(pong stream))
((or (equal? ":!rollcall" command)
(equal? ":!anna" 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? ":!eval" command)
(let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data))))))
(send-message stream chn (evaluate expr))))
((equal? ":!doc" command)
(let ((lang (slist-ref data 4))
(search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data)))))))
(send-message stream chn (find-documentation (string->symbol lang) search))))
((equal? ":!tz" command)
(send-message stream chn (if (= 4 (length data))
(timezone (get-username (car data)))
(timezone (slist-ref data 4)))))
((equal? ":!lgreets" command)
(format #t "~s~%" *left-greets*)
(send-message stream chn (if (= 4 (length data))
(greets *left-greets* (get-username (car data)))
(greets *left-greets* (slist-ref data 4)))))
((equal? ":!rgreets" command)
(format #t "~s~%" *right-greets*)
(send-message stream chn (if (= 4 (length data))
(greets *right-greets* (get-username (car data)))
(greets *right-greets* (slist-ref data 4)))))
((equal? ":!greets" command)
(send-message stream chn (string-append "o/ - "
(number->string (all-greets *right-greets*))
" vs \\o - "
(number->string (all-greets *left-greets*)))))
((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)))
(write-greets))
((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/")
(inc-right-greets (get-username (car data)))
(write-greets))
((equal? ":!kirby" (slist-ref data 3))
(send-message stream chn "13●0ミ8☆"))
((equal? ":!dw" (slist-ref data 3))
(send-message stream chn (diceware (slist-ref data 4))))
((and (= 7 (length data))
(equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
(send-action stream chn "dies")
(close-port stream)
(exit)))
(inc-left-greets (get-username (car data)))
(write-greets))
((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/")
(inc-right-greets (get-username (car data)))
(write-greets))
((equal? ":!kirby" command)
(send-message stream chn "13●0ミ8☆"))
((equal? ":!dw" command)
(send-message stream chn (diceware (slist-ref data 4))))
((equal? ":!qotd" command)
(qotd stream chn))
((and (= 7 (length data))
(equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
(send-action stream chn "dies")
(close-port stream)
(exit))))
(main-loop stream)))
(let* ((io (make-connection "127.0.0.1" 6667)))