1;MetronomeMark
2;;Tempo-script by DW tweaked by RTS
3(let ( (tag "MetronomeMark")
4		(TempoChoice #f) (replace #f) (input "")  (AboveBelow? "^")
5		(MidiBPM 60) (ShowBPM? #f)(ValidBPM? #f) (BPMString "") (Go? #t)
6		(LilyString #f) (TempoAdjust #f)(DisplayString "") (InQuotes "")(duration "4") (bpm 60)  (OldLily  (not (d-CheckLilyVersion "2.12.0")))
7	)
8
9(define (GetBPM BaseBeat )  	;sets MidiBPM, ValidBPM?, BPMString
10	(let ((dotted #f)  (MetronomeMarkVisible #f)(defaultBPM "60") (len 1))
11		(set! defaultBPM
12			(cond
13				( (equal? TempoChoice "Presto" ) "168" )
14				( (equal? TempoChoice "Vivace" ) "140" )
15				( (equal? TempoChoice "Allegro" ) "120" )
16				( (equal? TempoChoice "Moderato" ) "108" )
17				( (equal? TempoChoice "Andante" ) "84" )
18				( (equal? TempoChoice "Adagio" ) "72" )
19				( (equal? TempoChoice "Largo" ) "60" )
20				( (equal? TempoChoice "Lento" ) "40" )
21				(else "60" )
22			)
23		)
24		(if (equal? "" BaseBeat)  (set! BaseBeat (d-GetUserInput (_ "Metronome Marking") (_ "Give unit beat duration (e.g., 4. for dotted-quarter) \n or enter n for none:") "4" )))
25
26		(if (or (equal? BaseBeat (_ "n") ) (equal? #f BaseBeat))
27			(begin
28				(set! ValidBPM? #f)	;if user doesn't want to use BPM.
29				(if (not BaseBeat) (set! Go? #f))
30			)
31			(begin 				; if user wants to use bpm...
32				(set! len (string-length BaseBeat) )
33				(set! dotted (equal? "." (substring BaseBeat (- len 1) len ))  ) ;see if a dot at end
34				(if dotted
35					(set! duration (substring BaseBeat 0 (- len 1)))  ;if there's a dot, cut it off from BaseBeat to get base duration.
36					(set! duration BaseBeat)
37				)
38				(if replace (set! defaultBPM (d-DirectiveGet-standalone-midibytes tag ))) ;use old BPM if there. Bug: Only good for 4=...
39
40				(set! bpm (d-GetUserInput (_ "Metronome Marking")  (string-append (_ "Give number of these ") BaseBeat (_ " beats per minute:")) defaultBPM ) )
41
42
43				(set! ValidBPM?   (not (equal? (and (string->number duration) (string->number bpm) ) #f)))  ;don't go unless both are numbers.
44				;don't go unless base duration is valid lilypond: (could go higher if wanted):
45				(set! ValidBPM? (and ValidBPM? (or   (equal? duration "1")(equal? duration "2")(equal? duration "4")(equal? duration "8")
46					(equal? duration "16")) ) )
47				(if (and bpm  (equal? ValidBPM? #t))
48					(begin
49						(if dotted (set! MidiBPM (number->string (floor (* (/ (string->number bpm) (string->number duration)) 6 ) ) ) )
50							(set! MidiBPM (number->string (floor (* (/ (string->number bpm) (string->number duration) ) 4))  ) )
51						);want * 3/2 for dotted,*4 since midi uses quarters and divide by duration,
52						(if (not ShowBPM? ) (set! ShowBPM?  (d-GetOption (string-append (_ "BPM Printed") stop (_ "BPM Not Printed") stop))))
53
54						(if (not ShowBPM?) (set! Go? #f))
55						(set! ShowBPM? (equal? ShowBPM? (_ "BPM Printed")))
56
57						(set! BPMString (string-append  BaseBeat "=" bpm ))
58
59					) ;begin
60					(d-WarningDialog (_ "Incorrect BPM syntax."))
61				)
62			)
63		)
64	);let
65);define GetBPM
66
67
68;procedure begins here.
69
70;see if there's already one there:
71(if (d-Directive-standalone?  tag)
72	;if we want to REPLACE an existing directive...
73	(let ((choice #f))
74		(set! replace 'edit)
75		(set! choice (d-GetOption  (string-append "Change"stop"Delete" stop cue-Advanced stop)))
76		(cond
77			;((boolean? choice)
78			;	(d-WarningDialog "Operation cancelled"))
79			((equal? choice "Change")
80				(set! replace #t ))
81			((equal? choice  cue-Advanced)
82				(if (not (d-DirectiveTextEdit-standalone tag))
83          (d-DirectiveDelete-standalone tag)))
84			((equal? choice "Delete")
85				(d-DirectiveDelete-standalone tag))
86		)
87	)
88)
89
90(if (boolean? replace)	;as long as we're not just editing an existing directive, we continue from here.
91	(begin
92		;get tempo text from user:
93		(set! TempoChoice (d-GetOption (string-append "Presto" stop "Vivace" stop "Allegro" stop
94			"Moderato" stop "Andante" stop "Adagio" stop "Largo" stop  "Lento" stop "Tempo Adjust (ritardando, etc.)" stop
95			"Custom tempo (e.g., Allegro assai)" stop "Beat Change (e.g., 4=4.)" stop "No Tempo Text-Metronome Only" stop)))
96		(if (not TempoChoice) (set! Go? #f))
97
98		(if (equal? TempoChoice "No Tempo Text-Metronome Only") (set! TempoChoice #f ) )
99		(if (equal? TempoChoice "Custom tempo (e.g., Allegro assai)") 	;read input if user wants custom:
100			(begin
101				(set! InQuotes "\"")
102				(set! TempoChoice (d-GetUserInput "Tempo setting" "Enter tempo text:" "Allegro assai" ) )
103				(if (not TempoChoice) (set! Go? #f))
104			)
105		)
106		(if (equal? TempoChoice  "Tempo Adjust (ritardando, etc.)") 	;for custom italic tempo adjustments
107			(begin
108				(set! TempoAdjust #t)
109				(set! InQuotes "\"")
110				(set! TempoChoice (d-GetUserInput "Tempo adjust" "Enter text:" "rit." ))
111				(if (not TempoChoice) (set! Go? #f))
112				(if Go? (set! AboveBelow? (d-GetOption (string-append "Neutral" stop "Above" stop  "Below" stop ))))
113				(if (not AboveBelow?) (set! Go? #f))
114				(set! AboveBelow?
115					(cond
116						((equal? AboveBelow? "Above") "^" )
117						((equal? AboveBelow? "Below") "_" )
118						(else "-")
119					)
120				)
121			)
122		)
123		(if (equal? TempoChoice "Beat Change (e.g., 4=4.)" )
124			(begin
125				(set! Go? #f)
126				(d-BeatChange)
127			)
128		)
129		(if (equal? TempoChoice "") (set! TempoChoice #f))
130
131		;TempoChoice should now have the desired text to be shown, or #f is nothing is to be shown.
132		;TempoAdjust = #t if italics should be used.
133
134		(if Go? (GetBPM "" ))	;find out what bpm the user wants and whether to print it(but not if user cancelled)
135
136		; now set DisplayString-what denemo shows.
137
138		(if ShowBPM?
139			(begin   ;if we print the BPM:
140				(if TempoChoice
141					(set! DisplayString (string-append TempoChoice "(" BPMString ")" ))
142					(set! DisplayString BPMString)
143
144				)
145			)
146			;if NOT showing BPM...
147			(if ValidBPM?
148				(set! DisplayString (string-append (if TempoChoice TempoChoice "") "[" BPMString "]" ))
149				(set! DisplayString TempoChoice)
150			)
151		)
152
153		;now need to set LilyString...
154		(if TempoChoice (set! TempoChoice (string-append InQuotes TempoChoice InQuotes) )) ;if more than 1 word, may need quotes.
155
156		(if TempoAdjust
157			(begin		;if we want to REPLACE an existing tempo directive...
158				(if TempoChoice (set! LilyString (string-append "s8*0" AboveBelow? "\\markup { \\italic "  TempoChoice "} " )))
159				(if ValidBPM? (set! LilyString (string-append LilyString "\\tempo " BPMString " ")))
160			) 	;if TempoAdjust=#t.
161			(begin		;when TempoAdjust = #f...
162				(if ShowBPM?
163					(if OldLily
164						;if using OldLily syntax....
165						(if TempoChoice
166							(set! LilyString
167								(string-append  "s8*0" AboveBelow? "\\markup \\bold { " TempoChoice " (\\smaller \\general-align #Y #DOWN"
168								" \\note #\"" duration  "\" #.75 = " bpm  ")} \\once \\override Score.MetronomeMark #'transparent = ##t \\tempo "  BPMString " ")
169							)
170							(set! LilyString  (string-append "\\tempo "  BPMString " "))
171						)
172
173						;if we're NOT using OldLily syntax:
174						(set! LilyString (string-append "\\tempo " (if TempoChoice (string-append TempoChoice " ") "") BPMString " "))
175					)
176					;if we're NOT showing BPM...
177					(if OldLily
178						(set! LilyString (if TempoChoice (string-append " s8*0" AboveBelow? "\\markup \\bold { " TempoChoice " } " )))
179						(if TempoChoice (set! LilyString (string-append "\\tempo " TempoChoice " ")))
180					)
181				)
182			)
183		)
184
185		;now make the directive...
186		(if Go?
187			(begin
188				(if (not replace) (d-DirectivePut-standalone tag ) )
189				(if LilyString (d-DirectivePut-standalone-postfix tag LilyString ) )
190				(d-DirectivePut-standalone-grob  tag "MetronomeMark")
191				(d-DirectivePut-standalone-graphic  tag (string-append "\n" DisplayString "\nDenemo\n12"))
192				(d-DirectivePut-standalone-gy tag -25)
193				(d-DirectivePut-standalone-minpixels tag 10 )
194				(d-DirectivePut-standalone-ty tag 85 ) ;;try -40 instead of 85 for above-the-staff
195				(if (equal? ValidBPM? #t)
196					(begin
197						(d-DirectivePut-standalone-override tag (logior DENEMO_OVERRIDE_TAGEDIT DENEMO_OVERRIDE_TEMPO DENEMO_OVERRIDE_STEP))
198						(d-DirectivePut-standalone-midibytes tag MidiBPM)
199					)
200				)
201				(d-SetSaved #f)
202				(d-RefreshDisplay)
203				(d-ChooseCondition) ;;; this did not fire using d-PopUpMenu so changed to RadioBoxMenu
204				(d-MoveCursorRight))))))