chopper.lsp
 Version 1.00  31 October 2004
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line  

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 Chops sound file into several pieces, rearranges their order, and splices
 them back together.

function

 (chopper:swap-list  lst [pos])
 Partition list and rearrange.
 (chopper:swap-list '(A B C D))  --> (C D A B)

 lst    - list
 pos    - flonum. Partition position, 0 < pos < 1, default 0.5

 return - list.

function

 (chopper:permute  lst [n [pos]])
 Create permutation by dividing source list in two parts and rearranging. 
 Repeat the process on n sublist.

 (chopper:permute '(A B C D E F G H) 0) --> (E F G H  A B C D)
 (chopper:permute '(A B C D E F G H) 1) --> (G H E F  C D A B)
 
 lst    - list.
 n      - integer. Number of swaps. Generally n should be less then 
          2 raised to length of lst
 pos    - flonum. Position of splice within sub list. 0 < p < 1.

 return - list

function

 (chopper:chop file [n])
 Chop soundfile into n equal pieces.

 file   - string. Fully qualified sound file name.
 n      - integer. Number of slices, default 2.
 return - list. A list of n sounds.    

function

 (function:splice sndlst)
 Combine list of sounds sequentially into a single sound object.

 sndlst - list. A list of sounds or sound vectors.
 return - sound or sound vector

function

 (chopper file [:splices][:shuffle])
 Take sound file, chop it into several equal length pieces, rearrange them,
 and splice the result back together.

 file     - string. Fully qualified sound file name.

 :splices - integer. Number of cuts to make on original sound. Default 2

 :shuffle - integer. Number of rearrangements, see chopper:permute for 
            description of the algorithm. Default 2

 return   - sound

;; chopper.lsp
;; Version 1.00  31 October 2004
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line  
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Chops sound file into several pieces, rearranges their order, and splices
;; them back together.
;;

(require 'sam)
(require 'slice)
(provide 'chopper)
(current-file "chopper")


;; @doc function chopper:swap-list
;; (chopper:swap-list  lst [pos])
;; Partition list and rearrange.
;; (chopper:swap-list '(A B C D))  --> (C D A B)
;;
;; lst    - list
;; pos    - flonum. Partition position, 0 < pos < 1, default 0.5
;;
;; return - list.
;;

(defun chopper:swap-list (lst &optional (pos 0.5))
  (let ((p (truncate (* (length lst) pos))))
    (append (slice lst p -1)(slice lst 0 (- p 1)))))


;; @doc function chopper:permute
;; (chopper:permute  lst [n [pos]])
;; Create permutation by dividing source list in two parts and rearranging. 
;; Repeat the process on n sublist.
;;
;; (chopper:permute '(A B C D E F G H) 0) --> (E F G H  A B C D)
;; (chopper:permute '(A B C D E F G H) 1) --> (G H E F  C D A B)
;; 
;; lst    - list.
;; n      - integer. Number of swaps. Generally n should be less then 
;;          2 raised to length of lst
;; pos    - flonum. Position of splice within sub list. 0 < p < 1.
;;
;; return - list
;;

(defun chopper:permute (lst &optional (n 0)(pos 0.5))
  (if (plusp n)
      (let ((p (truncate (* (length lst) pos))))
	(append (chopper:permute (slice lst p -1)(- n 1) pos)
		(chopper:permute (slice lst 0 (- p 1))(- n 1) pos)))
    (chopper:swap-list lst pos)))


;; @doc function chopper:chop
;; (chopper:chop file [n])
;; Chop soundfile into n equal pieces.
;;
;; file   - string. Fully qualified sound file name.
;; n      - integer. Number of slices, default 2.
;; return - list. A list of n sounds.    
;;

(defun chopper:chop (file &optional (n 2))
  (let (snd sr len dur points)
    (setq snd (sam:read file))
    (if (arrayp snd)
	(setq snd (aref snd 0)))
    (setq sr (snd-srate snd))
    (setq len (snd-length snd ny:all))
    (setq dur (/ len (float sr)))
    (setq points (append (range n 0 (/ dur (float n)))(list dur)))
    (do ((i 1 (+ i 1))
	 (start (car points)(nth i points))
	 (end (car (cdr points))(nth (+ i 1) points))
	 (acc '() (cons (sam:read file :time-offset start :dur (- end start)) acc)))
	((> i (length (cdr points)))(reverse acc))
      )))


;; @doc function chopper:splice
;; (function:splice sndlst)
;; Combine list of sounds sequentially into a single sound object.
;;
;; sndlst - list. A list of sounds or sound vectors.
;; return - sound or sound vector
;;

(defun chopper:splice (sndlst)
  (let (time-offset snd sr dur)
    (if (arrayp (car sndlst))
	(setq sr (float (snd-srate (aref (car sndlst) 0 ))))
      (setq sr (float (snd-srate (car sndlst))))) ; end if
    (setq time-offset 0)
    (simrep (i (length sndlst))
	    (prog2
		(setq snd (nth i sndlst))
		(at time-offset (cue snd))
	      (setq dur (/ (snd-length 
			    (if (arrayp snd) (aref snd 0) snd)
			    ny:all) sr))
	      (setq time-offset (+ dur time-offset))))))


;; @doc function chopper
;; (chopper file [:splices][:shuffle])
;; Take sound file, chop it into several equal length pieces, rearrange them,
;; and splice the result back together.
;;
;; file     - string. Fully qualified sound file name.
;;
;; :splices - integer. Number of cuts to make on original sound. Default 2
;;
;; :shuffle - integer. Number of rearrangements, see chopper:permute for 
;;            description of the algorithm. Default 2
;;
;; return   - sound
;;

(defun chopper (file &key (splices 2)(shuffle 2))
  (let (slst)
    (setq slst (chopper:chop file splices))
    (chopper:splice (chopper:permute slst shuffle))))