File: CheckTimeSignatures.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 (54 lines) | stat: -rw-r--r-- 2,942 bytes parent folder | download | duplicates (3)
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
;;;CheckTimeSignatures
 (define-once CheckScore::ignore 0)
 (define CheckTimeSignatures::return #f)
 (define-once CheckScore::error-position #f)
 (let ()
    (define position (GetPosition))
    (define (check-down timesig)
        (define result #f)
        (d-PushPosition) 
        (if (and (d-MoveToStaffDown)  (not (d-Directive-voice? "SubstituteMusic")))
           (begin
             (while (d-NextObjectInMeasure))
             (if (not (equal? timesig (d-GetPrevailingTimesig)))
                (if (positive? CheckScore::ignore)
                    (set! CheckScore::ignore (1- CheckScore::ignore))
                    (begin
                        (set! result (string-append  (_ "Time Signature does not match ") timesig " : " (d-GetPrevailingTimesig)))
                        (set! CheckScore::error-position (GetPosition)))))))
        (d-PopPosition)
        result)
        
     (while (d-MoveToStaffUp))
   (if (not (d-Directive-layout? "PolymetricStaffs"))
     (let outer-loop ((first #t))
         (d-MoveToBeginning)
         (if (not (d-Directive-voice? "SubstituteMusic"))
             (let measure ()
                        (define result #f)
                        (while (and (not result) (d-NextObjectInMeasure))
                                (if (and (Timesignature?) (not (zero? (d-GetStartTick))))
                                        (if (positive? CheckScore::ignore)
                                            (set! CheckScore::ignore (1- CheckScore::ignore))
                                        (begin
                                            (set! result #t)
                                            (set! CheckScore::error-position (GetPosition))
                                            (set! CheckTimeSignatures::return (_ "Time Signature not at start of measure"))))))
                                        
                        (if (not result)
                            (let ((timesig (d-GetPrevailingTimesig)))
                                    (begin
                                        (set! result (check-down timesig))
                                        (if result
                                            (set! CheckTimeSignatures::return result)
                                            (if (d-MoveToMeasureRight)
                                                (measure))))))))
        (if (and (not CheckTimeSignatures::return) (d-MoveToStaffDown))
            (outer-loop #f))))
    (if (not CheckTimeSignatures::params) ;;; interactive when #f
        (begin
            (if CheckTimeSignatures::return
                (begin
                    (apply d-GoToPosition CheckScore::error-position)
                    (d-WarningDialog CheckTimeSignatures::return))
                (d-InfoDialog (if    (d-Directive-layout? "PolymetricStaffs") (_ "Polymetric Staffs not checked")      (_ "No problem detected with time signature changes")))))))