%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Pitch manipulations in Scheme %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Creating Transpositions and inversions
% Transpositions

#(define (transpose ls int mod)
   (map (lambda (x) (modulo (+ int x) mod)) ls))

% Set first pitch as "0" and maintain interval relations

#(define (zero-pset ls mod)
   (transpose ls (* (car ls) -1) mod))

% Inversion
#(define (invert ls mod)
   (map (lambda (x) (modulo x mod))		         ; keep inside modulos (e.g. 12 for 12-tone rows)
     (map (lambda (y) (+ y (car ls)))		         ; sum the inverted intervals with the first pitch of the original pitch set
       (map (lambda (z) (* z -1)) (zero-pset ls mod))))) % invert zeroed pitch set signals

% Apply the chosen operation in different ways depending on the number of arguments

#(define (pset-op op pset . ls)
   (cond 
   ((null? ls) (op pset))
   ((null? (cdr ls)) (op pset (car ls)))
   (else (op pset (car ls) (cadr ls)))))

% 12 tone specific operations (always inside modulos 12)

#(define (12transpose pset n) (transpose pset n 12))

#(define (12invert pset) (invert pset 12))

#(define (12retrograde pset) (reverse pset))

#(define (12retinvert pset) (reverse (invert pset 12)))

% Transpose the original 12 tone row according to the intervals of the inverted form

#(define (squareTranspose 12set n)
   (list-ref (invert (zero-pset 12set 12) 12) n))




%%%%%%%%% Some further pitch manipulations (no used yet)
% List all transpositions

#(define (all-transpositions pset mod)
   (let loop ((x pset) (y '()))
     (if (null? x)
         (reverse y)
         (loop (cdr x) (cons (transpose (zero-pset pset) (car x) mod) y)))))

% list all transpositions in ascending order

#(define (all-transpositions-order pset mod)
   (let loop ((x pset) (y '()) (z 0))
     (if (null? x)
         (reverse y)
         (loop (cdr x) (cons (transpose pset z mod) y) (+ z 1)))))

% list all inversions

#(define (all-inversions pset mod)
   (let loop ((x (all-transpositions pset mod)) (y '()))
     (if (null? x)
         (reverse y)
         (loop (cdr x) (cons (invert (car x) mod) y)))))

% List all inversions in ascending order

#(define (all-inversions-order pset mod)
   (let loop ((x (all-transpositions-order pset mod)) (y '()))
     (if (null? x)
         (reverse y)
         (loop (cdr x) (cons (row-invert (car x) mod) y)))))