;;;; auto-beam.scm -- Auto-beam-engraver settings
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;; 
;;;; (c)  2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>

;;; specify generic beam begin and end times

;;; format:
;;;
;;;   function shortest-duration-in-beam time-signature
;;;
;;; where
;;;
;;;     function = begin or end
;;;     shortest-duration-in-beam = numerator denominator; e.g.: 1 16
;;;     time-signature = numerator denominator, e.g.: 4 4
;;;
;;; unspecified or wildcard entries for duration or time-signature
;;; are given by * *

;;; maybe do:  '(end shortest-1 16 time-3 4) ?

;;; in 3 2 time:
;;;   end beams each 1 2 note
;;;   end beams with 16th notes each 1 4 note
;;;   end beams with 32th notes each 1 8 note

(define-public default-auto-beam-settings
   `(
     ((end * * 3 2) . ,(ly:make-moment 1 2))
     ((end 1 16 3 2) . ,(ly:make-moment 1 4))
     ((end 1 32 3 2) . ,(ly:make-moment 1 8))

     ((begin 1 8 3 4) . ,(ly:make-moment 1 4))

     ((end * * 3 4) . ,(ly:make-moment 3 4))
     ((begin 1 16 3 4) . ,(ly:make-moment 1 16))
     ((end 1 16 3 4) . ,(ly:make-moment 1 4))
     ;;((begin 1 32 3 4) . ,(ly:make-moment 1 8))
     ((end 1 32 3 4) . ,(ly:make-moment 1 8))

     ((begin 1 16 3 8) . ,(ly:make-moment 1 8))
     ((end * * 3 8) . ,(ly:make-moment 3 8))

     ;; in common time:
     ;;   end beams each 1 2 note
     ;;   end beams with 32th notes each 1 8 note
     ;;   end beams with 1 8 triplets each 1 4 note

     ((end * * 4 4) . ,(ly:make-moment 1 2))
     ((end 1 12 4 4) . ,(ly:make-moment 1 4))
     ((end 1 16 4 4) . ,(ly:make-moment 1 4))
     ((end 1 32 4 4) . ,(ly:make-moment 1 8))

     ((end * * 2 4) . ,(ly:make-moment 1 4))
     ((end 1 12 2 4) . ,(ly:make-moment 1 4))
     ((end 1 16 2 4) . ,(ly:make-moment 1 4))
     ((end 1 32 2 4) . ,(ly:make-moment 1 8))

     ;; It seems that, because of a bug in the previous auto-beamer,
     ;; we had the effect of this setting x
     ;; ((end * * 2 8) . ,(ly:make-moment 2 8))

     ((end * * 4 8) . ,(ly:make-moment 1 4))
     ((end 1 16 4 8) . ,(ly:make-moment 1 4))
     ((end 1 32 4 8) . ,(ly:make-moment 1 8))

     ((end * * 4 16) . ,(ly:make-moment 1 8))

     ((end * * 6 8) . ,(ly:make-moment 3 8))
     ((end 1 16 6 8) . ,(ly:make-moment 3 8))
     ((end 1 32 6 8) . ,(ly:make-moment 1 8))

     ((end * * 9 8) . ,(ly:make-moment 3 8))
     ((end 1 16 9 8) . ,(ly:make-moment 3 8))
     ((end 1 32 9 8) . ,(ly:make-moment 1 8))

     ((end * * 12 8) . ,(ly:make-moment 3 8))
     ((end 1 16 12 8) . ,(ly:make-moment 3 8))
     ((end 1 32 12 8) . ,(ly:make-moment 1 8))
     ))


(define (override-property-setting context context-prop setting value)
  "Like the C++ code that executes \\override, but without type
checking. "

  (ly:context-set-property! context context-prop
			   (cons (cons setting value)
				 (ly:context-property context context-prop)
				 )
			   )
  )

(define (revert-property-setting context setting)
  "Like the C++ code that executes \revert, but without type
checking. "
  
  (define (revert-assoc alist key)
    "Return ALIST, with KEY removed. ALIST is not modified, instead
a fresh copy of the  list-head is made."
    (cond
     ((null? alist) '())
     ((equal? (caar alist) key) (cdr alist))
     (else (cons (car alist) (revert-assoc alist key)))
     ))

  
  
    (ly:context-set-property!
     context context-prop
     (revert-assoc (ly:context-property context context-prop)
		   setting))
  )

(define-public (override-auto-beam-setting setting num den . rest)
  (ly:export
   (context-spec-music
    (make-apply-context (lambda (c)
			  (override-property-setting
			   c 'autoBeamSettings
			   setting (ly:make-moment num den))
			  ))
    (if (and (pair? rest) (symbol? (car rest)))
	(car rest)
	'Voice)
  )))

(define-public (revert-auto-beam-setting setting . rest)
  (ly:export
   (context-spec-music
    (make-apply-context (lambda (c)
			  (revert-property-setting
			   c 'autoBeamSettings
			   setting)))
    (if (and (pair? rest) (symbol? (car rest)))
	(car rest)
	'Voice))))

