(require (quote calc-ext)) (defun calc-Need-calc-units nil (byte-code "" [nil] 1)) (defun calc-base-units nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code "!\"!#)" [calc-autorange-units nil calc-enter-result 1 "bsun" math-simplify-units math-to-standard-units calc-top-n] 8)) 117] 3)) (defun calc-quick-units nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code " ZUȂ!!Y!X'! !1! GW= \" \"U\" 8\"#d\" 8\"!#," [num last-command-char pos units expr nil 48 0 10 calc-var-value var-Units calc-top-n 1 9 error "Bad unit number" math-vectorp "No \"quick units\" are defined" "Unit number %d not defined" math-units-in-expr-p calc-enter-result format "cun%d" math-convert-units "*un%d" math-simplify-units math-mul] 19)) 358] 3)) (defun calc-convert-units (&optional old-units new-units) (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code "!\"P9! \")҉̂9 \"5 P ! !=H 8\" \")g b Qc!\"wP!!=8\"\"!=8 \"   8\"!# ! \"?##*+" [expr uoldname nil unew t uold old-units new-units units std math-standard-units-systems calc-top-n 1 math-units-in-expr-p read-string "Old units: " equal "" "1" string-match "\\` */" math-read-expr car-safe error "Bad format in units expression: %s" math-mul ", new units: " "New units: " 2 var assq calc-enter-result "cvun" math-simplify-units math-to-standard-units "No units specified" math-convert-units] 30)) 884] 3)) (defun calc-autorange-units (arg) (interactive "P") (byte-code "!" [nil calc-do (lambda nil (byte-code "$ Ƃ!" [arg nil t calc-autorange-units calc-change-mode message "Adjusting target unit prefix automatically." "Using target units exactly."] 5))] 2)) (defun calc-convert-temperature (&optional old-units new-units) (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code "! =!5:/@@!P!E2!<!!) !=N 8\"\"\\ \"r o Qp!! != 8\" $!#," [expr uold nil uoldname unew old-units units new-units calc-top-n 1 math-single-units-in-expr-p var intern "var-" symbol-name error "Not a pure temperature expression" math-read-expr read-string "Old temperature units: " car-safe "Bad format in units expression: %s" 2 math-units-in-expr-p math-mul ", new units: " "New temperature units: " calc-enter-result "cvtm" math-simplify-units math-convert-temperature] 24)) 1947] 3)) (defun calc-remove-units nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code "!!!#" [calc-enter-result 1 "rmun" math-simplify-units math-remove-units calc-top-n] 7)) 2665] 3)) (defun calc-extract-units nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code "!!!#" [calc-enter-result 1 "rmun" math-simplify-units math-extract-units calc-top-n] 7)) 2874] 3)) (defun calc-explain-units nil (interactive) (byte-code "!" [nil calc-do (lambda nil (byte-code "!\"  \" Q4 - #1\"B ? \"B!*" [num-units nil den-units calc-explain-units-rec calc-top-n 1 string-match "^[^(].* .*[^)]$" "(" ")" message "%s per %s" "%s" "1 per %s" "No units in expression"] 8))] 2)) (defun calc-explain-units-rec (expr pow) (byte-code " ! !?08@! H=* O \"h \"b \"_ O H=RւS TOQ9h Q 8@= 8!H \"8 \"@>? P !P \" \" \" \"8\" P P \" \"8\" P P !!Q ! Q ,( Q) ) !=H 8 \" 8 \" !=a 8 \" 8 [\" !>r 8 \" != 8! 8 8\"\"*" [u expr pos pow name math-unit-prefixes t num-units den-units math-check-unit-name nil math-zerop 2 symbol-name 0 42 1 string-match "[^a-zA-Z0-9']" "^[a-zA-Z0-9' ()]*$" "[ ()]" 32 "-" "" "(" ")" assq (mHg gf) downcase math-equal-int -1 -2 equal 4 ((m . 1)) "Square-" "-squared" 3 -3 ((m . 1)) "Cubic-" "-cubed" "^" math-format-number math-abs math-posp " " car-safe * calc-explain-units-rec / (neg + -) ^ math-realp math-mul] 37)) (defun calc-simplify-units nil (interactive) (byte-code "\"" [nil calc-do (lambda nil (byte-code ">?!!#)" [calc-simplify-mode (none num) calc-enter-result 1 "smun" math-simplify-units calc-top-n] 6)) 4338] 3)) (defun calc-view-units-table (n) (interactive "P") (byte-code "ˆ ‰!   2 !!  !! !)5!)" [n math-units-table-buffer-valid nil win math-units-table curwin get-buffer-window "*Units Table*" bury-buffer window-buffer selected-window select-window switch-to-buffer math-build-units-table-buffer] 9)) (defun calc-enter-units-table (n) (interactive "P") (byte-code "ˆ ‰!!!" [n math-units-table-buffer-valid nil t math-build-units-table-buffer message substitute-command-keys "Type \\[calc] to return to the Calculator."] 4)) (defun calc-define-unit (uname desc) (interactive "SDefine unit name: sDescription: ") (byte-code "! " [nil calc-do (lambda nil (byte-code "! \"  E Bĉ A!=*8 =?:\"?:\"\" AA\"?K\"*" [form unit uname math-additional-units nil math-units-table desc calc-top-n 1 assq setcar car-safe var math-equal-int math-format-flat-expr 0 equal ""] 11)) calc-invalidate-units-table] 3)) (defun calc-undefine-unit (uname) (interactive "SUndefine unit name: ") (byte-code "! " [nil calc-do (lambda nil (byte-code " \" \" \" \" \"ʼn)" [unit uname math-additional-units math-standard-units math-units-table nil assq error "\"%s\" is a predefined unit name" "Unit name \"%s\" not found" delq] 7)) calc-invalidate-units-table] 3)) (defun calc-invalidate-units-table nil (byte-code "! ! qeb!c))))" [math-units-table nil buf buffer-read-only get-buffer "*Units Table*" looking-at "Calculator Units Table" "(Obsolete) "] 3)) (defun calc-get-unit-definition (uname) (interactive "SGet definition for unit: ") (byte-code "!" [nil calc-do (lambda nil (byte-code " \" \"8 ;* \"' O/ !8E8# \"X !P!E# \"))" [unit uname math-units-table msg math-build-units-table assq error "Unit name \"%s\" not found" 2 string-match "^\\*" 1 nil symbol-name calc-enter-result 0 "ugdf" message "Derived unit: %s" var intern "var-" "Base unit: %s"] 16))] 2)) (defun calc-permanent-units nil (interactive) (byte-code "!" [nil calc-do (lambda nil (byte-code " !!qeb# `#1 !`\":dbc! # c  @@! @8{ @8;o @8!x @8\"!| @8!& AK)ccc )" [pos calc-settings-file nil t math-additional-units list find-file-noselect substitute-in-file-name search-forward ";;; Custom units stored by Calc" beginning-of-line " ;;; End of custom units" forward-line 1 delete-region " " forward-char -1 insert ";;; Custom units stored by Calc on " current-time-string " " "(setq math-additional-units '( " " (" symbol-name " " prin1-to-string math-format-flat-expr 0 "nil" 2 ") " ")) " ";;; (no custom units defined) " ";;; End of custom units " save-buffer] 25))] 2)) (defvar math-standard-units (quote ((m nil "*Meter") (in "2.54 cm" "Inch") (ft "12 in" "Foot") (yd "3 ft" "Yard") (mi "5280 ft" "Mile") (au "1.495979e11 m" "Astronomical Unit") (lyr "9460536207068016 m" "Light Year") (pc "206264.80625 au" "Parsec") (nmi "1852 m" "Nautical Mile") (fath "6 ft" "Fathom") (u "1 um" "Micron") (mil "in/1000" "Mil") (point "in/72" "Point (1/72 inch)") (tpt "in/72.27" "Point (TeX conventions)") (Ang "1e-10 m" "Angstrom") (mfi "mi+ft+in" "Miles + feet + inches") (hect "10000 m^2" "*Hectare") (acre "mi^2 / 640" "Acre") (b "1e-28 m^2" "Barn") (l "1e-3 m^3" "*Liter") (L "1e-3 m^3" "Liter") (gal "4 qt" "US Gallon") (qt "2 pt" "Quart") (pt "2 cup" "Pint") (cup "8 ozfl" "Cup") (ozfl "2 tbsp" "Fluid Ounce") (floz "2 tbsp" "Fluid Ounce") (tbsp "3 tsp" "Tablespoon") (tsp "4.92892159375 ml" "Teaspoon") (vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons") (galC "4.54609 l" "Canadian Gallon") (galUK "4.546092 l" "UK Gallon") (s nil "*Second") (sec "s" "Second") (min "60 s" "Minute") (hr "60 min" "Hour") (day "24 hr" "Day") (wk "7 day" "Week") (hms "wk+day+hr+min+s" "Hours, minutes, seconds") (yr "365.25 day" "Year") (Hz "1/s" "Hertz") (mph "mi/hr" "*Miles per hour") (kph "km/hr" "Kilometers per hour") (knot "nmi/hr" "Knot") (c "2.99792458e8 m/s" "Speed of light") (ga "9.80665 m/s^2" "*\"g\" acceleration") (g nil "*Gram") (lb "16 oz" "Pound (mass)") (oz "28.349523125 g" "Ounce (mass)") (ton "2000 lb" "Ton") (tpo "ton+lb+oz" "Tons + pounds + ounces (mass)") (t "1000 kg" "Metric ton") (tonUK "1016.0469088 kg" "UK ton") (lbt "12 ozt" "Troy pound") (ozt "31.103475 g" "Troy ounce") (ct ".2 g" "Carat") (amu "1.6605402e-24 g" "Unified atomic mass") (N "m kg/s^2" "*Newton") (dyn "1e-5 N" "Dyne") (gf "ga g" "Gram (force)") (lbf "4.44822161526 N" "Pound (force)") (kip "1000 lbf" "Kilopound (force)") (pdl "0.138255 N" "Poundal") (J "N m" "*Joule") (erg "1e-7 J" "Erg") (cal "4.1868 J" "International Table Calorie") (Btu "1055.05585262 J" "International Table Btu") (eV "ech V" "Electron volt") (ev "eV" "Electron volt") (therm "105506000 J" "EEC therm") (invcm "h c/cm" "Energy in inverse centimeters") (Kayser "invcm" "Kayser (inverse centimeter energy)") (men "100/invcm" "Inverse energy in meters") (Hzen "h Hz" "Energy in Hertz") (Ken "k K" "Energy in Kelvins") (W "J/s" "*Watt") (hp "745.7 W" "Horsepower") (K nil "*Degree Kelvin" K) (dK "K" "Degree Kelvin" K) (degK "K" "Degree Kelvin" K) (dC "K" "Degree Celsius" C) (degC "K" "Degree Celsius" C) (dF "(5/9) K" "Degree Fahrenheit" F) (degF "(5/9) K" "Degree Fahrenheit" F) (Pa "N/m^2" "*Pascal") (bar "1e5 Pa" "Bar") (atm "101325 Pa" "Standard atmosphere") (torr "atm/760" "Torr") (mHg "1000 torr" "Meter of mercury") (inHg "25.4 mmHg" "Inch of mercury") (inH2O "248.84 Pa" "Inch of water") (psi "6894.75729317 Pa" "Pound per square inch") (P "0.1 Pa s" "*Poise") (St "1e-4 m^2/s" "Stokes") (A nil "*Ampere") (C "A s" "Coulomb") (Fdy "ech Nav" "Faraday") (e "1.60217733e-19 C" "Elementary charge") (ech "1.60217733e-19 C" "Elementary charge") (V "W/A" "Volt") (ohm "V/A" "Ohm") (mho "A/V" "Mho") (S "A/V" "Siemens") (F "C/V" "Farad") (H "Wb/A" "Henry") (T "Wb/m^2" "Tesla") (G "1e-4 T" "Gauss") (Wb "V s" "Weber") (cd nil "*Candela") (sb "1e4 cd/m^2" "Stilb") (lm "cd sr" "Lumen") (lx "lm/m^2" "Lux") (ph "1e4 lx" "Phot") (fc "10.76 lx" "Footcandle") (lam "1e4 lm/m^2" "Lambert") (flam "1.07639104e-3 lam" "Footlambert") (Bq "1/s" "*Becquerel") (Ci "3.7e10 Bq" "Curie") (Gy "J/kg" "Gray") (Sv "Gy" "Sievert") (R "2.58e-4 C/kg" "Roentgen") (rd ".01 Gy" "Rad") (rem "rd" "Rem") (mol nil "*Mole") (rad nil "*Radian") (circ "2 pi rad" "Full circle") (rev "circ" "Full revolution") (deg "circ/360" "Degree") (arcmin "deg/60" "Arc minute") (arcsec "arcmin/60" "Arc second") (grad "circ/400" "Grade") (rpm "rev/min" "Revolutions per minute") (sr nil "*Steradian") (h "6.6260755e-34 J s" "*Planck's constant") (hbar "h / 2 pi" "Planck's constant") (mu0 "4 pi 1e-7 H/m" "Permeability of vacuum") (Grav "6.67259e-11 N m^2/kg^2" "Gravitational constant") (Nav "6.0221367e23 / mol" "Avagadro's constant") (me "0.51099906 MeV/c^2" "Electron rest mass") (mp "1.007276470 amu" "Proton rest mass") (mn "1.008664904 amu" "Neutron rest mass") (mu "0.113428913 amu" "Muon rest mass") (Ryd "1.0973731571e5 invcm" "Rydberg's constant") (k "1.3806513e-23 J/K" "Boltzmann's constant") (fsc "1 / 137.0359895" "Fine structure constant") (muB "5.78838263e-11 MeV/T" "Bohr magneton") (muN "3.15245166e-14 MeV/T" "Nuclear magneton") (mue "1.001159652193 muB" "Electron magnetic moment") (mup "2.792847386 muN" "Proton magnetic moment") (R0 "Nav k" "Molar gas constant") (V0 "22.413992 L/mol" "Standard volume of ideal gas")))) (defvar math-additional-units nil "\ *Additional units table for user-defined units. Must be formatted like math-standard-units. If this is changed, be sure to set math-units-table to nil to ensure that the combined units table will be rebuilt.") (defvar math-unit-prefixes (quote ((69 (float 1 18) "Exa") (80 (float 1 15) "Peta") (84 (float 1 12) "Tera") (71 (float 1 9) "Giga") (77 (float 1 6) "Mega") (107 (float 1 3) "Kilo") (75 (float 1 3) "Kilo") (104 (float 1 2) "Hecto") (72 (float 1 2) "Hecto") (68 (float 1 1) "Deka") (0 (float 1 0) nil) (100 (float 1 -1) "Deci") (99 (float 1 -2) "Centi") (109 (float 1 -3) "Milli") (117 (float 1 -6) "Micro") (110 (float 1 -9) "Nano") (112 (float 1 -12) "Pico") (102 (float 1 -15) "Femto") (97 (float 1 -18) "Atto")))) (defvar math-standard-units-systems (quote ((base nil) (si ((g (quote (* (var kg var-kg) (float 1 -3)))))) (mks ((g (quote (* (var kg var-kg) (float 1 -3)))))) (cgs ((m (quote (* (var cm var-cm) 100)))))))) (defvar math-units-table nil "\ Internal units table derived from math-defined-units. Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (defvar math-units-table-buffer-valid nil) (defun math-build-units-table nil (byte-code "0 \" \"!lj \"  \")! +" [math-units-table combined-units math-additional-units math-standard-units unit-list tab math-units-table-buffer-valid nil append mapcar car message "Building units table..." (lambda (x) (byte-code "@818;.8! !=)@ 8#* )18888?C@BC%" [x exp list 1 math-read-plain-expr car-safe error "Format error in definition of %s in units table: %s" 2 3] 10)) math-find-base-units "Building units table...done"] 8)) (defun math-find-base-units (entry) (byte-code "8= @\"8l\"\"8\"̈ @A=7 A'  AY A@A=Q AA\"U A:) \"\" \" )" [entry base b 4 boom error "Circular definition involving unit %s" nil setcar nthcdr math-find-base-units-rec 1 (or base (error "Dimensionless definition for unit %s" (car entry))) 0 setcdr sort math-compare-unit-names] 10)) (defun math-compare-unit-names (a b) (byte-code "@ @ >A>" [b a unit-list] 3)) (defun math-find-base-units-rec (expr pow) (byte-code " !F! B @A \" @@\" - A \\\"8 @@ BB* A ) ! @=X 8!i 8 8\"\" @= 8 \" 8 \" @= 8 \" 8 [\" @= 8 \" @= 8 \" @= 8= 8@#@\")" [u expr ulist p pow old base entry t math-check-unit-name math-find-base-units * assq setcdr math-scalarp ^ integerp 2 math-find-base-units-rec 1 / neg + var pi error "Unknown name %s in defining expression for unit %s" "Malformed defining expression for unit %s"] 19)) (defun math-units-in-expr-p (expr sub-exprs) (byte-code ":,@=!, @>,8 \",8 \"" [expr sub-exprs var math-check-unit-name (* / ^) math-units-in-expr-p 1 2] 5)) (defun math-only-units-in-expr-p (expr) (byte-code ":=@=!=@>)8!&8!=@==8!=8!" [expr var math-check-unit-name (* /) math-only-units-in-expr-p 1 2 ^ math-realp] 7)) (defun math-single-units-in-expr-p (expr) (byte-code "! \\@=!\\@=?8!8! 3 3̆; ; *\\@=[8\"ŜX8!\\̇" [expr nil u1 u2 t math-scalarp var math-check-unit-name * math-single-units-in-expr-p 1 2 wrong / math-units-in-expr-p] 8)) (defun math-check-unit-name (v) (byte-code "!=a8  \"a8! GV` H \"` O! \"` H=` GV` H=` H=` O! \")" [v math-units-table name math-unit-prefixes car-safe var assq 1 math-build-units-table symbol-name 0 intern nil 77 3 101 2 103] 12)) (defun math-to-standard-units (expr which-standard) (byte-code "!" [expr math-to-standard-rec] 2)) (defun math-to-standard-rec (expr) (byte-code "!=v!8 f 8$ 8!E @ \" 6 8D @ @!P!E) ?a @=a !H \"8Er =q r*:?@>@A\"B" [expr u base st which-standard math-unit-prefixes car-safe var math-check-unit-name 1 math-to-standard-rec assq intern "var-" symbol-name * 0 pi math-pi (bigpos bigneg frac float cplx polar hms date mod var) mapcar] 13)) (defun math-apply-units (expr units ulist &optional pure) (byte-code "` ! !!AL @8\" S !)! @@\"\" @8\"\"A @8\"@@\"\"*o i n E!" [ulist new value expr calc-internal-prec pure units 0 nil math-simplify-units math-numberp error "Incompatible units" math-div 1 math-floor math-normalize math-add math-mul math-sub *] 17)) (defun math-decompose-units (units) (byte-code " !8!=8) ! != E @\"   !=_8!B8@!BA@8@8\"!o \"B, A)" [u units entry calc-internal-prec calc-prefer-frac math-decompose-units-cache ulist nil utemp qty unit math-check-unit-name car-safe 1 + calcFunc-expand equal math-decompose-unit-part 2 error "Inconsistent units in sum" sort (lambda (x y) (byte-code "8 8\"U?" [x y math-compare 1 -1] 4))] 14)) (setq math-decompose-units-cache nil) (defun math-decompose-unit-part (unit) (byte-code "\"!\"B" [unit nil t math-is-multiple math-simplify-units math-to-standard-units] 6)) (defun math-find-compatible-unit (expr unit) (byte-code " ! \")" [u unit expr math-check-unit-name math-find-compatible-unit-rec 1] 4)) (defun math-find-compatible-unit-rec (expr pow) (byte-code "!=8 \"8 \"f!=58 \"28 [\"f!=B8!S8 8\"\"f! 8 8\"e B)" [expr pow t u2 u car-safe * math-find-compatible-unit-rec 1 2 / ^ integerp math-check-unit-name equal 4] 15)) (defun math-convert-units (expr new-units &optional pure) (byte-code "\\ ? \" ? @ A\"\"! A\"\" @ \" A\"\"!\"!u !M @8 !=[ ! \"i !u E\" $+)!" [calc-internal-prec compat pure expr new-units unit-list nil math-combining-units t math-normalize 2 math-find-compatible-unit math-simplify-units math-mul math-div math-pow math-to-standard-units math-decompose-units car-safe + math-units-in-expr-p math-convert-units-rec math-apply-units /] 24)) (defun math-convert-units-rec (expr) (byte-code "\" E\" $/:? @>'/@A\"B" [expr nil new-units unit-list pure math-units-in-expr-p math-apply-units math-to-standard-units / (bigpos bigneg frac float cplx polar hms date mod var) mapcar math-convert-units-rec] 7)) (defun math-convert-temperature (expr old new &optional pure) (byte-code " ! #? 8@\" ! !$ ! :1 87! :@ 8F! @ !P!EE) 8 8= 8= E 8= EE 8= 8= EE E EE 8= E E+" [units expr uold old unew new v t pure math-single-units-in-expr-p equal 1 math-check-unit-name error "Inconsistent temperature units" 3 "Not a valid temperature unit" "Not a pure temperature expression" / var intern "var-" symbol-name K - (float 27315 -2) F + * (frac 9 5) 32 C (frac 9 5) (float 27315 -2) (frac 5 9) (float 27315 -2)] 15)) (defun math-simplify-units (a) (byte-code " !*" [math-simplifying-units t calc-matrix-mode a scalar math-simplify] 2)) (fset (quote calcFunc-usimplify) (symbol-function (quote math-simplify-units))) (math-defsimplify (+ -) (and math-simplifying-units (math-units-in-expr-p (nth 1 expr) nil) (let* ((units (math-extract-units (nth 1 expr))) (ratio (math-simplify (math-to-standard-units (list (quote /) (nth 2 expr) units) nil)))) (if (math-units-in-expr-p ratio nil) (progn (calc-record-why "*Inconsistent units" expr) expr) (list (quote *) (math-add (math-remove-units (nth 1 expr)) (if (eq (car expr) (quote -)) (math-neg ratio) ratio)) units))))) (math-defsimplify * (math-simplify-units-prod)) (defun math-simplify-units-prod nil (byte-code "  8:? 8@> 8! ! AA @ @=6҂7!=NA @!=t8!t8\"A @! ! W @=҂Y W !     @8=8!H \"88\"  \\ L @@>L @@=@=?L  @88\" WL @@=)@5 @@!@!P! @@\"L8\"Y A    \"  =?}  !\"\\W A 8  Z\")\" \" -." [math-simplifying-units calc-autorange-units expr num xpon unitp unit pow u uxpon pref math-unit-prefixes p pxpon pname math-units-table calc-prefer-frac nil 1 (bigpos bigneg frac float) math-float calcFunc-xpon * -1 car-safe ^ integerp 2 math-check-unit-name 0 m 3 reverse assq symbol-name (100 68 104 72) 99 math-build-var-name char-to-string /= math-abs setcar calcFunc-scf] 27)) (math-defsimplify / (and math-simplifying-units (let ((np (cdr expr)) (try-cancel-units 0) n nn) (setq n (if (eq (car-safe (nth 2 expr)) (quote *)) (cdr (nth 2 expr)) (nthcdr 2 expr))) (if (math-realp (car n)) (progn (setcar (cdr expr) (math-mul (nth 1 expr) (let ((calc-prefer-frac nil)) (math-div 1 (car n))))) (setcar n 1))) (while (eq (car-safe (setq n (car np))) (quote *)) (math-simplify-units-divisor (cdr n) (cdr (cdr expr))) (setq np (cdr (cdr n)))) (math-simplify-units-divisor np (cdr (cdr expr))) (if (eq try-cancel-units 0) (let* ((math-simplifying-units nil) (base (math-simplify (math-to-standard-units expr nil)))) (if (math-numberp base) (setq expr base)))) (if (eq (car-safe expr) (quote /)) (math-simplify-units-prod)) expr))) (defun math-simplify-units-divisor (np dp) (byte-code " @ @!=5 8\"+ \" A\" AA  \"J \" \"," [n np d dd temp dp nil car-safe * math-simplify-units-quotient 1 setcar] 9)) (defun math-simplify-units-quotient (n d) (byte-code " != 8! 8 8 !=7 8!7 8 8 ! ! 8 8\"V =c E\" 8 8  @@@@= @A\" @A \"Z\\Ay Ap)**" [pow1 pow2 n d un ud nil ud1 try-cancel-units 1 car-safe ^ integerp 2 math-check-unit-name equal 4 math-to-standard-units / *] 16)) (math-defsimplify ^ (and math-simplifying-units (math-realp (nth 2 expr)) (if (memq (car-safe (nth 1 expr)) (quote (* /))) (list (car (nth 1 expr)) (list (quote ^) (nth 1 (nth 1 expr)) (nth 2 expr)) (list (quote ^) (nth 2 (nth 1 expr)) (nth 2 expr))) (math-simplify-units-pow (nth 1 expr) (nth 2 expr))))) (math-defsimplify calcFunc-sqrt (and math-simplifying-units (if (memq (car-safe (nth 1 expr)) (quote (* /))) (list (car (nth 1 expr)) (list (quote calcFunc-sqrt) (nth 1 (nth 1 expr))) (list (quote calcFunc-sqrt) (nth 2 (nth 1 expr)))) (math-simplify-units-pow (nth 1 expr) (quote (frac 1 2)))))) (math-defsimplify (calcFunc-floor calcFunc-ceil calcFunc-round calcFunc-rounde calcFunc-roundu calcFunc-trunc calcFunc-float calcFunc-frac calcFunc-abs calcFunc-clean) (and math-simplifying-units (= (length expr) 2) (if (math-only-units-in-expr-p (nth 1 expr)) (nth 1 expr) (if (and (memq (car-safe (nth 1 expr)) (quote (* /))) (or (math-only-units-in-expr-p (nth 1 (nth 1 expr))) (math-only-units-in-expr-p (nth 2 (nth 1 expr))))) (list (car (nth 1 expr)) (cons (car expr) (cons (nth 1 (nth 1 expr)) (cdr (cdr expr)))) (cons (car expr) (cons (nth 2 (nth 1 expr)) (cdr (cdr expr))))))))) (defun math-simplify-units-pow (a pow) (byte-code "!=8!8!&8 8\"EQ! ! !=9 8 P P \"P\" E+" [a pow u pf d nil car-safe ^ math-check-unit-name 1 math-realp 2 math-mul math-to-simple-fraction frac math-units-are-multiple math-to-standard-units] 12)) (defun math-units-are-multiple (u n) (byte-code "8@A \"UA?" [u n 4 % 0] 4)) (math-defsimplify calcFunc-sin (and math-simplifying-units (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode (quote rad))) (and (eq (car-safe rad) (quote *)) (math-realp (nth 1 rad)) (eq (car-safe (nth 2 rad)) (quote var)) (eq (nth 1 (nth 2 rad)) (quote rad)) (list (quote calcFunc-sin) (nth 1 rad)))))) (math-defsimplify calcFunc-cos (and math-simplifying-units (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode (quote rad))) (and (eq (car-safe rad) (quote *)) (math-realp (nth 1 rad)) (eq (car-safe (nth 2 rad)) (quote var)) (eq (nth 1 (nth 2 rad)) (quote rad)) (list (quote calcFunc-cos) (nth 1 rad)))))) (math-defsimplify calcFunc-tan (and math-simplifying-units (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode (quote rad))) (and (eq (car-safe rad) (quote *)) (math-realp (nth 1 rad)) (eq (car-safe (nth 2 rad)) (quote var)) (eq (nth 1 (nth 2 rad)) (quote rad)) (list (quote calcFunc-tan) (nth 1 rad)))))) (defun math-remove-units (expr) (byte-code "! ‚#:?@>#@A\"B" [expr math-check-unit-name 1 (bigpos bigneg frac float cplx polar hms date mod var) mapcar math-remove-units] 5)) (defun math-extract-units (expr) (byte-code "!>@A\"B!Ƈ" [expr car-safe (* /) mapcar math-extract-units math-check-unit-name 1] 5)) (defun math-build-units-table-buffer (enter-buffer) (byte-code " !?! =ł      ! qʼn cc 8 @  8  @=lω  y @\"   GV H= =c O c c @!c c 8j 8!c jcj c 8 8\"c @!c cjc  c #c, 8,cc APc  @  @!\" 8 88\"q A@@!#sc 88!\"j 8# A@@=ňAcω!)ωp qebq) ! !. !!!!" [math-units-table math-units-table-buffer-valid buf uptr calc-language nil calc-float-format calc-group-digits calc-number-radix calc-point-char std u name shadowed buffer-read-only t math-additional-units math-unit-prefixes oldbuf enter-buffer get-buffer "*Units Table*" get-buffer-create math-build-units-table big (float 0) 10 "." message "Formatting units table..." erase-buffer "Calculator Units Table: " "Unit Type Definition Description " 2 m assq 1 0 42 " " " " "(" symbol-name ")" 3 "U" 14 math-format-value 80 41 " (redefined above)" " (base unit)" " Unit Prefix Table: " insert char-to-string equal " " " " "10^" int-to-string 15 "Formatting units table...done" pop-to-buffer display-buffer] 26)) (setq math-units-table '((m nil "*Meter" nil ((m . 1))) (in (* (float 254 -2) (var cm var-cm)) "Inch" nil ((m . 1))) (ft (* 12 (var in var-in)) "Foot" nil ((m . 1))) (yd (* 3 (var ft var-ft)) "Yard" nil ((m . 1))) (mi (* 5280 (var ft var-ft)) "Mile" nil ((m . 1))) (au (* (float (bigpos 979 495 1) 5) (var m var-m)) "Astronomical Unit" nil ((m . 1))) (lyr (* (bigpos 16 68 207 536 460 9) (var m var-m)) "Light Year" nil ((m . 1))) (pc (* (float (bigpos 625 480 626 20) -5) (var au var-au)) "Parsec" nil ((m . 1))) (nmi (* 1852 (var m var-m)) "Nautical Mile" nil ((m . 1))) (fath (* 6 (var ft var-ft)) "Fathom" nil ((m . 1))) (u (* 1 (var um var-um)) "Micron" nil ((m . 1))) (mil (/ (var in var-in) 1000) "Mil" nil ((m . 1))) (point (/ (var in var-in) 72) "Point (1/72 inch)" nil ((m . 1))) (tpt (/ (var in var-in) (float 7227 -2)) "Point (TeX conventions)" nil ((m . 1))) (Ang (* (float 1 -10) (var m var-m)) "Angstrom" nil ((m . 1))) (mfi (+ (+ (var mi var-mi) (var ft var-ft)) (var in var-in)) "Miles + feet + inches" nil ((m . 1))) (hect (* 10000 (^ (var m var-m) 2)) "*Hectare" nil ((m . 2))) (acre (/ (^ (var mi var-mi) 2) 640) "Acre" nil ((m . 2))) (b (* (float 1 -28) (^ (var m var-m) 2)) "Barn" nil ((m . 2))) (l (* (float 1 -3) (^ (var m var-m) 3)) "*Liter" nil ((m . 3))) (L (* (float 1 -3) (^ (var m var-m) 3)) "Liter" nil ((m . 3))) (gal (* 4 (var qt var-qt)) "US Gallon" nil ((m . 3))) (qt (* 2 (var pt var-pt)) "Quart" nil ((m . 3))) (pt (* 2 (var cup var-cup)) "Pint" nil ((m . 3))) (cup (* 8 (var ozfl var-ozfl)) "Cup" nil ((m . 3))) (ozfl (* 2 (var tbsp var-tbsp)) "Fluid Ounce" nil ((m . 3))) (floz (* 2 (var tbsp var-tbsp)) "Fluid Ounce" nil ((m . 3))) (tbsp (* 3 (var tsp var-tsp)) "Tablespoon" nil ((m . 3))) (tsp (* (float (bigpos 375 159 892 492) -11) (var ml var-ml)) "Teaspoon" nil ((m . 3))) (vol (+ (+ (+ (+ (+ (+ (var tsp var-tsp) (var tbsp var-tbsp)) (var ozfl var-ozfl)) (var cup var-cup)) (var pt var-pt)) (var qt var-qt)) (var gal var-gal)) "Gallons + ... + teaspoons" nil ((m . 3))) (galC (* (float 454609 -5) (var l var-l)) "Canadian Gallon" nil ((m . 3))) (galUK (* (float (bigpos 92 546 4) -6) (var l var-l)) "UK Gallon" nil ((m . 3))) (s nil "*Second" nil ((s . 1))) (sec (var s var-s) "Second" nil ((s . 1))) (min (* 60 (var s var-s)) "Minute" nil ((s . 1))) (hr (* 60 (var min var-min)) "Hour" nil ((s . 1))) (day (* 24 (var hr var-hr)) "Day" nil ((s . 1))) (wk (* 7 (var day var-day)) "Week" nil ((s . 1))) (hms (+ (+ (+ (+ (var wk var-wk) (var day var-day)) (var hr var-hr)) (var min var-min)) (var s var-s)) "Hours, minutes, seconds" nil ((s . 1))) (yr (* (float 36525 -2) (var day var-day)) "Year" nil ((s . 1))) (Hz (/ 1 (var s var-s)) "Hertz" nil ((s . -1))) (mph (/ (var mi var-mi) (var hr var-hr)) "*Miles per hour" nil ((m . 1) (s . -1))) (kph (/ (var km var-km) (var hr var-hr)) "Kilometers per hour" nil ((m . 1) (s . -1))) (knot (/ (var nmi var-nmi) (var hr var-hr)) "Knot" nil ((m . 1) (s . -1))) (c (/ (* (float (bigpos 458 792 299) 0) (var m var-m)) (var s var-s)) "Speed of light" nil ((m . 1) (s . -1))) (ga (/ (* (float 980665 -5) (var m var-m)) (^ (var s var-s) 2)) "*\"g\" acceleration" nil ((m . 1) (s . -2))) (g nil "*Gram" nil ((g . 1))) (lb (* 16 (var oz var-oz)) "Pound (mass)" nil ((g . 1))) (oz (* (float (bigpos 125 523 349 28) -9) (var g var-g)) "Ounce (mass)" nil ((g . 1))) (ton (* 2000 (var lb var-lb)) "Ton" nil ((g . 1))) (tpo (+ (+ (var ton var-ton) (var lb var-lb)) (var oz var-oz)) "Tons + pounds + ounces (mass)" nil ((g . 1))) (t (* 1000 (var kg var-kg)) "Metric ton" nil ((g . 1))) (tonUK (* (float (bigpos 88 469 160 10) -7) (var kg var-kg)) "UK ton" nil ((g . 1))) (lbt (* 12 (var ozt var-ozt)) "Troy pound" nil ((g . 1))) (ozt (* (float (bigpos 475 103 31) -6) (var g var-g)) "Troy ounce" nil ((g . 1))) (ct (* (float 2 -1) (var g var-g)) "Carat" nil ((g . 1))) (amu (* (float (bigpos 402 605 16) -31) (var g var-g)) "Unified atomic mass" nil ((g . 1))) (N (/ (* (var m var-m) (var kg var-kg)) (^ (var s var-s) 2)) "*Newton" nil ((m . 1) (s . -2) (g . 1))) (dyn (* (float 1 -5) (var N var-N)) "Dyne" nil ((m . 1) (s . -2) (g . 1))) (gf (* (var ga var-ga) (var g var-g)) "Gram (force)" nil ((m . 1) (s . -2) (g . 1))) (lbf (* (float (bigpos 526 161 822 444) -11) (var N var-N)) "Pound (force)" nil ((m . 1) (s . -2) (g . 1))) (kip (* 1000 (var lbf var-lbf)) "Kilopound (force)" nil ((m . 1) (s . -2) (g . 1))) (pdl (* (float 138255 -6) (var N var-N)) "Poundal" nil ((m . 1) (s . -2) (g . 1))) (J (* (var N var-N) (var m var-m)) "*Joule" nil ((m . 2) (s . -2) (g . 1))) (erg (* (float 1 -7) (var J var-J)) "Erg" nil ((m . 2) (s . -2) (g . 1))) (cal (* (float 41868 -4) (var J var-J)) "International Table Calorie" nil ((m . 2) (s . -2) (g . 1))) (Btu (* (float (bigpos 262 585 505 105) -8) (var J var-J)) "International Table Btu" nil ((m . 2) (s . -2) (g . 1))) (eV (* (var ech var-ech) (var V var-V)) "Electron volt" nil ((m . 2) (s . -2) (g . 1))) (ev (var eV var-eV) "Electron volt" nil ((m . 2) (s . -2) (g . 1))) (therm (* (bigpos 0 506 105) (var J var-J)) "EEC therm" nil ((m . 2) (s . -2) (g . 1))) (invcm (/ (* (var h var-h) (var c var-c)) (var cm var-cm)) "Energy in inverse centimeters" nil ((m . 2) (s . -2) (g . 1))) (Kayser (var invcm var-invcm) "Kayser (inverse centimeter energy)" nil ((m . 2) (s . -2) (g . 1))) (men (/ 100 (var invcm var-invcm)) "Inverse energy in meters" nil ((m . -2) (s . 2) (g . -1))) (Hzen (* (var h var-h) (var Hz var-Hz)) "Energy in Hertz" nil ((m . 2) (s . -2) (g . 1))) (Ken (* (var k var-k) (var K var-K)) "Energy in Kelvins" nil ((m . 2) (s . -2) (g . 1))) (W (/ (var J var-J) (var s var-s)) "*Watt" nil ((m . 2) (s . -3) (g . 1))) (hp (* (float 7457 -1) (var W var-W)) "Horsepower" nil ((m . 2) (s . -3) (g . 1))) (K nil "*Degree Kelvin" K ((K . 1))) (dK (var K var-K) "Degree Kelvin" K ((K . 1))) (degK (var K var-K) "Degree Kelvin" K ((K . 1))) (dC (var K var-K) "Degree Celsius" C ((K . 1))) (degC (var K var-K) "Degree Celsius" C ((K . 1))) (dF (* (/ 5 9) (var K var-K)) "Degree Fahrenheit" F ((K . 1))) (degF (* (/ 5 9) (var K var-K)) "Degree Fahrenheit" F ((K . 1))) (Pa (/ (var N var-N) (^ (var m var-m) 2)) "*Pascal" nil ((m . -1) (s . -2) (g . 1))) (bar (* (float 1 5) (var Pa var-Pa)) "Bar" nil ((m . -1) (s . -2) (g . 1))) (atm (* 101325 (var Pa var-Pa)) "Standard atmosphere" nil ((m . -1) (s . -2) (g . 1))) (torr (/ (var atm var-atm) 760) "Torr" nil ((m . -1) (s . -2) (g . 1))) (mHg (* 1000 (var torr var-torr)) "Meter of mercury" nil ((m . -1) (s . -2) (g . 1))) (inHg (* (float 254 -1) (var mmHg var-mmHg)) "Inch of mercury" nil ((m . -1) (s . -2) (g . 1))) (inH2O (* (float 24884 -2) (var Pa var-Pa)) "Inch of water" nil ((m . -1) (s . -2) (g . 1))) (psi (* (float (bigpos 317 729 475 689) -8) (var Pa var-Pa)) "Pound per square inch" nil ((m . -1) (s . -2) (g . 1))) (P (* (float 1 -1) (* (var Pa var-Pa) (var s var-s))) "*Poise" nil ((m . -1) (s . -1) (g . 1))) (St (/ (* (float 1 -4) (^ (var m var-m) 2)) (var s var-s)) "Stokes" nil ((m . 2) (s . -1))) (A nil "*Ampere" nil ((A . 1))) (C (* (var A var-A) (var s var-s)) "Coulomb" nil ((s . 1) (A . 1))) (Fdy (* (var ech var-ech) (var Nav var-Nav)) "Faraday" nil ((s . 1) (A . 1) (mol . -1))) (e (* (float (bigpos 733 217 160) -27) (var C var-C)) "Elementary charge" nil ((s . 1) (A . 1))) (ech (* (float (bigpos 733 217 160) -27) (var C var-C)) "Elementary charge" nil ((s . 1) (A . 1))) (V (/ (var W var-W) (var A var-A)) "Volt" nil ((m . 2) (s . -3) (g . 1) (A . -1))) (ohm (/ (var V var-V) (var A var-A)) "Ohm" nil ((m . 2) (s . -3) (g . 1) (A . -2))) (mho (/ (var A var-A) (var V var-V)) "Mho" nil ((m . -2) (s . 3) (g . -1) (A . 2))) (S (/ (var A var-A) (var V var-V)) "Siemens" nil ((m . -2) (s . 3) (g . -1) (A . 2))) (F (/ (var C var-C) (var V var-V)) "Farad" nil ((m . -2) (s . 4) (g . -1) (A . 2))) (H (/ (var Wb var-Wb) (var A var-A)) "Henry" nil ((m . 2) (s . -2) (g . 1) (A . -2))) (T (/ (var Wb var-Wb) (^ (var m var-m) 2)) "Tesla" nil ((s . -2) (g . 1) (A . -1))) (G (* (float 1 -4) (var T var-T)) "Gauss" nil ((s . -2) (g . 1) (A . -1))) (Wb (* (var V var-V) (var s var-s)) "Weber" nil ((m . 2) (s . -2) (g . 1) (A . -1))) (cd nil "*Candela" nil ((cd . 1))) (sb (/ (* (float 1 4) (var cd var-cd)) (^ (var m var-m) 2)) "Stilb" nil ((m . -2) (cd . 1))) (lm (* (var cd var-cd) (var sr var-sr)) "Lumen" nil ((cd . 1) (sr . 1))) (lx (/ (var lm var-lm) (^ (var m var-m) 2)) "Lux" nil ((m . -2) (cd . 1) (sr . 1))) (ph (* (float 1 4) (var lx var-lx)) "Phot" nil ((m . -2) (cd . 1) (sr . 1))) (fc (* (float 1076 -2) (var lx var-lx)) "Footcandle" nil ((m . -2) (cd . 1) (sr . 1))) (lam (/ (* (float 1 4) (var lm var-lm)) (^ (var m var-m) 2)) "Lambert" nil ((m . -2) (cd . 1) (sr . 1))) (flam (* (float (bigpos 104 639 107) -11) (var lam var-lam)) "Footlambert" nil ((m . -2) (cd . 1) (sr . 1))) (Bq (/ 1 (var s var-s)) "*Becquerel" nil ((s . -1))) (Ci (* (float 37 9) (var Bq var-Bq)) "Curie" nil ((s . -1))) (Gy (/ (var J var-J) (var kg var-kg)) "Gray" nil ((m . 2) (s . -2))) (Sv (var Gy var-Gy) "Sievert" nil ((m . 2) (s . -2))) (R (/ (* (float 258 -6) (var C var-C)) (var kg var-kg)) "Roentgen" nil ((s . 1) (g . -1) (A . 1))) (rd (* (float 1 -2) (var Gy var-Gy)) "Rad" nil ((m . 2) (s . -2))) (rem (var rd var-rd) "Rem" nil ((m . 2) (s . -2))) (mol nil "*Mole" nil ((mol . 1))) (rad nil "*Radian" nil ((rad . 1))) (circ (* 2 (* (var pi var-pi) (var rad var-rad))) "Full circle" nil ((rad . 1))) (rev (var circ var-circ) "Full revolution" nil ((rad . 1))) (deg (/ (var circ var-circ) 360) "Degree" nil ((rad . 1))) (arcmin (/ (var deg var-deg) 60) "Arc minute" nil ((rad . 1))) (arcsec (/ (var arcmin var-arcmin) 60) "Arc second" nil ((rad . 1))) (grad (/ (var circ var-circ) 400) "Grade" nil ((rad . 1))) (rpm (/ (var rev var-rev) (var min var-min)) "Revolutions per minute" nil ((s . -1) (rad . 1))) (sr nil "*Steradian" nil ((sr . 1))) (h (* (float (bigpos 755 260 66) -41) (* (var J var-J) (var s var-s))) "*Planck's constant" nil ((m . 2) (s . -1) (g . 1))) (hbar (/ (var h var-h) (* 2 (var pi var-pi))) "Planck's constant" nil ((m . 2) (s . -1) (g . 1))) (mu0 (/ (* 4 (* (var pi var-pi) (* (float 1 -7) (var H var-H)))) (var m var-m)) "Permeability of vacuum" nil ((m . 1) (s . -2) (g . 1) (A . -2))) (Grav (/ (* (float 667259 -16) (* (var N var-N) (^ (var m var-m) 2))) (^ (var kg var-kg) 2)) "Gravitational constant" nil ((m . 3) (s . -2) (g . -1))) (Nav (/ (float (bigpos 367 221 60) 16) (var mol var-mol)) "Avagadro's constant" nil ((mol . -1))) (me (/ (* (float (bigpos 906 99 51) -8) (var MeV var-MeV)) (^ (var c var-c) 2)) "Electron rest mass" nil ((g . 1))) (mp (* (float (bigpos 647 727 100) -8) (var amu var-amu)) "Proton rest mass" nil ((g . 1))) (mn (* (float (bigpos 904 664 8 1) -9) (var amu var-amu)) "Neutron rest mass" nil ((g . 1))) (mu (* (float (bigpos 913 428 113) -9) (var amu var-amu)) "Muon rest mass" nil ((g . 1))) (Ryd (* (float (bigpos 571 731 973 10) -5) (var invcm var-invcm)) "Rydberg's constant" nil ((m . 2) (s . -2) (g . 1))) (k (/ (* (float (bigpos 513 806 13) -30) (var J var-J)) (var K var-K)) "Boltzmann's constant" nil ((m . 2) (s . -2) (g . 1) (K . -1))) (fsc (/ 1 (float (bigpos 895 359 370 1) -7)) "Fine structure constant" nil nil) (muB (/ (* (float (bigpos 263 838 578) -19) (var MeV var-MeV)) (var T var-T)) "Bohr magneton" nil ((m . 2) (A . 1))) (muN (/ (* (float (bigpos 166 245 315) -22) (var MeV var-MeV)) (var T var-T)) "Nuclear magneton" nil ((m . 2) (A . 1))) (mue (* (float (bigpos 219 965 115 100) -11) (var muB var-muB)) "Electron magnetic moment" nil ((m . 2) (A . 1))) (mup (* (float (bigpos 386 847 792 2) -9) (var muN var-muN)) "Proton magnetic moment" nil ((m . 2) (A . 1))) (R0 (* (var Nav var-Nav) (var k var-k)) "Molar gas constant" nil ((m . 2) (s . -2) (g . 1) (K . -1) (mol . -1))) (V0 (/ (* (float (bigpos 992 413 22) -6) (var L var-L)) (var mol var-mol)) "Standard volume of ideal gas" nil ((m . 3) (mol . -1)))))