Bug in CMN: meter does not accept strings
Jacques Duthen
duthen@club-internet.fr
Thu, 22 May 1997 02:04:27 +0200
Hello!
The doc (cmn.html) says:
<i>meter</i> displays a meter and sets the staff's current meter (for
beaming
decisions and so on). <i>Numerator</i> and <i>denominator</i> can be
integers,
strings, or symbols.
Integers and symbols are ok, but strings produce the following error:
> Error: value "\"3+4\"" is not of the expected type number.
I fixed the functions (in cmn1.lisp and cmn4.lisp) which call `num',
but maybe it would be better (safer) to throw away the function `algol+'
and to ask the user to give:
- num, an integer, the real number of beats,
- den, an integer, the information for the duration of a beat.
The function `beats-per-measure' would then just return `num'.
And if the user wants a special numerator, s/he could give it
with an extra message like this:
(meter 7 8 (numerator "three + four"))
This special numerator would be stored in the meter and
used by the display functions.
BTW, this does not provide a way to ask for the meter:
4 3
- + -
4 8
Here are the modified functions:
hth [jack]
;;; [jack] bug fix of cmn1.lisp
;;; The numerator of a time signature can be a string,
;;; so "~A" is better than "~S".
(defmethod display ((meter meter-mixin) container score &rest rest)
(when container
(setf (box-x0 meter) (box-x0 container))
(setf (staff-y0 meter) (staff-y0 container)))
(when (and (or (not (member :just-fooling rest))
(not (eq (visible-justification meter) :none)))
(not (invisible-matrix-p meter)))
(let* ((parens (find-if #'(lambda (n) (and (sundry-p n) (eq
:in-parentheses (sundry-name n)))) (marks meter)))
(x0 (+ (box-x0 meter) (dxy-dx meter) (if parens .1 0)))
(y0 (+ (%staff-y0 meter) (dxy-dy meter))))
(if (marks meter) (apply #'display-marks meter score rest))
(when (or (not (meter-size meter))
(not (zerop (meter-size meter))))
(if (or (meter-name meter) (eq (meter-style meter) :suppressed))
(progn
(comment score (format nil "~A" (meter-name meter)))
(moveto score x0 (+ y0 (- (half-staff-dy score) .025)))
(if (meter-name meter)
(show score (if (eq (meter-name meter) :common-time) %commontime
%cuttime))
;; [jack] "~s" doesn't handle string num
(let ((num-text (format nil "~A" (num meter))))
(if (or (not (meter-size meter))
(<= (meter-size meter) 1.0))
(show score (%%text :letters num-text))
(show score (%%text :letters num-text :font-name music-font
:font-scaler (meter-size meter)))))))
;; [jack] "~s" doesn't handle string num
(let* ((num-text (format nil "~A" (num meter)))
(den-text (format nil "~S" (den meter)))
(num-len (length num-text))
(den-len (length den-text))
(num-offset (if (>= num-len den-len)
(if (and (numberp (num meter))
(= (num meter) 6))
-.0125 0)
(* .15 (- den-len num-len))))
(den-offset (if (>= den-len num-len)
(if (and (numberp (den meter))
(= (den meter) 8))
.0125 0)
(* .15 (- num-len den-len)))))
(if (or (not (meter-size meter))
(<= (meter-size meter) 1.0))
(progn
(moveto score (+ x0 num-offset) (+ y0 .75))
(show score (%%text :letters num-text))
(if (not (eq (meter-style meter) :note-head))
(progn
(moveto score
(+ x0 den-offset)
#+Sonata (+ y0 (- .25 .025)) #+Petrucci (+ y0 .25))
(show score (%%text :letters den-text)))
(let ((ob (quarters-to-text (/ 4 (den meter)) t))) ; 2nd arg ->
stem-down
(moveto score x0 (+ y0 .25))
(show score (text ob (font-name music-font))))))
(if (plusp (meter-size meter))
(let ((yup (* (meter-size meter) #+Sonata .215 #+Petrucci .25))
(ydown (* (meter-size meter) #+Sonata .215 #+Petrucci .23))
(added-num-offset (* num-offset (meter-size meter)))
(added-den-offset (* den-offset (meter-size meter))))
(moveto score (+ x0 added-num-offset) (+ y0 .5 yup))
(show score (%%text :letters num-text :font-name music-font
:font-scaler (meter-size meter)))
(moveto score (+ x0 added-den-offset) (- (+ y0 .5 -.025) ydown))
(show score (%%text :letters den-text :font-name music-font
:font-scaler (meter-size meter))))))))))))
(defun algol+ (sym)
(let (nums)
;; [jack] (format nil "~s" sym) doesn't handle string num
(with-input-from-string (str (nsubstitute #\ #\+ (format nil "~a"
sym)))
(loop for num = (read str nil nil nil)
while num
do (push num nums)
finally (return (apply #'+ nums))))))
(defmethod house ((meter meter) score)
(declare (ignore score))
(if (not (invisible-matrix-p meter))
;; [jack] "~s" doesn't handle string num
(let* ((num-text (format nil "~A" (num meter)))
(den-text (format nil "~S" (den meter)))
(dx-num (text-dx num-text))
(dx-den (text-dx den-text))
(parens (find-if #'(lambda (n) (and (sundry-p n) (eq
:in-parentheses (sundry-name n)))) (marks meter))))
(setf (box-x1 meter) (+ (* (max dx-num dx-den) (or (meter-size meter)
1.0)) (if parens .1 0)))
(setf (center meter) 0)
(if (not (walls meter)) (setf (walls meter) meter-walls))
(if (not (fences meter)) (setf (fences meter) meter-fences))
(if (not (expanders meter)) (setf (expanders meter) meter-expanders)))
(progn
(setf (box-x1 meter) 0)
(setf (center meter) 0))))
;;; [jack] bug fix of cmn4.lisp
;;; To get the numerical value of the numerator,
;;; beats-per-measure is better than num.
(defun staff-engorge (objects)
(let ((current-clef nil)
(current-meter nil)
(current-key nil)
(new-data nil)
(local-brace nil))
(loop for stf in objects do
;; at the start of each staff after the first, toss the redundant
set-up stuff
(let ((stf-data (staff-data stf))
(happy t))
(if (and (not local-brace) (staff-local-brace stf))
(setf local-brace (copy (staff-local-brace stf))))
(when (or current-clef current-meter current-key)
(loop while happy do
(let ((topdat (first stf-data)))
;;(setq jd-topdat topdat jd-current-meter current-meter)
;;(break)
(if (or (bar-p topdat)
(and (clef-p topdat) (eq (clef-name topdat) (clef-name
current-clef)))
(and (meter-p topdat)
(= (den topdat) (den current-meter))
;; [jack] beats-per-measure is better than
num
;;(= (num topdat) (num current-meter))
(= (beats-per-measure topdat)
(beats-per-measure current-meter)))
(and (key-p topdat) (equalp (signature topdat) (signature
current-key))))
(setf stf-data (cdr stf-data))
(setf happy nil)))))
(loop for datum in stf-data do
(push datum new-data)
(if (meter-p datum) (setf current-meter datum)
(if (clef-p datum) (setf current-clef datum)
(if (key-p datum) (setf current-key datum)))))))
(setf (staff-data (first objects)) (nreverse new-data))
(setf (staff-local-brace (first objects)) local-brace)
(first objects)))
--
| # # | # # # | # # | # # # | # # | # # # | Jacques Duthen [jack] |
| # # | # # # | # # | # # # | # # | # # # | duthen@club-internet.fr |
|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|_|