transpose-pitch-list now takes a :sort argument which is nil by default

mdedwards · Aug 27, 2024 · fc0b8d3 · fc0b8d3
1 parent eca983d
commit fc0b8d3
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 21 deletions.
diff --git a/src/chord.lsp b/src/chord.lsp
@@ -18,7 +18,7 @@
 ;;;
 ;;; Creation date:    July 28th 2001
 ;;;
-;;; $$ Last modified:  16:20:27 Sat Mar 16 2024 CET
+;;; $$ Last modified:  13:31:58 Tue Aug 27 2024 CEST
 ;;;
 ;;; SVN ID: $Id$
 ;;;
@@ -941,8 +941,9 @@ data: (
   (setq lowest (make-pitch lowest)
         highest (make-pitch highest))
   (setf (slot-value c 'data)
-        (transpose-pitch-list (data c) semitones
-                              :lowest lowest :highest highest))
+        (transpose-pitch-list
+         (data c) semitones :sort (auto-sort c) :lowest lowest
+                            :highest highest))
   ;; 8.2.11: got to do this here too now
   ;; MDE Sun Aug  6 11:26:39 2017 -- no, added to verify-and-store instead
   ;; (set-micro-tone result)

diff --git a/src/pitch.lsp b/src/pitch.lsp
@@ -19,7 +19,7 @@
 ;;;
 ;;; Creation date:    March 18th 2001
 ;;;
-;;; $$ Last modified:  12:24:57 Tue Aug 27 2024 CEST
+;;; $$ Last modified:  13:21:17 Tue Aug 27 2024 CEST
 ;;;
 ;;; SVN ID: $Id$
 ;;;
@@ -2623,9 +2623,6 @@ PITCH: frequency: 1760.000, midi-note: 93, midi-channel: 1
       collect (force-white-note p)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; SAR Tue Jan  3 10:51:55 EST 2012: Added robodoc info
-
 ;;; ****f* pitch/transpose-pitch-list
 ;;; DESCRIPTION
 ;;; Transpose the values of a list of pitch objects by a specified number of
@@ -2646,7 +2643,9 @@ PITCH: frequency: 1760.000, midi-note: 93, midi-channel: 1
 ;;; - :lowest. Don't transpose pitches which are lower than this
 ;;;   argument. Default = C-1 (midi note 0)  
 ;;; - :lowest. Don't transpose pitches which are higher than this
-;;;   argument. Default = B8 (midi note 119) 
+;;;   argument. Default = B8 (midi note 119)
+;;; - :sort. Whether to sort the pitch list from highest to lowest.
+;;;   Default = NIL
 ;;; 
 ;;; RETURN VALUE
 ;;; By default, the method returns a list of pitch objects. When the first
@@ -2699,9 +2698,7 @@ PITCH: frequency: 554.365, midi-note: 73, midi-channel: 0
 |#
 ;;; SYNOPSIS
 (defun transpose-pitch-list (pitch-list semitones
-                             &key
-                               (return-symbols nil)
-                               (package :sc)
+                             &key (sort nil) (return-symbols nil) (package :sc)
                                lowest highest)
 ;;; ****
   (setq lowest (make-pitch lowest)
@@ -2725,8 +2722,7 @@ PITCH: frequency: 554.365, midi-note: 73, midi-channel: 0
                 (setf (marks new) (my-copy-list (marks pitch))
                       (marks-before new) (my-copy-list (marks-before pitch))))
            collect new)))
-    ;;      (result (loop for p in pl collect (transpose p semitones))))
-    (setq result (sort-pitch-list result))
+    (when sort (setq result (sort-pitch-list result)))
     (if return-symbols
         (pitch-list-to-symbols result package)
         result)))
@@ -2872,9 +2868,6 @@ data: F4
                         p)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; SAR Tue Jan  3 12:26:26 EST 2012: Added robodoc info
-
 ;;; ****f* pitch/sort-pitch-list
 ;;; DESCRIPTION
 ;;; Sort a list of pitch objects from low to high based on their frequency
@@ -3174,7 +3167,8 @@ data: EF3
 ;;; 26th August 2024
 ;;; 
 ;;; DESCRIPTION
-;;; stretch a list of pitches by scaling and/or adding their intervals
+;;; Stretch a list of pitches by scaling and/or adding their intervals. Note
+;;; that all pitches will be rounded to the nearest note in the current scale.
 ;;; 
 ;;; ARGUMENTS
 ;;; a list of pitches, either as pitch objects or symbols

diff --git a/tests/sc-test-suite.lsp b/tests/sc-test-suite.lsp
@@ -17,7 +17,7 @@
 ;;;
 ;;; Creation date:    7th December 2011 (Edinburgh)
 ;;;
-;;; $$ Last modified:  21:03:24 Mon Aug 26 2024 CEST
+;;; $$ Last modified:  13:32:52 Tue Aug 27 2024 CEST
 ;;;
 ;;; SVN ID: $Id: sc-test-suite.lsp 6249 2017-06-07 16:05:15Z medward2 $
 ;;;
@@ -3570,15 +3570,16 @@
     (sc-test-check
       (listp pl)
       (listp (transpose-pitch-list pl 2))
-      (equalp (loop for p in (transpose-pitch-list pl 2) collect (data p))
+      (equalp (loop for p in (transpose-pitch-list pl 2 :sort t)
+                    collect (data p))
               '(D4 EF4 E4 F4 FS4 G4 AF4 A4 BF4 B4 C5 CS5))
-      (listp (transpose-pitch-list pl 2 :return-symbols t))
+      (listp (transpose-pitch-list pl 2 :return-symbols t :sort t))
       ;; MDE Tue Apr 10 08:13:14 2012 -- 
       ;; (equalp (print-simple-pitch-list pl)
       ;;      '(C4 CS4 D4 EF4 E4 F4 FS4 G4 AF4 A4 BF4 B4))
       (string= (print-simple-pitch-list pl nil)
                "(C4 CS4 D4 EF4 E4 F4 FS4 G4 AF4 A4 BF4 B4)")
-      (equalp (transpose-pitch-list pl 2 :return-symbols t) 
+      (equalp (transpose-pitch-list pl 2 :return-symbols t :sort t)
               '(D4 EF4 E4 F4 FS4 G4 AF4 A4 BF4 B4 C5 CS5)))))
 
 ;;; SAR Tue Jan  3 11:53:23 EST 2012