;Rebar
;Fixed for tuplets giving inexact numbers of ticks
;Rebar-repartitions the measures, searches for under/overfull, pad with rests, by DW, trivial mods by RTS
;FIXME-currently no support for nested tuplets
;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
(define ReBar::return #f)
(let ( (Input1 #f) (Input2 #f) (InitialTimeSig 1) (ScanAllStaffs #f) (TupletScaleFactor 1)  
(SplitAll #f))
 	
;MakeBlankRestDuration: makes a tied rest conglomerate of total duration Duration.
;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 (MakeRest Duration TryDuration Type)  ;set Type to "Blank" to get blanks.
	(begin
		(if (not (equal? TupletScaleFactor 1)) 
			(begin
				(d-InfoDialog (_ "There are unclosed tuplets in this bar.\n Please fix - see CheckTuplets command."))
				#f	;terminate
			)
		)
		(if (and (> Duration 0) (equal? (remainder 256 (denominator Duration)) 0)  ) ;check for valid Duration
			(begin	;when Duration is a valid duration...			

				(if  (<= (expt 1/2 TryDuration) Duration)	;see if we should add note of length TryDuration 
					(begin
						(InsertRest TryDuration Type)	
						(set! Duration (- Duration (* (expt 1/2 TryDuration) TupletScaleFactor)));now modify true Duration by what we just added.
						
					)
				)
				(if (<= TryDuration 8) 
					(MakeRest Duration (+ 1 TryDuration) Type)
				)			
			)
			#f				
		)
	);let
)

(define (InsertRest  Duration Type) ;inserts a rest of duration TryDuration, and makes it tied. denom of Duration must be power of 2.

	(if (equal? Type "Blank") (d-InsertBlankWholeNote)  (d-InsertWholeRest) )	;Insert correct type
	(if (equal? (d-GetType) "Appending")  (d-MoveCursorLeft))  ;now we're on it. (Don't need to go left if we're not appending)
	(while (> Duration 0) ;we keep diminishing until we got it.
		(begin
			(d-Diminish)
			(set! Duration (- Duration 1))
		)
	)
	;(d-MoveCursorRight)
)

;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 (> Duration 0) (equal? (remainder 256 (denominator EffectiveDuration)) 0)  ) ;check for valid Duration
			(begin	;when EffectiveDuration is a valid duration...			
				(if  (<= (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 (<= 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 (> 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 function:

(define (AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?) ;;set Pad? to #t if we should add blanks to underfull bars. 
(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)
		(begin (d-RefreshDisplay)
		(if (not (d-GetUserInput "Debug Message" 
			(string-append "Counter:" (number->string Counter) "\nTupletScaleFactor:" (number->string TupletScaleFactor) "\nTimeSig:" (number->string
				TimeSig)
			 ) "Hit OK when ready" ) ) (#f) ) 
	))
	
	(define (GetTimeSigChange)
		(d-RefreshDisplay);;forces the cached data about the time signature at the cursor to be updated (sigh)
		(set! TimeSig (string->number (d-InsertTimeSig "query=timesigname") ))
	);GetTimeSig
	

		
	(define (NextBreakInMeasure) ;move to next object in measure, skipping objects of no duration, return #t if we found something with nonzero duration
		(let ((GNB 0)(Moved #f))
			(while 
				(and 
					(d-NextObjectInMeasure) 
					(set! Moved #t)	;make sure we know we moved
					(equal? (GetNoteBeat) 0)	;do this so we don't run GetNoteBeat twice on same object (it could mess up counts?)

				)
			)
			(and Moved (not (equal? (GetNoteBeat) 0))) 	;return #t if we Moved and found something with nonzero duration
		)
	)
	
	(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) "LILYDIRECTIVE")
				(set! NoteBeat (/ (d-GetDurationInTicks) 1536))
			)
			(if (equal? (d-GetType) "CHORD" ) 
				(if (not (d-ToggleGrace "query="))	;if it's not a grace, continue; otherwise, leave it as 0.					
						(set! NoteBeat (/ (d-GetDurationInTicks) 1536))					
				)
			) 
			 NoteBeat	;return NoteBeat
			)
		)
	);GetNoteBeat
	(define (R-StartTuplet TupletFactor)	;note: doesn't modify TupletScaleFactor.
		(begin
			(d-StartTriplet)
			(if (boolean? (d-GetTuplet))
			(d-MoveCursorLeft))
			(d-SetTuplet  (number->string TupletFactor ) )
			(d-MoveCursorRight)
		)
	)

	(define (LoopThroughBar)   ;stops once we've met or surpassed the measure size, or run out of new notes.
		(if (and (< 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 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
		(disp "check Counter " Counter " and time sig " TimeSig "ok")
		;;ticks have granularity of 1 so we cannot accept a 1 discrepancy as meaning anything once we have reached a certain number of ticks - how many I am not sure, but try 383, fails with septuplet, try 255
	(if (and (None?) (not Pad?))
		(set! Counter TimeSig))
	(let ((top (numerator Counter)) (bottom (denominator Counter)))
		;(disp "We have top " top " bottom " bottom " div "  (/ (1+ top) bottom) " ok")
		(if  (and (> top 254) (equal? TimeSig (/ (1+ top) bottom)))
			(set! Counter (/ (1+ top) bottom))))
(disp "Set Counter " Counter "\n")			
		  (if (< Counter TimeSig) ;if measure too small, (going back first)
			(if Pad? 	; and the user wants us to pad,
				(begin
					(if (not (or (equal? (d-GetType) "None") (equal? (d-GetType) "Appending"))) 
						(d-MoveCursorRight) )	;Get to end of bar, past last object.
					(if Blank?
						(MakeRest (- TimeSig Counter) 0 "Blank")	;fill 'er up
						(MakeRest (- TimeSig Counter) 0 "" )
					)
					(if (d-MoveToMeasureRight)
						(AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?) ;if not done, move on and go from there.
						#t		;otherwise return true
					)
				)	
				(if MergeAndSplit?	;if user wants to merge/split,
					(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
							(AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?);now do the measure again 
						)
						#t	;return true if there's no more, we're done with staff.
					)
					;if NOT supposed to merge/split...
					(if (d-MoveToMeasureRight)	;see if at end of staff.
						(begin				;if not at end of staff...
							(d-MoveToMeasureLeft)
							#f	;if we're not supposed to pad or merge/split, stop here.  This measure had prob's
						)
						#t		;otherwise, staff is good.
					)
					
				)
			
			)
			;if it wasn't too small...

			(if  (equal? Counter TimeSig) ; and if measure is exactly full now...
				(if (NextBreakInMeasure) ;see if there's extra stuff that has duration,
					(if MergeAndSplit?	;if there IS and we're supposed to merge/split...
						(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
							(AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?) 	; rebar from that point onward.						
						)
						#f	;if user doesn't want us to split,return false.
							; this bar is over-full, user will fix.
					)
					(begin	;if there's NOT extra stuff in this measure...
						(if (not (None?))
							(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
								(AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?);having gone on to next measure, rebar again.
							)
							#t	;make sure we return true-done with staff.							
						)
					)
				)

				(if (and MergeAndSplit? (> Counter TimeSig)) ; if the measure is overfull, see if want to split.
					(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
										(AuditThisStaff TimeSig Pad? Blank? MergeAndSplit?) ;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
							)
						)					
					)
					
					#f	;just return false if they don't want to Merge/Split.
				)
			)
			
		)
	)
) ;define AuditThisStaff

;now actually do it:
(if ReBar::params
   (begin
	 (d-MoveToBeginning) 
	 (set! ReBar::return (AuditThisStaff (string->number (d-InsertTimeSig "query=timesigname")) #f #f #f))
    )
    (let ((Pad #f) (Blank #f)(MergeAndSplit #f))
	(set! Input1 (d-GetOption (string-append (_ "Search for under/overfull bars") stop 
				(_ "Pad underfull bars with rests") stop (_ "Pad underfull bars with blank rests")  stop
				(_ "Rebar-Merge underfull, split overfull bars") stop)))
	(set! Blank (equal? Input1 (_ "Pad underfull bars with blank rests")))
	(set! Pad (or (equal? Input1 (_ "Pad underfull bars with rests"))(equal? Input1 (_ "Pad underfull bars with blank rests") )))
	(set! MergeAndSplit (equal? Input1 (_ "Rebar-Merge underfull, split overfull bars")))
	(if Input1 (set! Input2  (d-GetOption (string-append  (_ "Entire Staff") stop (_ "This Point Onwards")  stop (_ "Entire Movement") stop ))) )
	(if (and Input1 Input2)  ;don't go if user cancelled
		(let ((position #f))
			(if (equal? Input2 (_ "Entire Movement")) (set! ScanAllStaffs #t))
			(set! position (GetPosition))	;let's try to return cursor to here when done.
			(if ScanAllStaffs (while (d-MoveToStaffUp)))	;Start at top staff, top voice
			(if (not (equal? Input2 (_ "This Point Onwards"))) (d-MoveToBeginning))
			(set! InitialTimeSig (d-InsertTimeSig "query=timesigname"))
			(set! InitialTimeSig (string->number InitialTimeSig))
			(let ((AllOK #t))
				(if (not (AuditThisStaff InitialTimeSig Pad Blank MergeAndSplit)) (set! AllOK #f))
				(while (and ScanAllStaffs AllOK (or (d-MoveToVoiceDown) (d-MoveToStaffDown))) ;RebarAll if appropriate.
					(begin
						(d-MoveToBeginning)
						(if (not (AuditThisStaff  InitialTimeSig Pad Blank MergeAndSplit) ) (set! AllOK #f))	;if AuditThisStaff returns #f, need to stop.
						)
					)
				(set! ReBar::return AllOK)
				(if AllOK 
					(apply d-GoToPosition position)	;end where we began, unless there were problems.
					))))))
)	;let