;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                          Utility Library                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; Return a random element from a list.
;;; (define (random-elt list) ...)

;;; Curries a two argument function
;;; (define (curry f) ...)

;;; Flattens an arbitrary number of arguments into one list
;;; (define (flatten . x) ...)

;;; Truncate a string - remove whitespace characters from both ends.
;;; (define (truncate-string str) ...)

;;; A read-line version that truncates input and returns #f on end
;;; of file.
;;; (define (read-inp-line) ...)

;;; Converts an input line to a kust  string.
;;; (define (line->list string) ...)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

;;; Return a random element from a list.
(define (random-elt list)
  (list-ref list (random (length list))))

;;; Curries a two argument function
(define (curry f)
  (lambda (x)
    (lambda (y) (f x y))))

;;; Flattens an arbitrary number of arguments into one list
(define (flatten . x)
  (define (flatten-aux x)
    (cond ((null? x) '())
          ((not (pair? x)) (list x))
          (else (append (flatten-aux (head x))
                        (flatten-aux (tail x))))))
  (flatten-aux x))

;;; User input and text parsing

;;; Truncate a string - remove whitespace characters from both ends.
(define (truncate-string str)
  (define len (string-length str))
  (define (first n)
    (cond ((= n len) #f)
          ((char-whitespace? (string-ref str n))
           (first (add1 n)))
          (else n)))
  (define (last n)
    (cond ((= n 0) #f)
          ((char-whitespace? (string-ref str (sub1 n)))
           (last (sub1 n)))
          (else n)))
  (let* ((f (first 0))
         (l (and f (last len))))
    (if f (substring str f l) "")))

;;; A read-line version that truncates input and returns #f on end
;;; of file.
(define (read-inp-line)
  (let ((x (read-line)))
    (and (not (eof-object? x)) (truncate-string x))))

;;; Convert an input string to a list.
(define (line->list str)
  ;; this will convert the string to an input list
  (no-errors
    (let ((result (read-from-string (string-append "(" str ")"))))
      (and (list? result) result))))

;;; Returns a new string where all characters are lower-case
(define (string-lowercase str)
      (list->string
       (map char-downcase (string->list str))))

;;; Returns a new string where all characters are upper-case
(define (string-uppercase str)
      (list->string
       (map char-downcase (string->list str))))

;;; Replaces characters that are not easy to type on a keyboard with
;;; question marks.
(define (remove-non-alpha str)
  (define (replace-chars n)
    (if (< n (string-length str))
      (begin (unless (<= 32 (as <integer> (string-ref str n)) 126)
               (set! (string-ref str n) #\?))
             (replace-chars (add1 n)))
      str))
  (replace-chars 0))

;;; Muffles a string by replacing portions of the string with
;;; other interesting sequents.
(define muffle
  (letrec ((transform (lambda (msg clip)
                        (regexp-replace* (head clip) msg (tail clip))))
           (iter (lambda (msg transforms)
                   (if (empty? transforms)
                     msg
                     (iter (transform msg (head transforms))
                           (tail transforms))))))
    (let ((clips (list (cons (regexp "[pbfvwm]") "")
                       (cons (regexp "[fvszrl]") "h")
                       (list (cons (regexp "[bp]") "m")
                             (cons (regexp "[dt]") "n")
                             (cons (regexp "[kg]") "ng"))
                       (cons (regexp (echos-ns
                                      "([bcdfghjklmnpqrstvwxz])"
                                      "[bcdfghjklmnpqrstvwxz]+"))
                             "\\1"))))
      (lambda (msg)
        (let ((clip (random-elt clips)))
          (if (list? clip)
            (iter msg clip)
            (transform msg clip)))))))


;;; Encrypts using a simple find-and-replace method
(define obfuscate
  (letrec ((transform (lambda (msg clip)
                        (regexp-replace* (head clip) msg (tail clip))))
           (iter (lambda (msg transforms)
                   (if (empty? transforms)
                     msg
                     (iter (transform msg (head transforms))
                           (tail transforms))))))
    (let ((clips (list (cons (regexp "a") ".#")
                       (cons (regexp "e") "$*^")
                       (cons (regexp "sh") "@%")
                       (cons (regexp "s") "!f%a")
                       (cons (regexp "ch") "&&sh&&")
                       (cons (regexp "i") "*n%%")
                       (cons (regexp "get") "cur&^se")
                       (cons (regexp "m") "$#pork#@")
                       (cons (regexp "q") "^#kill%20student@"))))
      (lambda (msg)
        (iter msg clip)))))

;;; returns an string encrypted with 'obfuscate' to its original form
(define de-obfuscate
  (letrec ((transform (lambda (msg clip)
                        (regexp-replace* (head clip) msg (tail clip))))
           (iter (lambda (msg transforms)
                   (if (empty? transforms)
                     msg
                     (iter (transform msg (head transforms))
                           (tail transforms))))))
    (let ((clips (list
                  (cons (regexp "\\.\\#") "a")
                  (cons (regexp "\\$\\*\\^") "e")
                  (cons (regexp "\\@\\%") "sh")
                  (cons (regexp "\\!f\\%a") "s")
                  (cons (regexp "\\&\\&sh\\&\\&") "&&ch&&")
                  (cons (regexp "\\*n%%") "i")
                  (cons (regexp "cur\\&\\^se") "get")
                  (cons (regexp "\\$\\#pork\\#\\@") "m")
                  (cons (regexp "\\^\\#kill\\%20student\\@") "q"))))
      (lambda (msg)
        (iter msg clip)))))

;;; Returns a string with the time on the computer where this function
;;; is evaluated.
(define (server-time)
  (let* ((add0 (lambda (n)
                 (if (< n 10)
                   (string-append "0" (number->string n))
                   (number->string n))))
         (now (seconds->date (current-seconds)))
         (hour (struct-ref now 2)))
    (echos-ns
     (struct-ref now 4) "/" (struct-ref now 3) " "
     (cond ((= hour 0) 12)
           ((> hour 12) (- hour 12))
           (else hour)) ":"
           (add0 (struct-ref now 1)) ":" (add0 (struct-ref now 0))
           (if (<= 1 hour 12) "am" "pm"))))