; chaocipher

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (string-index c str)
  (let loop ((ss (string->list str)) (k 0))
    (cond ((null? ss) #f)
          ((char=? (car ss) c) k)
          (else (loop (cdr ss) (+ k 1))))))

(define (shift first past offset str)
  (define (cycle str offset)
    (append (drop offset str) (take offset str)))
  (let ((str (string->list str)))
    (list->string (append
      (take first str)
      (cycle (take (- past first) (drop first str)) offset)
      (drop past str)))))

(define (shift-left n str)
  (shift 1 14 1
    (shift 0 26 n str)))

(define (shift-right n str)
  (shift 2 14 1
    (shift 0 26 1
      (shift 0 26 n str))))

(define (cipher left right from to str)
  (let loop ((old (string->list str))
             (left left) (right right) (new '()))
    (if (null? old)
        (list->string (reverse new))
        (let ((n (string-index (car old) (if (eq? from 'left) left right))))
          (loop (cdr old) (shift-left n left) (shift-right n right)
                (cons (string-ref (if (eq? to 'left) left right) n) new))))))

(define (encipher left right str)
  (cipher left right 'right 'left str))

(define (decipher left right str)
  (cipher left right 'left 'right str))

(define ct "HXUCZVAMDSLKPEFJRIGTWOBNYQ")
(define pt "PTLNBQDEOYSFAVZKGJRIHWXUMC")

(display (encipher ct pt "WELLDONEISBETTERTHANWELLSAID")) (newline)
(display (decipher ct pt "OAHQHCNYNXTSZJRRHJBYHQKSOUJY")) (newline)

OAHQHCNYNXTSZJRRHJBYHQKSOUJY
WELLDONEISBETTERTHANWELLSAID