; rolling code
(define fob1
(let ( ; permanent read-only memory
(id 111) (k 948579992)
(a 69069) (c 1234567) (m 4294967296))
(let ( ; non-volatile read/write memory
(seed (modulo (* id k) m)))
(define (encrypt x) (bitwise-xor x k))
(define (next s) (modulo (+ (* a s) c) m))
(lambda (signal)
(set! seed (next seed))
(if signal (receiver id seed signal) 'DENY)))))
(define fob2
(let ( ; permanent read-only memory
(id 222) (k 948579992)
(a 69069) (c 1234567) (m 4294967296))
(let ( ; non-volatile read/write memory
(seed (modulo (* id k) m)))
(define (encrypt x) (bitwise-xor x k))
(define (next s) (modulo (+ (* a s) c) m))
(lambda (signal)
(set! seed (next seed))
(if signal (receiver id seed signal) 'DENY)))))
(define receiver
(let ( ; permanent read-only memory
(k 948579992)
(a 69069) (c 1234567) (m 4294967296))
(let ( ; non-volatile read/write memory
(len 0) (ids (vector))
(seeds (vector)) (prevs (vector)))
(define (decrypt x) (bitwise-xor x k))
(define (next s) (modulo (+ (* a s) c) m))
(define (ok s z)
(let loop ((i 256) (s (next s)))
(cond ((zero? i) #f)
((= (vector-ref seeds z) s) s)
(else (loop (- i 1) (next s))))))
(define (which id)
(let loop ((i 0))
(cond ((= i (vector-length ids)) -1)
((= (vector-ref ids i) id) i)
(else (loop (+ i 1))))))
(case-lambda
((new-ids) ; programming mode
(set! len (length new-ids))
(set! ids (list->vector new-ids))
(set! seeds (make-vector len 0))
(set! prevs (make-vector len 0)))
((id seed signal) ; operating mode
(let ((z (which id)))
(cond ((negative? z) 'DENY) ; unrecognized fob
((ok seed z) => ; recognized fob and code
(lambda (s)
(vector-set! seeds z s)
(vector-set! prevs z s) signal))
((= (next (vector-ref prevs z)) seed)
(vector-set! seeds z seed) ; resynchronize
(vector-set! prevs z seed) signal)
(else ; recognized fob, unrecognized code
(vector-set! prevs z seed) 'DENY))))))))
(receiver '(111 222))
(display (fob1 'LOCK)) (newline)
(display (fob1 'LOCK)) (newline)
(do ((i 300 (- i 1))) ((zero? i)) (fob1 #f))
(display (fob1 'LOCK)) (newline)
(display (fob1 'LOCK)) (newline)
(display (fob2 'UNLOCK)) (newline)
(display (fob2 'UNLOCK)) (newline)