; matrix rotation

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)
    (if (null? value)
        (vector-set! m i (make-vector columns))
        (vector-set! m i (make-vector columns (car value))))))

(define (matrix-rows x) (vector-length x))

(define (matrix-cols x) (vector-length (vector-ref x 0)))

(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))

(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))

(define-syntax for
  (syntax-rules ()
    ((for (var first past step) body ...)
      (let ((ge? (if (< first past) >= <=)))
        (do ((var first (+ var step)))
            ((ge? var past))
          body ...)))
    ((for (var first past) body ...)
      (let* ((f first) (p past) (s (if (< first past) 1 -1)))
        (for (var f p s) body ...)))
    ((for (var past) body ...)
      (let* ((p past)) (for (var 0 p) body ...)))))

(define (rotate source)
  (let* ((n (matrix-rows source))
         (m (matrix-cols source))
         (target (make-matrix m n)))
    (for (i 0 m)
      (for (j 0 n)
        (matrix-set! target i j
          (matrix-ref source (- n j 1) i))))
    target))

(define m '#( #(a b c) #(d e f) #(g h i) #(j k l) #(m n o)))
(display (rotate m)) (newline)

(define (rotate! m)
  (define (rot4 m topleft topright botleft botright)
    (let ((t (matrix-ref m (car botright) (cdr botright))))
      (matrix-set! m (car botright) (cdr botright)
        (matrix-ref m (car botleft) (cdr botleft)))
      (matrix-set! m (car botleft) (cdr botleft)
        (matrix-ref m (car topright) (cdr topright)))
      (matrix-set! m (car topright) (cdr topright)
        (matrix-ref m (car topleft) (cdr topleft)))
      (matrix-set! m (car topleft) (car topright) t)))
  (let ((n (matrix-rows m)))
    (for (i 0 (quotient n 2))
      (let ((top i) (bottom (- n i 1))
            (left i) (right (- n i 1)))
        (for (j 0 (- n i i 1))
          (rot4 m (cons top (+ left j))
                  (cons (+ top j) right)
                  (cons bottom (- right j))
                  (cons (- bottom j) left)))))
    m))

(define m '#( #(a b c d e) #(f g h i j) #(k l m n o) #(p q r s t) #(u v w x y)))
(display (rotate! m)) (newline)
(display (rotate! m)) (newline)
(display (rotate! m)) (newline)
(display (rotate! m)) (newline)