File: CheckScore.scm

package info (click to toggle)
denemo 2.6.49-0.2
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 66,916 kB
  • sloc: ansic: 94,587; lisp: 38,713; xml: 22,675; python: 1,930; sh: 1,239; makefile: 642; yacc: 288; sed: 93
file content (154 lines) | stat: -rw-r--r-- 6,930 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
;;;CheckScore
(define CheckScore::return #f)
(define-once CheckScore::ignore 0)
(define-once CheckScore::error-position #f)

(let ((old-volume (d-MasterVolume)))
    (d-MasterVolume 0)    
    (if CheckScore::params
        (set! CheckScore::ignore CheckScore::params))    
    (if (d-Directive-score? "CriticalCommentsAmended")
        (d-CriticalCommentary))
        
(if (not CheckScore::params);; interactive
	;;;Check Parts are same in each movement.
	(let ((parts #f))
		(define (collect-parts)
			(define parts (list (d-StaffProperties "query=denemo_name")))
			(while (d-MoveToStaffDown)
				(set! parts (cons (d-StaffProperties "query=denemo_name") parts)))
			parts)
		(define (differ list1 list2)
				(member #f (map equal? list1 list2)))
		(d-PushPosition)
		(d-GoToPosition 1 1 1 1)
		(set! parts (collect-parts))
		(while (d-NextMovement)
			(if (differ parts (collect-parts))
				(d-WarningDialog (string-append (_ "Parts in movement ")
					(number->string (d-GetMovement)) (_ " differ from those in opening movement.\nWhile this is not an error, be aware that trying to print a part that does not appear in each movement will result in empty movements.")))))
		(d-PopPosition)))        
        

    (while (d-PreviousMovement))
    (d-InfoDialog "Checking Score - Please wait\nThe display will be strange while checking is done!")
    (let movement ()
      (d-EvenOutStaffLengths 'check)
      (while (d-MoveToStaffUp))   
      (if (not CheckScore::return)
		  (let staff ()
			(d-KeepAlive) 
			(if (not (d-Directive-voice? "SubstituteMusic"))
				(begin
					(d-FixSlursInStaff 'check)     
					(d-CheckTiesInStaff 'noninteractive)
					(if CheckTiesInStaff::return
							(set! CheckScore::return CheckTiesInStaff::return))
					(if (not CheckScore::return)
						(begin
							(d-CheckDirectivePairs 'noninteractive)
							(if CheckDirectivePairs::return
								(set! CheckScore::return CheckDirectivePairs::return))))))
			(if (not CheckScore::return)
				(if (or (d-MoveToVoiceDown) (d-MoveToStaffDown))
					(staff))))
		  (if (not CheckScore::return)
			  (begin
				(while (d-MoveToStaffUp))   
				(let staff ()
				  (if (not (d-Directive-voice? "SubstituteMusic"))
					(begin
					(d-MoveToBeginning)
					(let measure ()
						(d-CheckTupletsInMeasure 'noninteractive)           
						(set! CheckScore::return CheckTupletsInMeasure::return)
						(if (not CheckScore::return)
							(begin
								(d-CheckBeamsInMeasure 'noninteractive)
								(set! CheckScore::return CheckBeamsInMeasure::return)))
						(if (not CheckScore::return)
							(if (d-MoveToMeasureRight)
							  (measure))))))
			 (if (not CheckScore::return)
				(if (or (d-MoveToVoiceDown) (d-MoveToStaffDown))
					(staff)))))))
                               
         (if (not CheckScore::return)                      
                   (begin
                        (d-CheckTimeSignatures #t)
                        (set! CheckScore::return CheckTimeSignatures::return)))            
                               
        (if (and (not CheckScore::return) (not (d-Directive-layout? "PolymetricStaffs")))
              (begin
                (while (d-MoveToStaffUp))  
                  (let staff ()
                    (while (and (d-Directive-voice? "SubstituteMusic") (d-MoveToStaffDown)))
                    (if (not (d-Directive-voice? "SubstituteMusic"))
                        (begin
                            (d-MoveToBeginning)
                            (let measure ()
                                (if (not (LastMeasure?)) 
		                    (if (AcceptableDurationMeasure?)
		                                (begin
		                                    (d-MoveToMeasureRight)
		                                    (measure))
		                                (begin
		                                     (if (positive? CheckScore::ignore)
		                                            (begin
		                                                (set! CheckScore::ignore (1- CheckScore::ignore))
		                                                (d-MoveToMeasureRight)
		                                                (measure))
		                                            (begin
		                                            	(if (eq? (d-GetMeasure) 1)
		                                            	    (set! CheckScore::return (_ "Incorrect measure duration; If you are trying to create an upbeat (pickup/'anacrusis) use the Anacrusis command"))
		                                                    (set! CheckScore::return (_ "Incorrect measure duration")))
		                                                (set! CheckScore::error-position (GetPosition))))))))
                            (if (not CheckScore::return)
                                (begin
                                   
                                    (if (or (d-MoveToVoiceDown) (d-MoveToStaffDown))
                                    (staff)))))))))
                        
        (if (not CheckScore::return)
            (begin
                (d-CheckBraces 'noninteractive)
                (set! CheckScore::return CheckBraces::Return)))
 
         (if (not CheckScore::return) 
         	(begin
         		(while (d-MoveToStaffUp))
         		(while (and (d-Directive-voice? "SubstituteMusic") (d-MoveToStaffDown)))
         		(d-MoveToEnd) 
         		(let ((ticks (GetMeasureTicks))) 
         			(if (or (not ticks) (zero? ticks))
         				(set! ticks (duration::GetWholeMeasureInTicks)))
		      		 (let staff ((theseticks (GetMeasureTicks))) 
		      		 	(if (or (not theseticks) (zero? theseticks))
         					(set! theseticks (duration::GetWholeMeasureInTicks)))
					(d-KeepAlive) 
					(if (and (not (d-Directive-voice? "SubstituteMusic"))
				   			(not (eq? ticks theseticks)))
				   				(begin
				   					(set! CheckScore::error-position (GetPosition))
				   					(set! CheckScore::return (_ "Final Measures not all equal duration"))))
				   	(if (d-MoveToStaffDown)
				   		(staff (GetMeasureTicks)))))))

        (if (not CheckScore::return)           
           (d-InstallGraceNoteHints 'check))               
                                            
        (if (and (not CheckScore::return) (d-NextMovement))
                (movement)))
                
    (if (not CheckScore::params);; interactive
            (begin
                (if (not CheckScore::return)
                    (begin
                        (set! CheckScore::error-position #f)
                        (d-InfoDialog  (_ "No problem detected in this score")))
                    (begin
                        (if CheckScore::error-position
                            (apply d-GoToPosition CheckScore::error-position))
                        (d-InfoDialog CheckScore::return))))
            (disp "Error location " CheckScore::error-position "\n"))
    (d-MasterVolume old-volume))