Half speed/double speed script

[Stefan Westerfeld <stefan space twc de>]

   Hi!

I finally wrote a script for this TODO item:

SCRIPTS:
- PianoRoll: script to lengthen/shorten notes, probably for the
  beginning a script which allows playing notes at half speed or double
  speed would be sufficient (the advantage is that it can be accelerator
  bound)

I'll include it here for review; it works fine, but there are two
issues mentioned in the source code. One is related to the pattern
view, and I think it can be simply postponed until someone experiences
actual problems with it (the pattern view is experimental after all).

The other issue is that the script doesn't affect events (such as
balance events which belong to the notes you want to "double speed") at
all due to API issues (see comment below). 

But even if the API was extended, there is still a GUI issue: if the
user wants to "double speed" a section, he probably wants to select the
notes and all the associated events. With the current GUI it is
impossible (or at least hard) as far as I understand, to get all these
events selected (you'd need to manually open all different event types
and select them).

So maybe GUI-wise the right fix here is not to "double speed" a
selection, but to allow setting start and end markers in the part. This
would automatically make clear which events should also be affected.

Maybe its useful to commit the script as it is before the event problems
are sorted out, though.

;; 
;; Copyright (C) 2003-2006 Stefan Westerfeld, stefan space twc de
;; 
;; This software is provided "as is"; redistribution and modification
;; is permitted, provided that the following disclaimer is retained.
;;
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; In no event shall the authors or contributors be liable for any
;; direct, indirect, incidental, special, exemplary, or consequential
;; damages (including, but not limited to, procurement of substitute
;; goods or services; loss of use, data, or profits; or business
;; interruption) however caused and on any theory of liability, whether
;; in contract, strict liability, or tort (including negligence or
;; otherwise) arising in any way out of the use of this software, even
;; if advised of the possibility of such damage.

;;
;; (bse-script-register <func> <options> <category> <blurb> <author> <license> ARGS...)
;;

(bse-script-register 'part-half-speed
		     ""
                     (N_ "/Part/Half Speed")
		     (N_ "This script has the effect that the selected notes "
			 "will be played twice as slow than before. To achieve "
			 "this, the note length of each note is doubled, and "
			 "the start positions are adjusted accordingly.")
		     "Stefan Westerfeld"
		     "Provided \"as is\", WITHOUT ANY WARRANTY: see .scm file for details"
		     (bse-param-part   (N_ "Part")))

(bse-script-register 'part-double-speed
		     ""
                     (N_ "/Part/Double Speed")
		     (N_ "This script has the effect that the selected notes "
			 "will be played twice as fast than before. To achieve "
			 "this, the note length of each note is halved, and "
			 "the start positions are adjusted accordingly.")
		     "Stefan Westerfeld"
		     "Provided \"as is\", WITHOUT ANY WARRANTY: see .scm file for details"
		     (bse-param-part   (N_ "Part")))

;; half speed/double speed: common part of the implementation
;;
;; FIXME: this doesn't affect control events at all 
;;
;; Reason: There is no elegant way to get all control events from a part.
;;   The only function that is close to what is needed is
;;   bse-part-list-selected-controls, but it only lists controls given of a
;;   specified the control type, so the API would force us to iterate over all
;;   possible control types.
(define (part-speed-change part factor undo-group-name)
  (if (not (bse-is-part part))
      (bse-exit-error 'text1 (_ "No valid part supplied")))
  (let* ((notes             (bse-part-list-selected-notes part))
	 (error-check-1     (if (< (length notes) 1) (bse-exit-error 'text1 (_ "No notes selected"))))
	 (get-note-start    (lambda (rec) (bse-rec-get rec 'tick)))
	 (start             (apply min (map get-note-start notes)))
	 (remove-old-note
	   (lambda (rec)
	     (bse-part-delete-event
	       part
	       (bse-rec-get rec 'id))))
	 (truncation	    #f)
	 (multiply-and-check-truncation
	   (lambda args
	     (let*
	       ((exact-result	  (apply * args))
	        (truncated-result (truncate exact-result)))
	       (if
		 (not (= exact-result truncated-result))
		 (set! truncation #t))
	       truncated-result)))
	 (add-new-note
	   (lambda (rec)
	     ;; we have first removed every note that was selected and now we
	     ;; reinsert these notes with new offset/duration
	     ;;
	     ;; to preserve the old selection, we reselect the new notes again
	     (bse-part-select-event
	       part
	       ;; using bse-part-insert-note-auto is pattern-view unfriendly,
	       ;; as it doesn't preserve channels; however, if we would naively
	       ;; preserve channels, then we could loose notes due to collisions
	       ;;
	       ;; i'll fix it when someone encounters problems in real world
	       ;; use cases
	       (bse-part-insert-note-auto
		 part
		 ;; compute new position relative to the first event
		 (+
		   (multiply-and-check-truncation
		     (- (bse-rec-get rec 'tick) start)
		     factor)
		   start)
		 (multiply-and-check-truncation
		   (bse-rec-get rec 'duration) factor)
		 (bse-rec-get rec 'note)
		 (bse-rec-get rec 'fine-tune)
		 (bse-rec-get rec 'velocity))))))
	(bse-item-group-undo part undo-group-name)
	(for-each remove-old-note notes)
	(for-each add-new-note notes)
        (bse-item-ungroup-undo part)
	(if truncation
	  (bse-script-message 'warning 'text1
	      (_ "some note durations or lengths needed to be truncated "
		 "(use undo to get your original data back)")))))

;; half speed: implementation
(define (part-half-speed part)
  (part-speed-change part 2 "part-half-speed"))

;; double speed: implementation
(define (part-double-speed part)
  (part-speed-change part 0.5 "part-double-speed"))

;; vim:set sw=2 sts=2 ts=8:

   Cu... Stefan
-- 
Stefan Westerfeld, Hamburg/Germany, http://space.twc.de/~stefan