1 |
;; Calculator for GNU Emacs, part II [calc-comp.el] |
;;; calccomp.el --- composition functions for Calc |
2 |
|
|
3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
4 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
|
5 |
|
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
|
;; Maintainer: Colin Walters <walters@debian.org> |
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
22 |
;; file named COPYING. Among other things, the copyright notice |
;; file named COPYING. Among other things, the copyright notice |
23 |
;; and this notice must be preserved on all copies. |
;; and this notice must be preserved on all copies. |
24 |
|
|
25 |
|
;;; Commentary: |
26 |
|
|
27 |
|
;;; Code: |
28 |
|
|
29 |
;; This file is autoloaded from calc-ext.el. |
;; This file is autoloaded from calc-ext.el. |
30 |
(require 'calc-ext) |
(require 'calc-ext) |
33 |
|
|
34 |
(defun calc-Need-calc-comp () nil) |
(defun calc-Need-calc-comp () nil) |
35 |
|
|
36 |
|
(defconst math-eqn-special-funcs |
37 |
|
'( calcFunc-log |
38 |
|
calcFunc-ln calcFunc-exp |
39 |
|
calcFunc-sin calcFunc-cos calcFunc-tan |
40 |
|
calcFunc-sinh calcFunc-cosh calcFunc-tanh |
41 |
|
calcFunc-arcsin calcFunc-arccos calcFunc-arctan |
42 |
|
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) |
43 |
|
|
44 |
;;; A "composition" has one of the following forms: |
;;; A "composition" has one of the following forms: |
45 |
;;; |
;;; |
892 |
0) |
0) |
893 |
right))))))))) |
right))))))))) |
894 |
|
|
|
(defconst math-eqn-special-funcs |
|
|
'( calcFunc-log |
|
|
calcFunc-ln calcFunc-exp |
|
|
calcFunc-sin calcFunc-cos calcFunc-tan |
|
|
calcFunc-sinh calcFunc-cosh calcFunc-tanh |
|
|
calcFunc-arcsin calcFunc-arccos calcFunc-arctan |
|
|
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh |
|
|
)) |
|
|
|
|
895 |
|
|
896 |
(defun math-prod-first-term (x) |
(defun math-prod-first-term (x) |
897 |
(while (eq (car-safe x) '*) |
(while (eq (car-safe x) '*) |
996 |
(<= (nth 1 (car a)) 255))))) |
(<= (nth 1 (car a)) 255))))) |
997 |
(null a)) |
(null a)) |
998 |
|
|
999 |
|
(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" ) |
1000 |
|
( ?\\ . "\\\\" ) |
1001 |
|
( ?\a . "\\a" ) |
1002 |
|
( ?\b . "\\b" ) |
1003 |
|
( ?\e . "\\e" ) |
1004 |
|
( ?\f . "\\f" ) |
1005 |
|
( ?\n . "\\n" ) |
1006 |
|
( ?\r . "\\r" ) |
1007 |
|
( ?\t . "\\t" ) |
1008 |
|
( ?\^? . "\\^?" ))) |
1009 |
|
|
1010 |
(defun math-vector-to-string (a &optional quoted) |
(defun math-vector-to-string (a &optional quoted) |
1011 |
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) |
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) |
1012 |
(cdr a)))) |
(cdr a)))) |
1029 |
(if quoted |
(if quoted |
1030 |
(concat "\"" a "\"") |
(concat "\"" a "\"") |
1031 |
a)) |
a)) |
1032 |
(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" ) |
|
|
( ?\\ . "\\\\" ) |
|
|
( ?\a . "\\a" ) |
|
|
( ?\b . "\\b" ) |
|
|
( ?\e . "\\e" ) |
|
|
( ?\f . "\\f" ) |
|
|
( ?\n . "\\n" ) |
|
|
( ?\r . "\\r" ) |
|
|
( ?\t . "\\t" ) |
|
|
( ?\^? . "\\^?" ) |
|
|
)) |
|
1033 |
|
|
1034 |
(defun math-to-underscores (x) |
(defun math-to-underscores (x) |
1035 |
(if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x) |
(if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x) |
1071 |
(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) |
(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) |
1072 |
(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) |
(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) |
1073 |
(defun math-compose-deriv (a prec) |
(defun math-compose-deriv (a prec) |
1074 |
(and (= (length a) 3) |
(when (= (length a) 3) |
1075 |
(math-compose-expr (list '/ |
(math-compose-expr (list '/ |
1076 |
(list 'calcFunc-choriz |
(list 'calcFunc-choriz |
1077 |
(list 'vec |
(list 'vec |
1078 |
'(calcFunc-string (vec ?d)) |
'(calcFunc-string (vec ?d)) |
1079 |
(nth 1 a))) |
(nth 1 a))) |
1080 |
(list 'calcFunc-choriz |
(list 'calcFunc-choriz |
1081 |
(list 'vec |
(list 'vec |
1082 |
'(calcFunc-string (vec ?d)) |
'(calcFunc-string (vec ?d)) |
1083 |
(nth 2 a)))) |
(nth 2 a)))) |
1084 |
prec))) |
prec))) |
1085 |
|
|
1086 |
(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) |
(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) |
1087 |
(defun math-compose-sqrt (a prec) |
(defun math-compose-sqrt (a prec) |
1088 |
(and (= (length a) 2) |
(when (= (length a) 2) |
1089 |
(let* ((c (math-compose-expr (nth 1 a) 0)) |
(let* ((c (math-compose-expr (nth 1 a) 0)) |
1090 |
(a (math-comp-ascent c)) |
(a (math-comp-ascent c)) |
1091 |
(d (math-comp-descent c)) |
(d (math-comp-descent c)) |
1092 |
(h (+ a d)) |
(h (+ a d)) |
1093 |
(w (math-comp-width c))) |
(w (math-comp-width c))) |
1094 |
(list 'vleft |
(list 'vleft |
1095 |
a |
a |
1096 |
(concat (if (= h 1) " " " ") |
(concat (if (= h 1) " " " ") |
1097 |
(make-string (+ w 2) ?\_)) |
(make-string (+ w 2) ?\_)) |
1098 |
(list 'horiz |
(list 'horiz |
1099 |
(if (= h 1) |
(if (= h 1) |
1100 |
"V" |
"V" |
1101 |
(append (list 'vleft (1- a)) |
(append (list 'vleft (1- a)) |
1102 |
(make-list (1- h) " |") |
(make-list (1- h) " |") |
1103 |
'("\\|"))) |
'("\\|"))) |
1104 |
" " |
" " |
1105 |
c))))) |
c))))) |
1106 |
|
|
1107 |
(put 'calcFunc-choose 'math-compose-big 'math-compose-choose) |
(put 'calcFunc-choose 'math-compose-big 'math-compose-choose) |
1108 |
(defun math-compose-choose (a prec) |
(defun math-compose-choose (a prec) |
1249 |
(math-vert-comp-to-string |
(math-vert-comp-to-string |
1250 |
(math-comp-simplify c width))))) |
(math-comp-simplify c width))))) |
1251 |
|
|
1252 |
|
(defvar math-comp-buf-string (make-vector 10 "")) |
1253 |
|
(defvar math-comp-buf-margin (make-vector 10 0)) |
1254 |
|
(defvar math-comp-buf-level (make-vector 10 0)) |
1255 |
(defun math-comp-is-flat (c) ; check if c's height is 1. |
(defun math-comp-is-flat (c) ; check if c's height is 1. |
1256 |
(cond ((not (consp c)) t) |
(cond ((not (consp c)) t) |
1257 |
((memq (car c) '(set break)) t) |
((memq (car c) '(set break)) t) |
1299 |
(setq prefix " ")) |
(setq prefix " ")) |
1300 |
(setq prefix "\n")))) |
(setq prefix "\n")))) |
1301 |
(concat comp-buf prefix str))))) |
(concat comp-buf prefix str))))) |
|
(setq math-comp-buf-string (make-vector 10 "")) |
|
|
(setq math-comp-buf-margin (make-vector 10 0)) |
|
|
(setq math-comp-buf-level (make-vector 10 0)) |
|
1302 |
|
|
1303 |
(defun math-comp-to-string-flat-term (c) |
(defun math-comp-to-string-flat-term (c) |
1304 |
(cond ((not (consp c)) |
(cond ((not (consp c)) |