; voice leading -- 4 part voice writing (see HW 6, problem 4)
; AUTHOR: *EDIT* (with help from Gary T. Leavens)

; You must fill in each place in the
; following where it says EDIT below

; this code uses: "abs", "and", "not", the "List" cluster

;;;;;;;;;;;;;;;;NOTES;;;;;;;;;;;;;;;;
(cluster Note
  ; Export: create, degree, equal, closest,
  ; thirdAbove, fifthAbove, octaveAbove, octaveBelow, display

  ; SUMMARY: degrees of a scale in a key, with tonic = 1 (immutable)

  (rep down)   ; a pun... down gets the rep from abstract in CLU...

  ; ABSTRACTION FUNCTION: r: rep represents the note of degree (down r)
  ; REP INVARIANT: true

  (define create (n)
    ; TYPE: Int -> Note
    ; EFFECT: return the Note representing n
    (Note n))

  (define degree (n)
    ; TYPE: Note -> Int
    ; EFFECT: return the degree of n
    (down n))

  (define equal (n1 n2)
    ; TYPE: Note, Note -> bool
    ; EFFECT: is n1 the same degree as n2?
    EDIT)

  (define lower (n1 n2)
    ; TYPE: Note, Note -> bool
    ; EFFECT: is n1 lower than n2?
    EDIT)

  (define higher (n1 n2)
    ; TYPE: Note, Note -> bool
    ; EFFECT: is n1 higher than n2?
    EDIT)

  (define closest (n1 n2 n3 direction)
    ; TYPE: Note, Note, Note -> Note
    ; REQUIRES: direction is either -1 or +1
    ; EFFECT: return the closest of n2 and n3 to n1;
    ; if they are equally close, break ties in favor of the opposite sign
    ; of direction (that if direction is -1, pick the higher of n2 and n3)
    EDIT)

  (define thirdAbove (n)
    ; TYPE: Note -> Note
    ; EFFECT: return the Note whose degree is 2 more than n
    EDIT)

  (define fifthAbove (n)
    ; TYPE: Note -> Note
    ; EFFECT: return the Note whose degree is 4 more than n
    EDIT)

  (define octaveAbove (n)
    ; TYPE: Note -> Note
    ; EFFECT: return the Note whose degree is 7 more than n
    EDIT)

  (define octaveBelow (n)
    ; TYPE: Note -> Note
    ; EFFECT: return the Note whose degree is 7 less than n
    EDIT)

  (define display (n)
    ; TYPE: Note -> ()
    ; EFFECT: print the degree of n
    EDIT)
) ; Note


(define makeHigher (x y)
  ; TYPE: Note, Note -> Note
  ; EFFECT: return smallest note y' such that y' is 0 or more octaves
  ;         above y and such that y' > x
  (if (Note$lower x y)
      y
    (makeHigher x (Note$octaveAbove y))))


;;;;;;;;;;CHORDS;;;;;;;;;;;;;;;;
(cluster Chord
  ; Export: create, soprano, alto, tenor, bass, display

  ; SUMMARY: 4-part chords (immutable)

  (rep b t a s)

  ; ABSTRACTION FUNCTION: r: rep represents a chord with bass b,
  ; tenor t, alto a, and soprano s
  ; REP INVARIANT: true

  (define create (bs ten alt sop)
    ; TYPE: Note, Note, Note, Note -> Chord
    ; EFFECT: return the chord with bass bs, tenor ten, alto alt, soprano sop
    (Chord bs ten alt sop))

  (define soprano (c)
    ; TYPE: Chord -> Note
    ; EFFECT: Return the soprano note of c
    EDIT)

  (define alto (c)
    ; TYPE: Chord -> Note
    ; EFFECT: Return the alto note of c
    EDIT)

  (define tenor (c)
    ; TYPE: Chord -> Note
    ; EFFECT: Return the tenor note of c
    EDIT)

  (define bass (c)
    ; TYPE: Chord -> Note
    ; EFFECT: Return the bass note of c
    EDIT)

  (define display (c)
    ; TYPE: Chord -> ()
    ; EFFECT: display the sop, alto, tenor and bass of c (in that order)
    (begin
     (Note$display (s c))
     (Note$display (a c))
     (Note$display (t c))
     (Note$display (b c))))
) ; Chord


;;;;;;;;;;;SOME OPERATIONS ON LISTS;;;;;;;;;;;;;
(define append (lst1 lst2)
  ; TYPE: all a. a list, a list -> a list
  ; EFFECT: return the list of the elements of lst1 followed by those in lst2
  EDIT)

(define nl-member? (n lst)
  ; TYPE: note, Note list -> bool
  ; EFFECT: is n an element of lst?
  EDIT)

(define nl-display (nl)
  ; TYPE: Note list -> ()
  ; EFFECT: display each note of nl
  (if (List$null? nl)
      0 ; do nothing
    (begin
     (Note$display (List$car nl))
     (nl-display (List$cdr nl)))))

; you might want to EDIT in some other operations on lists here...


;;;;;;;;;;;;CHORD COMPLEXES;;;;;;;;;;;;;;;;
(cluster ChordComplex
  ; Export:  create, delete-note, choose-closest, elim-lower,
  ; empty?, any-thirds?, elements, display

  ; SUMMARY: List of notes for a potential chord (mutable)

  (rep third fifth octave base)
  ; you can EDIT this to use a different rep
  ; if you wish, but this one is fine.

  ; ABSTRACTION FUNCTION: r: rep represents
  ; a list of notes possible for a given chord
  ; such that taking any one of them out also
  ; takes out the other notes in the list that
  ; differ by an octave
  ; REP INVARIANT: for r: rep,
  ; the list (third r) contains notes of
  ; degree (Note$degree (base r)) + 2 + k*7 (for positive k)
  ; the list (fifth r) contains notes (Note$degree (base r)) + 4 + k*7
  ; the list (octave r) contains notes (Note$degree (base r)) + 7 + k*7

  (define create (bass sop)
    ; TYPE: Note, Note -> ChordComplex
    ; EFFECT: returns a new chord complex for a chord based on bass.
    (begin
     (set sop
	  (Note$octaveAbove
	   (makeHigher bass sop)))
     (ChordComplex
      (octave-list (Note$thirdAbove bass) sop)
      (octave-list (Note$fifthAbove bass) sop)
      (octave-list (Note$octaveAbove bass) sop)
      bass)))

  (define delete-note (cc n)
    ; TYPE: ChordComplex, Note -> bool
    ; REQUIRES: n is an element of cc
    ; MODIFIES: cc
    ; EFFECT: delete n and all its octaves from cc
    EDIT)

  (define choose-closest (cc n direction)
    ; TYPE: ChordComplex, Note, Int -> Note
    ; REQUIRES: direction is either -1 or +1 and cc is not empty
    ; MODIFIES: cc
    ; EFFECT: return the closest note to n in cc,
    ; breaking ties in favor of the lower if direction
    ; is +1 and the higher if direction is -1,
    ; and delete the note returned and all its octaves from cc.
    EDIT)

  (define elim-lower (cc n)
    ; TYPE: ChordComplex, Note -> ()
    ; MODIFIES: cc
    ; EFFECT: Deletes all notes from cc that are lower than n
    EDIT)

  (define empty? (cc)
    ; TYPE: ChordComplex -> Bool
    ; EFFECT: is cc empty?
    EDIT)

  (define any-thirds? (cc)
    ; TYPE: ChordComplex -> Bool
    ; EFFECT: are there any thirds above the bass left in cc?
    (not (List$null? (third cc))))

  (define display (cc)
    ; TYPE: ChordComplex -> ()
    ; EFFECT: print the notes of cc
    (nl-display (elements cc)))

  (define elements (cc)
    ; TYPE: ChordComplex -> Note list
    ; EFFECT: return a list of the notes in cc (without duplicates)
    EDIT)

  ; internal opertions
  ; you might want to EDIT some internal operations here

  (define octave-list (first max)
    ; TYPE: Note, Note -> Note list
    ; EFFECT: return the list of all Notes that are 0 or more octaves higher
    ; than first and no higher than max.  The list is in increasing order.
    (if (Note$higher first max)
        (List$nil)
        (List$cons first (octave-list (Note$octaveAbove first) max))))

) ; ChordComplex


(define signum (x)
  ; TYPE: Int -> Int
  ; EFFECT: return -1 if x is negative, 0 if x is 0, +1 if x is positive
  (+ (* (< x 0) -1) (> x 0)))


(define voice-leading (initial-chord bass-line)
  ; TYPE: Chord, Note list -> Chord list
  ; REQUIRES: the first element of bass-line is (Chord$bass initial-chord)
  ; EFFECT: returns chord list following rules of the problem statement
  (List$cons
   initial-chord
   (voice-leading-aux
    initial-chord
    (List$cdr bass-line)
    (Chord$bass initial-chord))))

(define voice-leading-aux (last-chord bass-line last-bass)
  ; TYPE: Chord, Note list, Note -> Note list
  ; EFFECT: returns a chord list following rules of problem statement
  ; for initial chord last-chord and bass line with (Chord$bass last-chord)
  ; added on to the front of bass-line.  (last-bass is a convenience here.)
  (if (List$null? bass-line)
      (List$nil)
    (begin
     (set dir ; direction of bass motion
          (signum (- (Note$degree (List$car bass-line))
                   (Note$degree last-bass))))
     (set bass
          (List$car bass-line))
     (set cc
          (ChordComplex$create
	   bass
	   (Chord$soprano last-chord)))

     (set tenor
          (ChordComplex$choose-closest
	   cc
	   (Chord$tenor last-chord) dir))
     (ChordComplex$elim-lower cc tenor)

     (set alto EDIT)
     EDIT

     (set soprano EDIT)

     (set new-chord EDIT)

     (List$cons EDIT))))


; test data
(set n-c (Note$create 1))
(set n-d (Note$create 2))
(set n-e (Note$create 3))
(set n-f (Note$create 4))
(set n-g (Note$create 5))
(set n-a (Note$create 6))
(set n-b (Note$create 7))

(set ic
     (Chord$create
      n-c
      n-g
      (Note$octaveAbove n-e)
      (Note$octaveAbove
       (Note$octaveAbove n-c))))

(set bl
     (List$cons
      n-c
      (List$cons
       n-f
       (List$cons 
	n-g
	(List$cons
	 n-c
	 (List$nil))))))
(define song-display (song)
  (if (List$null? song)
      0
    (begin
     (Chord$display (List$car song))
     (print 0) ; spacing...
     (song-display (List$cdr song)))))

;(set song (voice-leading ic bl))

(set hard-bl
     (List$cons
      n-c
      (List$cons
       n-g
       (List$cons
	n-e
	(List$cons
	 (Note$octaveAbove (Note$octaveAbove
			    n-a))
	 (List$nil))))))

;(set song (voice-leading ic hard-bl))