;oginal note
(define simple-octave 0)
(define simple-notename 0)
(define simple-accidental 0)

;transposition amount
(define delta-octave 0)
(define delta-notename 0)
(define delta-accidental 0)

(define 
  (text2pitch x) 
  (let (
	(value (- (char->integer x) 99)))
    (if (< value 0) (set! simple-notename (+ 7 value)))
    (if (>= value 0) (set! simple-notename value)))
  )

(define lily->pitch
  (lambda (string x)
    (if (< x (string-length string))
      (begin
	 (if (= x 0) (text2pitch (string-ref string x)))
	 (if (> x 0)
	   (begin
	    (if (equal? #\i (string-ref string x))
		(set! simple-accidental (+ simple-accidental 1)))
	    (if (equal? #\e (string-ref string x))
		(set! simple-accidental (- simple-accidental 1)))
	    (if (equal? #\' (string-ref string x))
		(set! simple-octave (+ simple-octave 1)))
	    (if (equal? #\, (string-ref string x))
		(set! simple-octave (- simple-octave 1)))
	   )
	 )
         (lily->pitch string (+ x 1))
       )
    )))

(define reset-values
  (lambda ()
   (begin 
    (set! simple-octave 0)
    (set! simple-notename 0)
    (set! simple-accidental 0)
    )
   )
)
;;;;copied from chord-name.scm in lilypond-1.6.5

(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))

(define (pitch::semitone pitch)
  (+ (* (car pitch) 12)
  (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
  (caddr pitch)))

(define (pitch::transpose pitch delta)
  (let ((simple-octave (+ (car pitch) (car delta)))
	(simple-notename (+ (cadr pitch) (cadr delta))))
  (let ((octave (+ simple-octave (quotient simple-notename 7)))
	(notename (modulo simple-notename 7)))
  (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
	(pitch::semitone `(,octave ,notename 0)))))
	`(,octave ,notename ,accidental)))))

;;;;end of ApplyToSelection derivitive

(define get-delta
  (lambda ()
    (begin
       (set! delta-octave (string->number (d-GetUserInput "Transposition - Instructions" "Enter the number of octaves to transpose by. negative number will transpose down" "0")))
       (set! delta-notename (string->number (d-GetUserInput "Transposition - Instructions" "Enter the number of diatonic steps to transpose by. This should be a positive number" "0")))
       (set! delta-accidental (string->number (d-GetUserInput "Transposition - Instructions" "Enter the number of accidentals to transpose by. positive number sharpen while negative numbers flaten" "0")))
     )))

(define transposed (lambda ()
  (begin
  (pitch::transpose `(,simple-octave ,simple-notename ,simple-accidental) `(,delta-octave ,delta-notename ,delta-accidental) ))))

(define transposed-diff (lambda ()
  (begin
    (let
       ((octave (- (list-ref (transposed) 0) simple-octave))
        (notename (- (list-ref (transposed) 1) simple-notename))
        (accidental (- (list-ref (transposed) 2) simple-accidental))
       )
       `(,octave ,notename ,accidental))
  )))

(define apply-transposition (lambda ()
  (begin 
    (reset-values)
    (lily->pitch (d-GetNotes) 0)
    (display `(,simple-octave ,simple-notename ,simple-accidental))
    (display (transposed-diff))
    (display (transposed))
    (d-DiatonicShift (number->string (* 7 (list-ref (transposed-diff) 0))))
    (d-DiatonicShift (number->string (list-ref (transposed-diff) 1)))
    (if (= (list-ref (transposed-diff) 2) 2) 
      (begin
	(d-Sharpen)
	(d-Sharpen)))
    (if (= (list-ref (transposed-diff) 2) 1) (d-Sharpen))
    (if (= (list-ref (transposed-diff) 2) -2) 
      (begin 
	(d-Flatten)
	(d-Flatten)))
    (if (= (list-ref (transposed-diff) 2) -1) (d-Flatten))
)))

(define this-proc (lambda ()
  (if (d-NextNote)
    (begin 
	(apply-transposition) 
        (this-proc)    
))))

(d-GoToBeginning)
(get-delta)
;(display (transposed-diff))
(apply-transposition)
(this-proc)