<?xml version="1.0"?>
<Denemo>
  <merge>
    <title>A Denemo Keymap</title>
    <author>AT, JRR, RTS</author>
    <map>
      <row>
        <action>ReBar</action>
        <scheme>;Rebar-repartitions the measures, by DW, trivial mods by RTS
;FIXME-currently no support for nested tuplets
;EV2
;fixed:cancel didn't cancel, removed unused variables
;notes: (d-GetType) returns CHORD TIMESIG LILYDIRECTIVE TUPOPEN TUPCLOSE (tuplets) Appending
;Variable descriptions:
;SplitAll set to #f allows user to decide whether to split across barlines; set to #t, splits always.
;TupletScaleFactor: e.g. if we're inside a triplet, scale durations by 2/3
;TupletList: lists tuplet scale factors currently active; eventually use for nested tuplets.
;NumTuplets: number of nestings of tuplets. 0 when no tuplets, 1 when inside a triplet, etc...

(let ( (Input #f) (InitialTimeSig 1) (RebarAll #f)(SplitAll #f) (TupletScaleFactor 1)  (TupletList #f) (NumTuplets 0) )

;SplitIntoNext:splits a measure by inserting a barline, ending in next bar
(define (SplitIntoNext) ;custom version of SplitIntoNext used here
(begin
	(d-SetMark)
	(if   (d-MeasureRight)
		(begin  (d-CursorLeft)  
        	        (d-Cut)
	                (d-CursorRight)
        	        (d-InsertMeasureBefore)
	    	)
		(begin
        		(d-GoToEnd)
			(d-Cut)
        		(d-AppendMeasure)
			(d-MoveToMeasureRight)
		)
 	)
	(d-Paste)	;now, position the cursor at begin of new bar:
	(d-MoveToMeasureLeft)  
	(d-MoveToMeasureRight)
	(d-UnsetMark)
))

(define (CustomDeleteBarline)
(let  ((type (d-GetType)) );don't try it if not at the end of bar
  (if (or (equal? type "Appending" ) (equal? type "None" ) )
    (begin (d-SetMark)
	(if (d-MoveToMeasureRight) ;;we don't want to delete next bar if there isn't one!
	(begin (d-MeasureLeft) ;; Now we're at the beginning of that measure
		(d-Cut)
		(d-DeleteMeasure)
		(d-Paste) )
	(d-UnsetMark) ;this is to clear the mark if we set it, but were at end of staff
)))))

;MakeDuration: makes a tied note conglomerate of total duration Duration.
;set Side to "Left" to have the shorter component durations on left, "Right" for other way.
;note that using "Left will leave the rightmost note tied since we will tie into next bar.
;IsConsecutive is set to #t when it recurses in order to make it add a dot instead of adding the next TryDuration.  Externally, call it always set to #f
;externally, call with TryDuration=0 to start with trying out whole notes.  Internally it will crank this up as it recurses.

(define (MakeDuration Duration Side TryDuration IsConsecutive) 
	(let ((EffectiveDuration 0))
		(set! EffectiveDuration (/ Duration TupletScaleFactor))	;if inside a tuplet, need to 
													;account for that by extending the effective duration proportionately.
		(if (and (&gt; Duration 0) (equal? (remainder 256 (denominator EffectiveDuration)) 0)  ) ;check for valid Duration
			(begin	;when EffectiveDuration is a valid duration...			
				(if  (&lt;= (expt 1/2 TryDuration) EffectiveDuration)	;see if we should add note of length TryDuration 
					(begin
						(if IsConsecutive 
							(begin
								(if (equal? Side "Right") (d-MoveCursorLeft));b/c when adding on the Right, we moved the cursor Right already
								(d-AddDot) ;if previous duration was there, just add a dot.
								(if (equal? Side "Right") (d-MoveCursorRight));returning it to its former position
							)
							(begin	;if previous duration wasn't...
								(set! IsConsecutive #t)	;so that next smaller duration will know to just add a dot if it's there
								(InsertOn Side TryDuration)
							)
						)	
						(set! Duration (- Duration (* (expt 1/2 TryDuration) TupletScaleFactor)));now modify true Duration by what we just added.
						(if (and (equal? Duration 0) (equal? Side "Right")) ;rightmost note entered on Side=Right, don't leave tied.
							(begin
								(d-MoveCursorLeft)
								(d-ToggleTie)
								(d-MoveCursorRight)
							)
						)
					)
					(set! IsConsecutive #f)	;when we don't add this TryDuration, set this to #f.
				)
				(if (&lt;= TryDuration 8) 
					(MakeDuration Duration Side (+ 1 TryDuration) IsConsecutive)
				)			
			)
			#f	
			
			
		)
	);let
)

(define (InsertOn Side Duration) ;inserts a note of duration TryDuration, and makes it tied. denom of Duration must be power of 2.

		(d-Paste)  ;paste, but then must get on top of the notes just pasted...
		(d-MoveCursorLeft)  ;now we're on it. 
	(d-Change0) ;start with whole, 
	(while (&gt; Duration 0) ;and keep diminishing until we got it.
		(begin
			(d-Diminish)
			(set! Duration (- Duration 1))
		)
	)
	(d-ToggleTie)
	(if (equal? Side "Right") (d-MoveCursorRight) )
)

;Now here's the rebarring function:

(define (RebarThisStaff TimeSig) 
(let ( (Counter 0) (Excess 0) (LeftOver 0)(Inquiry #f))
	;Counter keeps track of the duration of the notes of the bar as we proceed chord by chord.	

	;Debugger can be useful for bug-fixing
	(define (Debugger)
		(if (not (d-GetUserInput "Debug Message" 
			(string-append "Counter:" (number-&gt;string Counter) "\nTupletScaleFactor:" (number-&gt;string TupletScaleFactor)
			 ) "Hit OK when ready" ) ) (#f) ) 
	)
	
	(define (GetTimeSigChange)
		(set! TimeSig (string-&gt;number (d-InsertTimeSig "query=timesigname") ))
	);GetTimeSig
	
	(define (GetAnacrusis TagName)	;TagName = "Anacrusis" or "ShortMeasure"
		(let ((AnacrusisPF #f)(AnacrusisSize 0))
			(set! AnacrusisPF (d-DirectiveGet-standalone-postfix TagName))
			;look only at number of 128ths-final #, cutting off final space: (NOTE: assumes it's partial 128*xxx)
			(set! AnacrusisPF (substring AnacrusisPF 13   ))  ;remove final spaces, if there.
			(if (string-index AnacrusisPF #\sp )
				(set! AnacrusisPF (substring AnacrusisPF 0  (string-index AnacrusisPF #\sp) ))
			)
			(set! AnacrusisSize (/ (string-&gt;number AnacrusisPF) 128 ))
			 (- TimeSig AnacrusisSize)	;return this:it's how much space the Anacrusis accounts for.
		)
	)
	
	(define (NextBreakInMeasure) ;move to next object in measure, skipping TUPCLOSEs, return #t if there is one.
		(let ((Moved #f))
			(while (and 
				(d-NextObjectInMeasure) 
				(set! Moved #t)
				(if (equal? (d-GetType) "TUPCLOSE")
					(begin
						(CloseTuplet)
						#t	;return true so will loop again.
					)
					#f
				)
			))
			(and Moved (not (equal? (d-GetType) "TUPCLOSE")))	;return true if we moved and reached a non TUPCLOSE.
		)
	)
	(define (GetNoteBeat )	;get duration of a note as a fraction of a whole note, e.g. dotted quarter = 3/8
		(let ((note 0) (len 0 ) (DotIndex 0) (NumDots 0) (NoteBeat 0))
			(begin
			(if (equal? (d-GetType) "TIMESIG") 
				(if (equal? Counter 0) ;encountering a TimeSig change mid-measure requires user intervention
					(GetTimeSigChange)
					(begin
						(d-InfoDialog "This time signature change is in the middle of the bar.\n
						Please run the command again after you've fixed this.")
						(set! NoteBeat #f) ;this should halt the script after it's returned.
					)
				)
			)
			(if (equal? (d-GetType) "TUPOPEN") ;FIXME-no support for nested tuplets.
				(begin
					(set! TupletScaleFactor (string-&gt;number (d-GetTuplet))) ;FIXME-allow nested tuplets.
					(set! NumTuplets (+ 1 NumTuplets))
				)
			)
			(if (and 	(equal? (d-GetType) "LILYDIRECTIVE") 
					(or (equal? (d-DirectiveGetTag-standalone) "Anacrusis" ) (equal? (d-DirectiveGetTag-standalone) "ShortMeasure" ) ))
				(set! NoteBeat (GetAnacrusis (d-DirectiveGetTag-standalone)) )	;GetAnacrusis returns how much space it takes up.
			)
			(if (equal? (d-GetType) "TUPCLOSE") (CloseTuplet) )
			(if (equal? (d-GetType) "CHORD" ) 
				(if (not (d-ToggleGrace "query="))	;if it's not a grace, continue; otherwise, leave it as 0.
					(begin
						(set! note (d-GetNoteDuration))
						(set! len (string-length note) )
						(set! DotIndex (string-index note #\.) )
						( if DotIndex (begin		;if DotIndex is a valid number...
							(set! NumDots (- len DotIndex) )
							(set! note (substring note 0 DotIndex) )  ;trim off dots
						) )
						(set! note (string-&gt;number note))
						(set! NoteBeat ( / 1 note))
						;now modify base NoteBeat by (2-2^(-NumDots))
						(set! NoteBeat (* NoteBeat (- 2 (expt 2 (* -1 NumDots)))))				
					)
				)
			)
			(* TupletScaleFactor NoteBeat)	;return NoteBeat--modified by TupletScale Factor.
			)
		)
	);GetNoteBeat
	(define (R-StartTuplet TupletFactor)	;note: doesn't modify TupletScaleFactor.
		(begin
			(d-StartTriplet)
			(if (boolean? (d-GetTuplet))
			(d-MoveCursorLeft))
			(d-SetTuplet  (number-&gt;string TupletFactor ) )
			(d-MoveCursorRight)
		)
	)
	(define (CloseTuplet)
		(begin 
			(set! TupletScaleFactor 1) ;FIXME-doesn't allow nested tuplets.
			(set! NumTuplets (+ -1 NumTuplets))
		)
	)
	(define (LoopThroughBar)   ;stops once we've met or surpassed the measure size, or run out of new notes.
		(if (and (&lt; Counter TimeSig) (d-NextObjectInMeasure) )	;as long as the Counter is less than a full bar, and there's more stuff to process...
			(begin
				(set! Counter (+ Counter (GetNoteBeat)) )	;we increment the Counter,
				(LoopThroughBar)	;and keep going until done with the bar.
				
			)
		)
	)
	;here's the actual rebarring algorithm
	(while (d-PrevObjectInMeasure))	;go to beginning of measure
	(set! Counter (+ Counter (GetNoteBeat)) );read the first note in to get started...NOTE: if GetNoteBeat= #f this will terminate execution.
	(LoopThroughBar)	;then loop through the rest of the bar until counter equals or overshoots the measure size in TimeSig,
					; or the measure's done being processed
	(if (&lt; Counter TimeSig) ;if measure too small, 		
		(if (d-MoveToMeasureRight)  ;we see if there is a next measure; if so we want to merge the two and redo this measure.
			(begin
				(d-MoveCursorLeft) ;move onto the barline 
				(CustomDeleteBarline) ;delete it
				(RebarThisStaff TimeSig) ;now do the measure again 
			)
			#t	;return true if there's no more, we're done with staff.
		) 
		;if it wasn't too small...
		(if  (= Counter TimeSig) ; and if measure is exactly full now...
			(if (NextBreakInMeasure) ;if there's extra stuff that can be removed,
				(begin
					(if (not (= TupletScaleFactor 1)) (d-EndTuplet)) ;if need be, end the tuplet in this bar, then restart it in next
					(SplitIntoNext) ;cut off extra stuff (ending up in next bar)
					(if (not (= TupletScaleFactor 1)) (R-StartTuplet TupletScaleFactor)) ;restart the tuplet in following bar if needed
					(RebarThisStaff TimeSig) 	; rebar from that point onward.						
				)
				(begin	;if there's not extra stuff in this measure...
					(d-MoveCursorRight)
					(if (not (= TupletScaleFactor 1)) (d-EndTuplet)) ;if need be, end the tuplet in this bar, then restart it in next
					(if (d-MoveToMeasureRight) ;if there's another measure...
						(begin 
							(if (not (= TupletScaleFactor 1)) (R-StartTuplet TupletScaleFactor)) ;restart the tuplet in following bar if needed
							(RebarThisStaff TimeSig) ;having gone on to next measure, rebar again.
						)
						(begin
							(d-MoveCursorLeft)
							(d-DeleteObject)	;if we were in final measure, delete the EndTuplet we just put in.
							#t	;make sure we return true-done with staff.
						)
					)
				)
			)			
			(if (&gt; Counter TimeSig) ; if the measure break should fall in middle of a note... we've gotta split the note we're on.
				(begin
					(set! Excess (- Counter TimeSig)) ;this is how much of that note to put in next measure,						
					(if (equal? (remainder 256 (denominator (/ Excess TupletScaleFactor))) 0)  ;if we don't have to start a tuplet, we're good.
						(begin
							;query the user: should we split the note, or let him/her do it?				
							(if (not SplitAll) (set! Inquiry (d-GetOption (string-append "Split This Note" stop "Split All" stop "Stop Here" stop))) )
							;need to stop if we hit cancel
							(if (equal? Inquiry "Split All") (set! SplitAll #t))
							(if (or SplitAll (equal? Inquiry "Split This Note") (equal? Inquiry "Split All")) 
								(begin	;we're going to split across the barline and march on.
									(set! LeftOver (- (GetNoteBeat) Excess)) ;duration that stays in left measure.		
									(if (d-NextObjectInMeasure) ;if there're more stuff after the current stuff, chop it off to deal with it next bar
										(begin
											(SplitIntoNext)
											;now go back onto the note that should be split by barline.
											(d-MoveToMeasureLeft)
											(d-MoveToMeasureRight)
											(d-MoveCursorLeft)	;now on barline.
											(d-MoveCursorLeft) ;now we're back on the last note of that bar.
										)
									)
									;now we gotta get a copy of the note to split.
									(d-SetMark)
									(d-Cut) ;now the right note's cut onto the clipboard...
									(MakeDuration LeftOver "Left" 0 #f)	;syntax to add custom duration to each measure, shortest durations to left.
									(if (not (= TupletScaleFactor 1))  ;end the tuplets in this bar if need be, restart in next...
										(begin (d-MoveCursorRight) (d-EndTuplet)) )							
									(if (not (d-MoveToMeasureRight)) (d-InsertMeasureAfter))	;need to add a new measure if it ain't there.
									(if (not (= TupletScaleFactor 1)) ;start the tuplets in next bar if need be.
										(R-StartTuplet TupletScaleFactor) )
									(MakeDuration Excess "Right" 0 #f)	;add with shortest durations on right
									(RebarThisStaff TimeSig)	;continue 							
								)
								#f ;if user cancelled or Stopped Here, return false
							)
						)
						(begin
							(d-InfoDialog "This measure's discrepancy requires a tuplet.\nPlease adjust manually and run this script again.")
							#f	;return false
						)
					)					
				)
			)
		)
	)
)
) ;define RebarThisStaff
;now actually do it:
	(set! Input (d-GetOption (string-append "Entire Staff" stop "From This Point Onwards" stop "All Staves" stop)))
	(if Input ;don't go if user cancelled
	(begin
		(if (equal? Input "All Staves") (set! RebarAll #t))
		(d-PushPosition)	;let's try to return cursor to here when done.
		(if RebarAll (while (d-MoveToStaffUp)))	;Start at top staff, top voice
		(if (not (equal? Input "From This Point Onwards")) (d-MoveToBeginning))
		(set! InitialTimeSig (d-InsertTimeSig "query=timesigname"))
		(set! InitialTimeSig (string-&gt;number InitialTimeSig))
		(let ((AllOK #t))
			(if (not (RebarThisStaff InitialTimeSig)) (set! AllOK #f))
			(while (and RebarAll AllOK (or (d-MoveToVoiceDown) (d-MoveToStaffDown))) ;RebarAll if appropriate.
				(begin
					(d-MoveToBeginning)
					(if (not (RebarThisStaff  InitialTimeSig) ) (set! AllOK #f))	;if RebarThisStaff returns #f, need to stop.
				)
			)
			(if AllOK (d-PopPosition))	;end where we began, unless there were problems.
		)
	)
	)
)	;let</scheme>
        <label>Adjust the Measure Lengths</label>
        <tooltip>Removes gaps in duration of measures, redistributes the notes according to the time signature.</tooltip>
      </row>
    </map>
  </merge>
</Denemo>
