; rc40

(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))))))

; tilde represents shift

(define alpha "abcdefghijklmnopqrstuvwxyz0123456789.? ~")
(define shift "ABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(,/|~")

(define (c->i c) (string-index c alpha))
(define (i->c i) (string-ref alpha i))

; convert list [~burrito ~~sale~~ 2 ~2 ~47.99] to "Burrito SALE 2 @ $7.99"
(define (rc40->string cs)
  (let loop ((cs cs) (locked? #f) (ss (list)))
    (cond ((null? cs) (list->string (reverse ss)))
          ((and locked? (pair? (cdr cs)) (char=? (car cs) #\~) (char=? (cadr cs) #\~))
            (loop (cddr cs) #f ss))
          (locked? (loop (cdr cs) #t (cons (string-ref shift (c->i (car cs))) ss)))
          ((and (pair? (cdr cs)) (char=? (car cs) #\~) (char=? (cadr cs) #\~))
            (loop (cddr cs) #t ss))
          ((and (pair? cs) (char=? (car cs) #\~))
            (loop (cddr cs) #f (cons (string-ref shift (c->i (cadr cs))) ss)))
          (else (loop (cdr cs) #f (cons (car cs) ss))))))

; convert "Burrito SALE 2 @ $7.99" to list [~burrito ~~sale~~ 2 ~2 ~47.99]
(define (string->rc40 str)
  (let loop ((cs (string->list str)) (locked? #f) (ss (list)))
    (cond ((null? cs)
            (if locked?
                (reverse (cons #\~ (cons #\~ ss)))
                (reverse ss)))
          (locked?
            (if (string-index (car cs) shift)
                (loop (cdr cs) #t
                      (cons (string-ref alpha (string-index (car cs) shift)) ss))
                (loop cs #f (cons #\~ (cons #\~ ss)))))
          ((string-index (car cs) shift)
            (if (and (pair? (cdr cs)) (string-index (cadr cs) shift))
                (loop cs #t (cons #\~ (cons #\~ ss)))
                (loop (cdr cs) #f
                      (cons (string-ref alpha (string-index (car cs) shift))
                            (cons #\~ ss)))))
          (else (loop (cdr cs) #f (cons (car cs) ss))))))

(define (rc40-init key)
  (let ((kvec (make-vector 40)) (klen (string-length key)) (j 0)
        (key (list->string (string->rc40 key))))
    (do ((i 0 (+ i 1))) ((= i 40)) (vector-set! kvec i i))
    (do ((i 0 (+ i 1))) ((= i 40) kvec)
      (set! j (modulo (+ j (vector-ref kvec i)
                (c->i (string-ref key (modulo i klen)))) 40))
      (let ((t (vector-ref kvec i)))
        (vector-set! kvec i (vector-ref kvec j))
        (vector-set! kvec j t)))))

(define (rc40-stream key)
  (let ((i 0) (j 0) (kvec (rc40-init key)))
    (lambda ()
      (set! i (modulo (+ i 1) 40))
      (set! j (modulo (+ j (vector-ref kvec i)) 40))
      (let ((t (vector-ref kvec j)))
        (vector-set! kvec j (vector-ref kvec i))
        (vector-set! kvec i t))
      (vector-ref kvec (modulo (+ (vector-ref kvec i) (vector-ref kvec j)) 40)))))

(define (rc40-plus a b) (modulo (+ a b) 40))
(define (rc40-minus a b) (modulo (- b a) 40))

(define (rc40-encipher key text)
  (let ((rc40 (rc40-stream key)))
    (let loop ((ts (map c->i (string->rc40 text))) (zs '()))
      (if (null? ts) (rc40->string (map i->c (reverse zs)))
        (loop (cdr ts) (cons (rc40-plus (rc40) (car ts)) zs))))))

(define (rc40-decipher key text)
  (let ((rc40 (rc40-stream key)))
    (let loop ((ts (map c->i (string->rc40 text))) (zs '()))
      (if (null? ts) (rc40->string (map i->c (reverse zs)))
        (loop (cdr ts) (cons (rc40-minus (rc40) (car ts)) zs))))))

(display (rc40-encipher "tedunangst" "Programming Praxis sharpens your saw.")) (newline)
(display (rc40-decipher "tedunangst" "5cxaxlfrfhy6kh38fbplm0mDko58xs.l9Hkz8")) (newline)