diff --git a/anna.scm b/anna.scm index a569a69..7ced079 100755 --- a/anna.scm +++ b/anna.scm @@ -10,8 +10,10 @@ (ice-9 regex) (rnrs exceptions)) -(define +channels+ '("#tildetown" "#bots")) -;; (define +channels+ '("#bots")) +;; (define +channels+ '("#tildetown" "#bots")) +(define +channels+ '("#bots")) + +(load "greets.scm") (define (scdr lst) "Safe CDR. Returns CDR of lst, if it is a list. Returns lst otherwise." @@ -87,6 +89,8 @@ (define (send-action stream chn action) (format stream "PRIVMSG ~a :\x01ACTION ~a\x01\r\n" chn action)) +;;; TODO: this can be refactored into a function that takes one char and +;;; removes it, and composing that into more complex functions. (define (input-filter str) "Remove escaped chars to avoid fooling the bot into performing bad actions." (define (remove-escaped-chars lst) @@ -97,6 +101,15 @@ (else (cons (car lst) (remove-escaped-chars (cdr lst)))))) (list->string (remove-escaped-chars (string->list str)))) +(define (remove-newlines str) + (define (remove-newlines-aux lst) + (cond ((null? lst) '()) + ((or (equal? (string (car lst)) "\n") + (equal? (string (car lst)) "\r")) + (remove-newlines-aux (cdr lst))) + (else (cons (car lst) (remove-newlines-aux (cdr lst)))))) + (list->string (remove-newlines-aux (string->list str)))) + (define (evaluate str) "Evaluate the given string in a sandbox without crashing on errors." (guard (ex @@ -118,7 +131,7 @@ (define (timezone user) (let ((path (string-append "/home/" user "/.tz"))) (if (access? path R_OK) - (read-file path) + (remove-newlines (read-file path)) (string-append user " has not set their timezone. Use `echo '' > ~/.tz' to add your timezone.")))) @@ -161,19 +174,30 @@ sublink))) (else "Symbol not found in documentation.")))) -(define *left-greets* '()) -(define *right-greets* '()) - (define (greets category name) (if (not (assoc name category)) "0" (number->string (cdr (assoc name category))))) +(define (write-greets) + (define (greet-values alst) + (define (actual-values al) + (cond ((null? al) (format #f "~%")) + (else (string-append (format #f "~%(cons ~s ~s)" (caar al) (cdar al)) + (actual-values (cdr al)))))) + (format #f "(list ~a)" (actual-values alst))) + (call-with-output-file "greets.scm" (lambda (stream) + (format stream + "(define *left-greets* ~a)~%(define *right-greets* ~a)~%" + (greet-values *left-greets*) + (greet-values *right-greets*))))) + + ;; has to be separate functions since modifying the argument won't change global state (define (inc-left-greets name) (if (not (assoc name *left-greets*)) (set! *left-greets* (acons name 1 *left-greets*)) - (assoc-set! *left-greets* name (+ 1 (cdr (assoc name *left-greets*)))))) + (set! *left-greets* (assoc-set! *left-greets* name (+ 1 (cdr (assoc name *left-greets*))))))) (define (inc-right-greets name) (if (not (assoc name *right-greets*)) @@ -238,9 +262,11 @@ " vs \\o - " (number->string (all-greets *left-greets*))))) ((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)) ((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)) ((and (= 7 (length data)) (equal? (list-tail data 4) '("ACTION" "shoots" "anna"))) (send-action stream chn "dies") diff --git a/greets.scm b/greets.scm new file mode 100644 index 0000000..172fe47 --- /dev/null +++ b/greets.scm @@ -0,0 +1,6 @@ +(define *left-greets* (list +(cons "opfez" 1) +)) +(define *right-greets* (list +(cons "opfez" 3) +))