(if (eq base 'pi)
(math-pi)
expr)))
- (if (Math-primp expr)
+ (if (or
+ (Math-primp expr)
+ (and (eq (car-safe expr) 'calcFunc-subscr)
+ (eq (car-safe (nth 1 expr)) 'var)))
expr
(cons (car expr)
(mapcar 'math-to-standard-rec (cdr expr))))))
coef)))
units)))))))
-(defun calcFunc-lufieldplus (a b)
+(defun calcFunc-lufadd (a b)
(math-logunits-add a b nil nil))
-(defun calcFunc-lupowerplus (a b)
+(defun calcFunc-lupadd (a b)
(math-logunits-add a b nil t))
-(defun calcFunc-lufieldminus (a b)
+(defun calcFunc-lufsub (a b)
(math-logunits-add a b t nil))
-(defun calcFunc-lupowerminus (a b)
+(defun calcFunc-lupsub (a b)
(math-logunits-add a b t t))
-(defun calc-logunits-add (arg)
+(defun calc-lu-plus (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-inverse)
(if (calc-is-hyperbolic)
- (calc-binary-op "lu-" 'calcFunc-lufieldminus arg)
- (calc-binary-op "lu-" 'calcFunc-lupowerminus arg))
+ (calc-binary-op "lu-" 'calcFunc-lufsub arg)
+ (calc-binary-op "lu-" 'calcFunc-lupsub arg))
(if (calc-is-hyperbolic)
- (calc-binary-op "lu+" 'calcFunc-lufieldplus arg)
- (calc-binary-op "lu+" 'calcFunc-lupowerplus arg)))))
+ (calc-binary-op "lu+" 'calcFunc-lufadd arg)
+ (calc-binary-op "lu+" 'calcFunc-lupadd arg)))))
-(defun calc-logunits-sub (arg)
+(defun calc-lu-minus (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-inverse)
(if (calc-is-hyperbolic)
- (calc-binary-op "lu+" 'calcFunc-lufieldplus arg)
- (calc-binary-op "lu+" 'calcFunc-lupowerplus arg))
+ (calc-binary-op "lu+" 'calcFunc-lufadd arg)
+ (calc-binary-op "lu+" 'calcFunc-lupadd arg))
(if (calc-is-hyperbolic)
- (calc-binary-op "lu-" 'calcFunc-lufieldminus arg)
- (calc-binary-op "lu-" 'calcFunc-lupowerminus arg)))))
+ (calc-binary-op "lu-" 'calcFunc-lufsub arg)
+ (calc-binary-op "lu-" 'calcFunc-lupsub arg)))))
(defun math-logunits-mul (a b power)
(let (logunit coef units number)
(math-div (math-conditional-apply 'calcFunc-ln b) (if power 2 1)))
units)))))))))
-(defun calcFunc-lufieldtimes (a b)
+(defun calcFunc-lufmul (a b)
(math-logunits-mul a b nil))
-(defun calcFunc-lupowertimes (a b)
+(defun calcFunc-lupmul (a b)
(math-logunits-mul a b t))
-(defun calc-logunits-mul (arg)
+(defun calc-lu-times (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-inverse)
(if (calc-is-hyperbolic)
- (calc-binary-op "lu/" 'calcFunc-lufielddiv arg)
- (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg))
+ (calc-binary-op "lu/" 'calcFunc-lufdiv arg)
+ (calc-binary-op "lu/" 'calcFunc-lupdiv arg))
(if (calc-is-hyperbolic)
- (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg)
- (calc-binary-op "lu*" 'calcFunc-lupowertimes arg)))))
+ (calc-binary-op "lu*" 'calcFunc-lufmul arg)
+ (calc-binary-op "lu*" 'calcFunc-lupmul arg)))))
-(defun calcFunc-lufielddiv (a b)
+(defun calcFunc-lufdiv (a b)
(math-logunits-divide a b nil))
-(defun calcFunc-lupowerdiv (a b)
+(defun calcFunc-lupdiv (a b)
(math-logunits-divide a b t))
-(defun calc-logunits-divide (arg)
+(defun calc-lu-divide (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-inverse)
(if (calc-is-hyperbolic)
- (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg)
- (calc-binary-op "lu*" 'calcFunc-lupowertimes arg))
+ (calc-binary-op "lu*" 'calcFunc-lufmul arg)
+ (calc-binary-op "lu*" 'calcFunc-lupmul arg))
(if (calc-is-hyperbolic)
- (calc-binary-op "lu/" 'calcFunc-lufielddiv arg)
- (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg)))))
+ (calc-binary-op "lu/" 'calcFunc-lufdiv arg)
+ (calc-binary-op "lu/" 'calcFunc-lupdiv arg)))))
(defun math-logunits-quant (val ref power)
(let* ((units (math-simplify (math-extract-units val)))
coeff))))
runits)))))
-(defvar calc-logunits-field-reference)
-(defvar calc-logunits-power-reference)
+(defvar calc-lu-field-reference)
+(defvar calc-lu-power-reference)
-(defun calcFunc-fieldquant (val &optional ref)
+(defun calcFunc-lufquant (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-field-reference)))
+ (setq ref (math-read-expr calc-lu-field-reference)))
(math-logunits-quant val ref nil))
-(defun calcFunc-powerquant (val &optional ref)
+(defun calcFunc-lupquant (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-power-reference)))
+ (setq ref (math-read-expr calc-lu-power-reference)))
(math-logunits-quant val ref t))
-(defun calc-logunits-quantity (arg)
+(defun calc-lu-quant (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-hyperbolic)
(if (calc-is-option)
- (calc-binary-op "lupq" 'calcFunc-fieldquant arg)
- (calc-unary-op "lupq" 'calcFunc-fieldquant arg))
+ (calc-binary-op "lupq" 'calcFunc-lufquant arg)
+ (calc-unary-op "lupq" 'calcFunc-lufquant arg))
(if (calc-is-option)
- (calc-binary-op "lufq" 'calcFunc-powerquant arg)
- (calc-unary-op "lufq" 'calcFunc-powerquant arg)))))
+ (calc-binary-op "lufq" 'calcFunc-lupquant arg)
+ (calc-unary-op "lufq" 'calcFunc-lupquant arg)))))
(defun math-logunits-level (val ref db power)
"Compute the value of VAL in decibels or nepers."
'(var Np var-Np)))
units)))
-(defun calcFunc-dbfieldlevel (val &optional ref)
+(defun calcFunc-dbfield (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-field-reference)))
+ (setq ref (math-read-expr calc-lu-field-reference)))
(math-logunits-level val ref t nil))
-(defun calcFunc-dbpowerlevel (val &optional ref)
+(defun calcFunc-dbpower (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-power-reference)))
+ (setq ref (math-read-expr calc-lu-power-reference)))
(math-logunits-level val ref t t))
-(defun calcFunc-npfieldlevel (val &optional ref)
+(defun calcFunc-npfield (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-field-reference)))
+ (setq ref (math-read-expr calc-lu-field-reference)))
(math-logunits-level val ref nil nil))
-(defun calcFunc-nppowerlevel (val &optional ref)
+(defun calcFunc-nppower (val &optional ref)
(unless ref
- (setq ref (math-read-expr calc-logunits-power-reference)))
+ (setq ref (math-read-expr calc-lu-power-reference)))
(math-logunits-level val ref nil t))
-(defun calc-logunits-dblevel (arg)
+(defun calc-db (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-hyperbolic)
(if (calc-is-option)
- (calc-binary-op "ludb" 'calcFunc-dbfieldlevel arg)
- (calc-unary-op "ludb" 'calcFunc-dbfieldlevel arg))
+ (calc-binary-op "ludb" 'calcFunc-dbfield arg)
+ (calc-unary-op "ludb" 'calcFunc-dbfield arg))
(if (calc-is-option)
- (calc-binary-op "ludb" 'calcFunc-dbpowerlevel arg)
- (calc-unary-op "ludb" 'calcFunc-dbpowerlevel arg)))))
+ (calc-binary-op "ludb" 'calcFunc-dbpower arg)
+ (calc-unary-op "ludb" 'calcFunc-dbpower arg)))))
-(defun calc-logunits-nplevel (arg)
+(defun calc-np (arg)
(interactive "P")
(calc-slow-wrapper
(if (calc-is-hyperbolic)
(if (calc-is-option)
- (calc-binary-op "lunp" 'calcFunc-npfieldlevel arg)
- (calc-unary-op "lunp" 'calcFunc-npfieldlevel arg))
+ (calc-binary-op "lunp" 'calcFunc-npfield arg)
+ (calc-unary-op "lunp" 'calcFunc-npfield arg))
(if (calc-is-option)
- (calc-binary-op "lunp" 'calcFunc-nppowerlevel arg)
- (calc-unary-op "lunp" 'calcFunc-nppowerlevel arg)))))
+ (calc-binary-op "lunp" 'calcFunc-nppower arg)
+ (calc-unary-op "lunp" 'calcFunc-nppower arg)))))
+
+;;; Musical notes
+
+
+(defvar calc-note-threshold)
+
+(defun math-midi-round (num)
+ "Round NUM to an integer N if NUM is within calc-note-threshold cents of N."
+ (let* ((n (math-round num))
+ (diff (math-abs
+ (math-sub num n))))
+ (if (< (math-compare diff
+ (math-div (math-read-expr calc-note-threshold) 100)) 0)
+ n
+ num)))
+
+(defconst math-notes
+ '(((var C var-C) . 0)
+ ((var Csharp var-Csharp) . 1)
+; ((var C♯ var-C♯) . 1)
+ ((var Dflat var-Dflat) . 1)
+; ((var D♭ var-D♭) . 1)
+ ((var D var-D) . 2)
+ ((var Dsharp var-Dsharp) . 3)
+; ((var D♯ var-D♯) . 3)
+ ((var E var-E) . 4)
+ ((var F var-F) . 5)
+ ((var Fsharp var-Fsharp) . 6)
+; ((var F♯ var-F♯) . 6)
+ ((var Gflat var-Gflat) . 6)
+; ((var G♭ var-G♭) . 6)
+ ((var G var-G) . 7)
+ ((var Gsharp var-Gsharp) . 8)
+; ((var G♯ var-G♯) . 8)
+ ((var A var-A) . 9)
+ ((var Asharp var-Asharp) . 10)
+; ((var A♯ var-A♯) . 10)
+ ((var Bflat var-Bflat) . 10)
+; ((var B♭ var-B♭) . 10)
+ ((var B var-B) . 11))
+ "An alist of notes with their number of semitones above C.")
+
+(defun math-freqp (freq)
+ "Non-nil if FREQ is a positive number times the unit Hz.
+If non-nil, return the coefficient of Hz."
+ (let ((freqcoef (math-simplify-units
+ (math-div freq '(var Hz var-Hz)))))
+ (if (Math-posp freqcoef) freqcoef)))
+
+(defun math-midip (num)
+ "Non-nil if NUM is a possible MIDI note number.
+If non-nil, return NUM."
+ (if (Math-numberp num) num))
+
+(defun math-spnp (spn)
+ "Non-nil if NUM is a scientific pitch note (note + cents).
+If non-nil, return a list consisting of the note and the cents coefficient."
+ (let (note cents rnote rcents)
+ (if (eq (car-safe spn) '+)
+ (setq note (nth 1 spn)
+ cents (nth 2 spn))
+ (setq note spn
+ cents nil))
+ (cond
+ ((and ;; NOTE is a note, CENTS is nil or cents.
+ (eq (car-safe note) 'calcFunc-subscr)
+ (assoc (nth 1 note) math-notes)
+ (integerp (nth 2 note))
+ (setq rnote note)
+ (or
+ (not cents)
+ (Math-numberp (setq rcents
+ (math-simplify
+ (math-div cents '(var cents var-cents)))))))
+ (list rnote rcents))
+ ((and ;; CENTS is a note, NOTE is cents.
+ (eq (car-safe cents) 'calcFunc-subscr)
+ (assoc (nth 1 cents) math-notes)
+ (integerp (nth 2 cents))
+ (setq rnote cents)
+ (or
+ (not note)
+ (Math-numberp (setq rcents
+ (math-simplify
+ (math-div note '(var cents var-cents)))))))
+ (list rnote rcents)))))
+
+(defun math-freq-to-midi (freq)
+ "Return the midi note number corresponding to FREQ Hz."
+ (let ((midi (math-add
+ 69
+ (math-mul
+ 12
+ (calcFunc-log
+ (math-div freq 440)
+ 2)))))
+ (math-midi-round midi)))
+
+(defun math-spn-to-midi (spn)
+ "Return the MIDI number corresponding to SPN."
+ (let* ((note (cdr (assoc (nth 1 (car spn)) math-notes)))
+ (octave (math-add (nth 2 (car spn)) 1))
+ (cents (nth 1 spn))
+ (midi (math-add
+ (math-mul 12 octave)
+ note)))
+ (if cents
+ (math-add midi (math-div cents 100))
+ midi)))
+
+(defun math-midi-to-spn (midi)
+ "Return the scientific pitch notation corresponding to midi number MIDI."
+ (let (midin cents)
+ (if (math-integerp midi)
+ (setq midin midi
+ cents nil)
+ (setq midin (math-floor midi)
+ cents (math-mul 100 (math-sub midi midin))))
+ (let* ((nr ;; This should be (math-idivmod midin 12), but with
+ ;; better behavior for negative midin.
+ (if (Math-negp midin)
+ (let ((dm (math-idivmod (math-neg midin) 12)))
+ (if (= (cdr dm) 0)
+ (cons (math-neg (car dm)) 0)
+ (cons
+ (math-sub (math-neg (car dm)) 1)
+ (math-sub 12 (cdr dm)))))
+ (math-idivmod midin 12)))
+ (n (math-sub (car nr) 1))
+ (note (car (rassoc (cdr nr) math-notes))))
+ (if cents
+ (list '+ (list 'calcFunc-subscr note n)
+ (list '* cents '(var cents var-cents)))
+ (list 'calcFunc-subscr note n)))))
+
+(defun math-freq-to-spn (freq)
+ "Return the scientific pitch notation corresponding to FREQ Hz."
+ (math-with-extra-prec 3
+ (math-midi-to-spn (math-freq-to-midi freq))))
+
+(defun math-midi-to-freq (midi)
+ "Return the frequency of the note with midi number MIDI."
+ (list '*
+ (math-mul
+ 440
+ (math-pow
+ 2
+ (math-div
+ (math-sub
+ midi
+ 69)
+ 12)))
+ '(var Hz var-Hz)))
+
+(defun math-spn-to-freq (spn)
+ "Return the frequency of the note with scientific pitch notation SPN."
+ (math-midi-to-freq (math-spn-to-midi spn)))
+
+(defun calcFunc-spn (expr)
+ "Return EXPR written as scientific pitch notation + cents."
+ ;; Get the coeffecient of Hz
+ (let (note)
+ (cond
+ ((setq note (math-freqp expr))
+ (math-freq-to-spn note))
+ ((setq note (math-midip expr))
+ (math-midi-to-spn note))
+ ((math-spnp expr)
+ expr)
+ (t
+ (math-reject-arg expr "*Improper expression")))))
+
+(defun calcFunc-midi (expr)
+ "Return EXPR written as a MIDI number."
+ (let (note)
+ (cond
+ ((setq note (math-freqp expr))
+ (math-freq-to-midi note))
+ ((setq note (math-spnp expr))
+ (math-spn-to-midi note))
+ ((math-midip expr)
+ expr)
+ (t
+ (math-reject-arg expr "*Improper expression")))))
+
+(defun calcFunc-freq (expr)
+ "Return the frequency corresponding to EXPR."
+ (let (note)
+ (cond
+ ((setq note (math-midip expr))
+ (math-midi-to-freq note))
+ ((setq note (math-spnp expr))
+ (math-spn-to-freq note))
+ ((math-freqp expr)
+ expr)
+ (t
+ (math-reject-arg expr "*Improper expression")))))
+
+(defun calc-freq (arg)
+ "Return the frequency corresponding to the expression on the stack."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-unary-op "freq" 'calcFunc-freq arg)))
+
+(defun calc-midi (arg)
+ "Return the MIDI number corresponding to the expression on the stack."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-unary-op "midi" 'calcFunc-midi arg)))
+
+(defun calc-spn (arg)
+ "Return the scientific pitch notation corresponding to the expression on the stack."
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-unary-op "spn" 'calcFunc-spn arg)))
+
(provide 'calc-units)