1 ;;; calc-graph.el --- graph output functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainers: D. Goel <deego@gnufans.org>
7 ;; Colin Walters <walters@debian.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
13 ;; accepts responsibility to anyone for the consequences of using it
14 ;; or for whether it serves any particular purpose or works at all,
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
16 ;; License for full details.
18 ;; Everyone is granted permission to copy, modify and redistribute
19 ;; GNU Emacs, but only under the conditions described in the
20 ;; GNU Emacs General Public License. A copy of this license is
21 ;; supposed to have been given to you along with GNU Emacs so you
22 ;; can know your rights and responsibilities. It should be in a
23 ;; file named COPYING. Among other things, the copyright notice
24 ;; and this notice must be preserved on all copies.
30 ;; This file is autoloaded from calc-ext.el.
35 (defun calc-Need-calc-graph () nil)
40 ;;; Note that some of the following initial values also occur in calc.el.
41 (defvar calc-gnuplot-tempfile "calc")
43 (defvar calc-gnuplot-default-device "default")
44 (defvar calc-gnuplot-default-output "STDOUT")
45 (defvar calc-gnuplot-print-device "postscript")
46 (defvar calc-gnuplot-print-output "auto")
47 (defvar calc-gnuplot-keep-outfile nil)
48 (defvar calc-gnuplot-version nil)
50 (defvar calc-gnuplot-display (getenv "DISPLAY"))
51 (defvar calc-gnuplot-geometry nil)
53 (defvar calc-graph-default-resolution 15)
54 (defvar calc-graph-default-resolution-3d 5)
55 (defvar calc-graph-default-precision 5)
57 (defvar calc-gnuplot-buffer nil)
58 (defvar calc-gnuplot-input nil)
60 (defvar calc-gnuplot-last-error-pos 1)
61 (defvar calc-graph-last-device nil)
62 (defvar calc-graph-last-output nil)
63 (defvar calc-graph-file-cache nil)
64 (defvar calc-graph-var-cache nil)
65 (defvar calc-graph-data-cache nil)
66 (defvar calc-graph-data-cache-limit 10)
67 (defvar calc-graph-no-auto-view nil)
68 (defvar calc-graph-no-wait nil)
70 (defun calc-graph-fast (many)
72 (let ((calc-graph-no-auto-view t))
75 (calc-graph-plot nil)))
77 (defun calc-graph-fast-3d (many)
79 (let ((calc-graph-no-auto-view t))
81 (calc-graph-add-3d many)
82 (calc-graph-plot nil)))
84 (defun calc-graph-delete (all)
89 (set-buffer calc-gnuplot-input)
90 (and (calc-graph-find-plot t all)
92 (if (looking-at "s?plot")
94 (setq calc-graph-var-cache nil)
95 (delete-region (point) (point-max)))
96 (delete-region (point) (1- (point-max)))))))
97 (calc-graph-view-commands)))
99 (defun calc-graph-find-plot (&optional before all)
100 (goto-char (point-min))
101 (and (re-search-forward "^s?plot[ \t]+" nil t)
103 (goto-char (point-max))
105 (not (search-backward "," nil t))
110 (beginning-of-line)))
112 (re-search-forward ",[ \t]+")))
115 (defun calc-graph-add (many)
120 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
121 (calc-graph-lookup (calc-top-n 1))))
122 ((or (consp many) (eq many 0))
123 (let ((xdata (calc-graph-lookup (calc-top-n 2)))
124 (ylist (calc-top-n 1)))
125 (or (eq (car-safe ylist) 'vec)
126 (error "Y argument must be a vector"))
127 (while (setq ylist (cdr ylist))
128 (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
129 ((> (setq many (prefix-numeric-value many)) 0)
130 (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
132 (calc-graph-add-curve xdata
133 (calc-graph-lookup (calc-top-n many)))
134 (setq many (1- many)))))
139 (setq pair (calc-top-n many))
140 (or (and (eq (car-safe pair) 'vec)
142 (error "Argument must be an [x,y] vector"))
143 (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
144 (calc-graph-lookup (nth 2 pair)))
145 (setq many (1- many))))))
146 (calc-graph-view-commands)))
148 (defun calc-graph-add-3d (many)
153 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
154 (calc-graph-lookup (calc-top-n 2))
155 (calc-graph-lookup (calc-top-n 1))))
156 ((or (consp many) (eq many 0))
157 (let ((xdata (calc-graph-lookup (calc-top-n 3)))
158 (ydata (calc-graph-lookup (calc-top-n 2)))
159 (zlist (calc-top-n 1)))
160 (or (eq (car-safe zlist) 'vec)
161 (error "Z argument must be a vector"))
162 (while (setq zlist (cdr zlist))
163 (calc-graph-add-curve xdata ydata
164 (calc-graph-lookup (car zlist))))))
165 ((> (setq many (prefix-numeric-value many)) 0)
166 (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
167 (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
169 (calc-graph-add-curve xdata ydata
170 (calc-graph-lookup (calc-top-n many)))
171 (setq many (1- many)))))
176 (setq curve (calc-top-n many))
177 (or (and (eq (car-safe curve) 'vec)
178 (= (length curve) 4))
179 (error "Argument must be an [x,y,z] vector"))
180 (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
181 (calc-graph-lookup (nth 2 curve))
182 (calc-graph-lookup (nth 3 curve)))
183 (setq many (1- many))))))
184 (calc-graph-view-commands)))
186 (defun calc-graph-add-curve (xdata ydata &optional zdata)
187 (let ((num (calc-graph-count-curves))
188 (pstyle (calc-var-value 'var-PointStyles))
189 (lstyle (calc-var-value 'var-LineStyles)))
191 (set-buffer calc-gnuplot-input)
192 (goto-char (point-min))
193 (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
195 (error "Can't mix 2d and 3d curves on one graph"))
196 (if (re-search-forward "^s?plot[ \t]" nil t)
200 (goto-char (point-max))
201 (or (eq (preceding-char) ?\n)
203 (insert (if zdata "splot" "plot") " \n")
205 (insert "{" (symbol-name (nth 1 xdata))
206 ":" (symbol-name (nth 1 ydata)))
208 (insert ":" (symbol-name (nth 1 zdata))))
210 "title \"" (symbol-name (nth 1 ydata)) "\" "
212 (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
213 (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle)))
214 (calc-graph-set-styles
215 (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
217 (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
218 (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
221 (defun calc-graph-lookup (thing)
222 (if (and (eq (car-safe thing) 'var)
223 (calc-var-value (nth 2 thing)))
225 (let ((found (assoc thing calc-graph-var-cache)))
228 (setq varname (concat "PlotData"
230 (1+ (length calc-graph-var-cache))))
231 var (list 'var (intern varname)
232 (intern (concat "var-" varname)))
233 found (cons thing var)
234 calc-graph-var-cache (cons found calc-graph-var-cache))
235 (set (nth 2 var) thing)))
238 (defun calc-graph-juggle (arg)
242 (set-buffer calc-gnuplot-input)
244 (let ((num (calc-graph-count-curves)))
247 (setq arg (+ arg num))))))
248 (while (>= (setq arg (1- arg)) 0)
249 (calc-graph-do-juggle))))
251 (defun calc-graph-count-curves ()
253 (set-buffer calc-gnuplot-input)
254 (if (re-search-forward "^s?plot[ \t]" nil t)
256 (goto-char (point-min))
257 (while (search-forward "," nil t)
262 (defun calc-graph-do-juggle ()
264 (and (calc-graph-find-plot t t)
267 (calc-graph-find-plot t nil)
268 (or (eq base (point))
269 (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
270 (delete-region (point) (1- (point-max)))
271 (goto-char (+ base 5))
272 (insert str ", ")))))))
274 (defun calc-graph-print (flag)
276 (calc-graph-plot flag t))
278 (defun calc-graph-plot (flag &optional printing)
281 (let ((calcbuf (current-buffer))
282 (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
286 (refine (and flag (> (prefix-numeric-value flag) 0)))
287 (recompute (and flag (< (prefix-numeric-value flag) 0)))
290 cache-env is-splot device output resolution precision samples-pos)
291 (or (boundp 'calc-graph-prev-kill-hook)
292 (if calc-emacs-type-19
294 (setq calc-graph-prev-kill-hook nil)
295 (add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
296 (setq calc-graph-prev-kill-hook kill-emacs-hook)
297 (setq kill-emacs-hook 'calc-graph-kill-hook)))
302 (set-buffer calc-gnuplot-input)
303 (goto-char (point-min))
304 (setq is-splot (re-search-forward "^splot[ \t]" nil t))
305 (let ((str (buffer-string))
306 (ver calc-gnuplot-version))
307 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
309 (insert "# (Note: This is a temporary copy---do not edit!)\n")
311 (insert "set noarrow\nset nolabel\n"
312 "set autoscale xy\nset nologscale xy\n"
313 "set xlabel\nset ylabel\nset title\n"
314 "set noclip points\nset clip one\nset clip two\n"
315 "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
316 "set data style linespoints\n"
317 "set nogrid\nset nokey\nset nopolar\n"))
319 (insert "set surface\nset nocontour\n"
320 "set " (if is-splot "" "no") "parametric\n"
321 "set notime\nset border\nset ztics\nset zeroaxis\n"
322 "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
323 (setq samples-pos (point))
325 (goto-char (point-min))
328 (error "This option works only for 2d plots")
330 (let ((calc-gnuplot-input (current-buffer))
331 (calc-graph-no-auto-view t))
333 (setq device calc-gnuplot-print-device
334 output calc-gnuplot-print-output)
335 (setq device (calc-graph-find-command "terminal")
336 output (calc-graph-find-command "output"))
338 (setq device calc-gnuplot-default-device))
340 (setq output (car (read-from-string output)))
341 (setq output calc-gnuplot-default-output)))
342 (if (or (equal device "") (equal device "default"))
343 (setq device (if printing
345 (if (or (eq window-system 'x) (getenv "DISPLAY"))
347 (if (>= calc-gnuplot-version 3)
348 "dumb" "postscript")))))
349 (if (equal device "dumb")
350 (setq device (format "dumb %d %d"
351 (1- (frame-width)) (1- (frame-height)))))
352 (if (equal device "big")
353 (setq device (format "dumb %d %d"
354 (* 4 (- (frame-width) 3))
355 (* 4 (- (frame-height) 3)))))
357 (if (or (equal output "auto")
358 (and (equal output "tty") (setq tty-output t)))
359 (setq tempoutfile (calc-temp-file-name -1)
361 (setq output (eval output)))
362 (or (equal device calc-graph-last-device)
364 (setq calc-graph-last-device device)
365 (calc-gnuplot-command "set terminal" device)))
366 (or (equal output calc-graph-last-output)
368 (setq calc-graph-last-output output)
369 (calc-gnuplot-command "set output"
370 (if (equal output "STDOUT")
372 (prin1-to-string output)))))
373 (setq resolution (calc-graph-find-command "samples"))
375 (setq resolution (string-to-int resolution))
376 (setq resolution (if is-splot
377 calc-graph-default-resolution-3d
378 calc-graph-default-resolution)))
379 (setq precision (calc-graph-find-command "precision"))
381 (setq precision (string-to-int precision))
382 (setq precision calc-graph-default-precision))
383 (calc-graph-set-command "terminal")
384 (calc-graph-set-command "output")
385 (calc-graph-set-command "samples")
386 (calc-graph-set-command "precision"))
387 (goto-char samples-pos)
388 (insert "set samples " (int-to-string (max (if is-splot 20 200)
389 (+ 5 resolution))) "\n")
390 (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
391 (delete-region (match-beginning 0) (match-end 0))
394 (while (memq (preceding-char) '(?\s ?\t))
396 (if (eq (preceding-char) ?\,)
397 (delete-backward-char 1))))
400 (setq cache-env (list calc-angle-mode
406 (if (and (not recompute)
407 (equal (cdr (car calc-graph-data-cache)) cache-env))
408 (while (> (length calc-graph-data-cache)
409 calc-graph-data-cache-limit)
410 (setcdr calc-graph-data-cache
411 (cdr (cdr calc-graph-data-cache))))
412 (setq calc-graph-data-cache (list (cons nil cache-env)))))
413 (calc-graph-find-plot t t)
414 (while (re-search-forward
416 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
417 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
419 (setq curve-num (1+ curve-num))
420 (let* ((xname (buffer-substring (match-beginning 1) (match-end 1)))
421 (xvar (intern (concat "var-" xname)))
422 (xvalue (math-evaluate-expr (calc-var-value xvar)))
423 (y3name (and is-splot
424 (buffer-substring (match-beginning 2)
426 (y3var (and is-splot (intern (concat "var-" y3name))))
427 (y3value (and is-splot (calc-var-value y3var)))
428 (yname (buffer-substring (match-beginning 3) (match-end 3)))
429 (yvar (intern (concat "var-" yname)))
430 (yvalue (calc-var-value yvar))
432 (delete-region (match-beginning 0) (match-end 0))
433 (setq filename (calc-temp-file-name curve-num))
440 (xlow nil) (xhigh nil) (y3low nil) (y3high nil)
441 xvec xval xstep var-DUMMY
442 y3vec y3val y3step var-DUMMY2 (zval nil)
443 yvec yval ycache ycacheptr yvector
445 (keep-file (and (not is-splot) (file-exists-p filename)))
447 (calc-symbolic-mode nil)
448 (calc-prefer-frac nil)
449 (calc-internal-prec (max 3 precision))
450 (calc-simplify-mode (and (not (memq calc-simplify-mode
455 (math-working-step 0)
456 (math-working-step-2 nil))
459 (calc-graph-compute-3d)
460 (calc-graph-compute-2d))
462 (goto-char (point-max))
466 (insert ":" yname "\n\n")
467 (setq tempbuftop (point))
468 (let ((calc-group-digits nil)
469 (calc-leading-zeros nil)
470 (calc-number-radix 10)
471 (entry (and (not is-splot)
472 (list xp yp xhigh numsteps))))
474 (nth 1 (nth (1+ curve-num)
475 calc-graph-file-cache)))
476 (setq keep-file nil))
477 (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache))
480 (calc-graph-format-data)))
484 (error "No valid data points for %s:%s"
486 (write-region tempbuftop (point-max) filename
488 (insert (prin1-to-string filename))))
490 (setcdr cache-env nil))
493 (calc-gnuplot-command "clear")
494 (calc-clear-command-flag 'clear-message)
495 (message "No data to plot!"))
496 (setq calc-graph-data-cache-limit (max curve-num
497 calc-graph-data-cache-limit)
498 filename (calc-temp-file-name 0))
499 (write-region (point-min) (point-max) filename nil 'quiet)
500 (calc-gnuplot-command "load" (prin1-to-string filename))
501 (or (equal output "STDOUT")
502 calc-gnuplot-keep-outfile
503 (progn ; need to close the output file before printing/plotting
504 (setq calc-graph-last-output "STDOUT")
505 (calc-gnuplot-command "set output")))
506 (let ((command (if printing
507 calc-gnuplot-print-command
508 (or calc-gnuplot-plot-command
509 (and (string-match "^dumb" device)
510 'calc-graph-show-dumb)
512 'calc-graph-show-tty)))))
514 (if (stringp command)
515 (calc-gnuplot-command
518 calc-gnuplot-print-output)))
519 (if (symbolp command)
520 (funcall command output)
521 (eval command))))))))))
523 (defun calc-graph-compute-2d ()
524 (if (setq yvec (eq (car-safe yvalue) 'vec))
525 (if (= (setq numsteps (1- (length yvalue))) 0)
526 (error "Can't plot an empty vector")
527 (if (setq xvec (eq (car-safe xvalue) 'vec))
528 (or (= (1- (length xvalue)) numsteps)
529 (error "%s and %s have different lengths" xname yname))
530 (if (and (eq (car-safe xvalue) 'intv)
531 (math-constp xvalue))
532 (setq xstep (math-div (math-sub (nth 3 xvalue)
535 xvalue (nth 2 xvalue))
536 (if (math-realp xvalue)
538 (error "%s is not a suitable basis for %s" xname yname)))))
539 (or (math-realp yvalue)
541 (setq yvalue (math-evaluate-expr yvalue))
542 (calc-default-formula-arglist yvalue)
544 (error "%s does not contain any unassigned variables" yname))
546 (error "%s contains more than one variable: %s"
548 (setq yvalue (math-expr-subst yvalue
549 (math-build-var-name (car arglist))
550 '(var DUMMY var-DUMMY)))))
551 (setq ycache (assoc yvalue calc-graph-data-cache))
552 (delq ycache calc-graph-data-cache)
553 (nconc calc-graph-data-cache
554 (list (or ycache (setq ycache (list yvalue)))))
555 (if (and (not (setq xvec (eq (car-safe xvalue) 'vec)))
556 refine (cdr (cdr ycache)))
557 (calc-graph-refine-2d)
558 (calc-graph-recompute-2d))))
560 (defun calc-graph-refine-2d ()
562 ycacheptr (cdr ycache))
563 (if (and (setq xval (calc-graph-find-command "xrange"))
564 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
566 (let ((b2 (match-beginning 2))
568 (setq xlow (math-read-number (substring xval
571 xhigh (math-read-number (substring xval b2 e2))))
573 (while (and (cdr ycacheptr)
574 (Math-lessp (car (nth 1 ycacheptr)) xlow))
575 (setq ycacheptr (cdr ycacheptr)))))
576 (setq math-working-step-2 (1- (length ycacheptr)))
577 (while (and (cdr ycacheptr)
579 (Math-lessp (car (car ycacheptr)) xhigh)))
580 (setq var-DUMMY (math-div (math-add (car (car ycacheptr))
581 (car (nth 1 ycacheptr)))
583 math-working-step (1+ math-working-step)
584 yval (math-evaluate-expr yvalue))
585 (setcdr ycacheptr (cons (cons var-DUMMY yval)
587 (setq ycacheptr (cdr (cdr ycacheptr))))
591 (defun calc-graph-recompute-2d ()
592 (setq ycacheptr ycache)
594 (setq numsteps (1- (length xvalue))
596 (if (and (eq (car-safe xvalue) 'intv)
597 (math-constp xvalue))
598 (setq numsteps resolution
602 xstep (math-div (math-sub xhigh xlow)
604 xvalue (nth 2 xvalue))
605 (error "%s is not a suitable basis for %s"
607 (setq math-working-step-2 numsteps)
608 (while (>= (setq numsteps (1- numsteps)) 0)
609 (setq math-working-step (1+ math-working-step))
614 (and (not (eq ycacheptr ycache))
615 (consp (car ycacheptr))
616 (not (Math-lessp (car (car ycacheptr)) xval))
617 (setq ycacheptr ycache)))
619 (setq xval xhigh) ; avoid cumulative roundoff
621 xvalue (math-add xvalue xstep))))
622 (while (and (cdr ycacheptr)
623 (Math-lessp (car (nth 1 ycacheptr)) xval))
624 (setq ycacheptr (cdr ycacheptr)))
625 (or (and (cdr ycacheptr)
626 (Math-equal (car (nth 1 ycacheptr)) xval))
630 (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue))
632 (setq ycacheptr (cdr ycacheptr))
634 (setq yvector (cons (cdr (car ycacheptr)) yvector))
635 (or yp (setq yp ycacheptr))))
639 yp (cons 'vec (nreverse yvector))
640 numsteps (1- (length xp)))
641 (setq numsteps 1000000)))
643 (defun calc-graph-compute-3d ()
644 (if (setq yvec (eq (car-safe yvalue) 'vec))
645 (if (math-matrixp yvalue)
647 (setq numsteps (1- (length yvalue))
648 numsteps3 (1- (length (nth 1 yvalue))))
649 (if (eq (car-safe xvalue) 'vec)
650 (or (= (1- (length xvalue)) numsteps)
651 (error "%s has wrong length" xname))
652 (if (and (eq (car-safe xvalue) 'intv)
653 (math-constp xvalue))
654 (setq xvalue (calcFunc-index numsteps
657 (math-sub (nth 3 xvalue)
660 (if (math-realp xvalue)
661 (setq xvalue (calcFunc-index numsteps xvalue 1))
662 (error "%s is not a suitable basis for %s" xname yname))))
663 (if (eq (car-safe y3value) 'vec)
664 (or (= (1- (length y3value)) numsteps3)
665 (error "%s has wrong length" y3name))
666 (if (and (eq (car-safe y3value) 'intv)
667 (math-constp y3value))
668 (setq y3value (calcFunc-index numsteps3
671 (math-sub (nth 3 y3value)
674 (if (math-realp y3value)
675 (setq y3value (calcFunc-index numsteps3 y3value 1))
676 (error "%s is not a suitable basis for %s" y3name yname))))
681 (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue))
682 (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
683 yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
684 zp (nconc zp (cons '(skip)
685 (copy-sequence (cdr (car yvalue)))))))
686 (setq numsteps (1- (* numsteps (1+ numsteps3)))))
687 (if (= (setq numsteps (1- (length yvalue))) 0)
688 (error "Can't plot an empty vector"))
689 (or (and (eq (car-safe xvalue) 'vec)
690 (= (1- (length xvalue)) numsteps))
691 (error "%s is not a suitable basis for %s" xname yname))
692 (or (and (eq (car-safe y3value) 'vec)
693 (= (1- (length y3value)) numsteps))
694 (error "%s is not a suitable basis for %s" y3name yname))
699 (or (math-realp yvalue)
701 (setq yvalue (math-evaluate-expr yvalue))
702 (calc-default-formula-arglist yvalue)
703 (setq arglist (sort arglist 'string-lessp))
705 (error "%s does not contain enough unassigned variables" yname))
706 (and (cdr (cdr arglist))
707 (error "%s contains too many variables: %s" yname arglist))
708 (setq yvalue (math-multi-subst yvalue
709 (mapcar 'math-build-var-name
711 '((var DUMMY var-DUMMY)
712 (var DUMMY2 var-DUMMY2))))))
713 (if (setq xvec (eq (car-safe xvalue) 'vec))
714 (setq numsteps (1- (length xvalue)))
715 (if (and (eq (car-safe xvalue) 'intv)
716 (math-constp xvalue))
717 (setq numsteps resolution
718 xvalue (calcFunc-index numsteps
720 (math-div (math-sub (nth 3 xvalue)
723 (error "%s is not a suitable basis for %s"
725 (if (setq y3vec (eq (car-safe y3value) 'vec))
726 (setq numsteps3 (1- (length y3value)))
727 (if (and (eq (car-safe y3value) 'intv)
728 (math-constp y3value))
729 (setq numsteps3 resolution
730 y3value (calcFunc-index numsteps3
732 (math-div (math-sub (nth 3 y3value)
735 (error "%s is not a suitable basis for %s"
741 (setq math-working-step 0)
742 (while (setq xvalue (cdr xvalue))
743 (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
744 yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
747 var-DUMMY (car xvalue)
748 math-working-step-2 0
749 math-working-step (1+ math-working-step))
750 (while (setq y3step (cdr y3step))
751 (setq math-working-step-2 (1+ math-working-step-2)
752 var-DUMMY2 (car y3step)
753 zp (cons (math-evaluate-expr yvalue) zp))))
754 (setq zp (nreverse zp)
755 numsteps (1- (* numsteps (1+ numsteps3))))))
757 (defun calc-graph-format-data ()
758 (while (<= (setq stepcount (1+ stepcount)) numsteps)
768 xvalue (math-add xvalue xstep)
771 (setq xval (car (car yp))
775 (and xhigh (equal xval xhigh)))
778 (if (and (eq (car-safe zval) 'calcFunc-xyz)
780 (setq xval (nth 1 zval)
783 (if (and (eq (car-safe yval) 'calcFunc-xyz)
788 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
790 (goto-char (point-max))
791 (re-search-backward "^plot[ \t]")
792 (insert "set parametric\ns")
793 (setq surprise-splot t))))
794 (setq xval (nth 1 yval)
797 (if (and (eq (car-safe yval) 'calcFunc-xy)
799 (setq xval (nth 1 yval)
800 yval (nth 2 yval)))))
801 (if (and (Math-realp xval)
803 (or (not zval) (Math-realp zval)))
807 (if (Math-integerp xval)
808 (insert (math-format-number xval))
809 (if (eq (car xval) 'frac)
810 (setq xval (math-float xval)))
811 (insert (math-format-number (nth 1 xval))
812 "e" (int-to-string (nth 2 xval))))
814 (if (Math-integerp yval)
815 (insert (math-format-number yval))
816 (if (eq (car yval) 'frac)
817 (setq yval (math-float yval)))
818 (insert (math-format-number (nth 1 yval))
819 "e" (int-to-string (nth 2 yval))))
823 (if (Math-integerp zval)
824 (insert (math-format-number zval))
825 (if (eq (car zval) 'frac)
826 (setq zval (math-float zval)))
827 (insert (math-format-number (nth 1 zval))
828 "e" (int-to-string (nth 2 zval))))))
830 (and (not (equal zval '(skip)))
831 (boundp 'var-PlotRejects)
832 (eq (car-safe var-PlotRejects) 'vec)
833 (nconc var-PlotRejects
838 (calc-refresh-evaltos 'var-PlotRejects))
844 (defun calc-temp-file-name (num)
845 (while (<= (length calc-graph-file-cache) (1+ num))
846 (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
847 (car (or (nth (1+ num) calc-graph-file-cache)
848 (setcar (nthcdr (1+ num) calc-graph-file-cache)
849 (list (make-temp-file
850 (concat calc-gnuplot-tempfile
852 (char-to-string (- ?A num))
853 (int-to-string num))))
856 (defun calc-graph-delete-temps ()
857 (while calc-graph-file-cache
858 (and (car calc-graph-file-cache)
859 (file-exists-p (car (car calc-graph-file-cache)))
861 (delete-file (car (car calc-graph-file-cache)))
863 (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
865 (defun calc-graph-kill-hook ()
866 (calc-graph-delete-temps)
867 (if calc-graph-prev-kill-hook
868 (funcall calc-graph-prev-kill-hook)))
870 (defun calc-graph-show-tty (output)
871 "Default calc-gnuplot-plot-command for \"tty\" output mode.
872 This is useful for tek40xx and other graphics-terminal types."
873 (call-process-region 1 1 shell-file-name
874 nil calc-gnuplot-buffer nil
875 "-c" (format "cat %s >/dev/tty; rm %s" output output)))
877 (defun calc-graph-show-dumb (&optional output)
878 "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
879 This \"dumb\" driver will be present in Gnuplot 3.0."
881 (save-window-excursion
882 (switch-to-buffer calc-gnuplot-buffer)
883 (delete-other-windows)
884 (goto-char calc-gnuplot-trail-mark)
885 (or (search-forward "\f" nil t)
887 (goto-char (point-max))
888 (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
889 (setq found-pt (point))
890 (if (looking-at "\f")
893 (if (eolp) (forward-line 1))
894 (or (calc-graph-find-command "time")
895 (calc-graph-find-command "title")
896 (calc-graph-find-command "ylabel")
898 (insert-before-markers (format "(%s)" (current-time-string)))
900 (set-window-start (selected-window) (point))
901 (goto-char (point-max)))
905 (or (boundp 'calc-dumb-map)
907 (setq calc-dumb-map (make-sparse-keymap))
908 (define-key calc-dumb-map "\n" 'scroll-up)
909 (define-key calc-dumb-map " " 'scroll-up)
910 (define-key calc-dumb-map "\177" 'scroll-down)
911 (define-key calc-dumb-map "<" 'scroll-left)
912 (define-key calc-dumb-map ">" 'scroll-right)
913 (define-key calc-dumb-map "{" 'scroll-down)
914 (define-key calc-dumb-map "}" 'scroll-up)
915 (define-key calc-dumb-map "q" 'exit-recursive-edit)
916 (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
917 (use-local-map calc-dumb-map)
918 (setq truncate-lines t)
919 (message "Type `q'%s to return to Calc"
920 (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
923 (bury-buffer "*Gnuplot Trail*")))
925 (defun calc-graph-clear ()
927 (if calc-graph-last-device
928 (if (or (equal calc-graph-last-device "x11")
929 (equal calc-graph-last-device "X11"))
930 (calc-gnuplot-command "set output"
931 (if (equal calc-graph-last-output "STDOUT")
933 (prin1-to-string calc-graph-last-output)))
934 (calc-gnuplot-command "clear"))))
936 (defun calc-graph-title-x (title)
937 (interactive "sX axis title: ")
938 (calc-graph-set-command "xlabel" (if (not (equal title ""))
939 (prin1-to-string title))))
941 (defun calc-graph-title-y (title)
942 (interactive "sY axis title: ")
943 (calc-graph-set-command "ylabel" (if (not (equal title ""))
944 (prin1-to-string title))))
946 (defun calc-graph-title-z (title)
947 (interactive "sZ axis title: ")
948 (calc-graph-set-command "zlabel" (if (not (equal title ""))
949 (prin1-to-string title))))
951 (defun calc-graph-range-x (range)
952 (interactive "sX axis range: ")
953 (calc-graph-set-range "xrange" range))
955 (defun calc-graph-range-y (range)
956 (interactive "sY axis range: ")
957 (calc-graph-set-range "yrange" range))
959 (defun calc-graph-range-z (range)
960 (interactive "sZ axis range: ")
961 (calc-graph-set-range "zrange" range))
963 (defun calc-graph-set-range (cmd range)
964 (if (equal range "$")
966 (let ((val (calc-top-n 1)))
967 (if (and (eq (car-safe val) 'intv) (math-constp val))
969 (math-format-number (math-float (nth 2 val))) ":"
970 (math-format-number (math-float (nth 3 val)))))
971 (if (and (eq (car-safe val) 'vec)
974 (math-format-number (math-float (nth 1 val))) ":"
975 (math-format-number (math-float (nth 2 val)))))
976 (error "Range specification must be an interval or 2-vector")))
977 (calc-pop-stack 1))))
978 (if (string-match "\\[.+\\]" range)
979 (setq range (substring range 1 -1)))
980 (if (and (not (string-match ":" range))
981 (or (string-match "," range)
982 (string-match " " range)))
983 (aset range (match-beginning 0) ?\:))
984 (calc-graph-set-command cmd (if (not (equal range ""))
985 (concat "[" range "]"))))
987 (defun calc-graph-log-x (flag)
989 (calc-graph-set-log flag 0 0))
991 (defun calc-graph-log-y (flag)
993 (calc-graph-set-log 0 flag 0))
995 (defun calc-graph-log-z (flag)
997 (calc-graph-set-log 0 0 flag))
999 (defun calc-graph-set-log (xflag yflag zflag)
1000 (let* ((old (or (calc-graph-find-command "logscale") ""))
1001 (xold (string-match "x" old))
1002 (yold (string-match "y" old))
1003 (zold (string-match "z" old))
1005 (setq str (concat (if (if xflag
1006 (if (eq xflag 0) xold
1007 (> (prefix-numeric-value xflag) 0))
1010 (if (eq yflag 0) yold
1011 (> (prefix-numeric-value yflag) 0))
1014 (if (eq zflag 0) zold
1015 (> (prefix-numeric-value zflag) 0))
1016 (not zold)) "z" "")))
1017 (calc-graph-set-command "logscale" (if (not (equal str "")) str))))
1019 (defun calc-graph-line-style (style)
1021 (calc-graph-set-styles (and style (prefix-numeric-value style)) t))
1023 (defun calc-graph-point-style (style)
1025 (calc-graph-set-styles t (and style (prefix-numeric-value style))))
1027 (defun calc-graph-set-styles (lines points)
1030 (set-buffer calc-gnuplot-input)
1031 (or (calc-graph-find-plot nil nil)
1032 (error "No data points have been set!"))
1033 (let ((base (point))
1034 (mode nil) (lstyle nil) (pstyle nil)
1035 start end lenbl penbl)
1036 (re-search-forward "[,\n]")
1038 (setq end (point) start end)
1040 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1042 (setq start (match-beginning 1))
1043 (goto-char (match-end 0))
1044 (if (looking-at "[ \t]+\\([a-z]+\\)")
1045 (setq mode (buffer-substring (match-beginning 1)
1047 (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1048 (setq lstyle (string-to-int
1049 (buffer-substring (match-beginning 1)
1051 (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1052 (setq pstyle (string-to-int
1053 (buffer-substring (match-beginning 1)
1055 (setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
1056 penbl (or (equal mode "points") (equal mode "linespoints")))
1060 lenbl (>= lines 0)))
1061 (setq lenbl (not lenbl)))
1065 penbl (>= points 0)))
1066 (setq penbl (not penbl)))
1067 (delete-region start end)
1071 (if penbl "linespoints" "lines")
1072 (if penbl "points" "dots")))
1073 (if (and pstyle (> pstyle 0))
1074 (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1075 " " (int-to-string pstyle))
1076 (if (and lstyle (> lstyle 0))
1077 (insert " " (int-to-string lstyle))))))
1078 (calc-graph-view-commands))
1080 (defun calc-graph-zero-x (flag)
1082 (calc-graph-set-command "noxzeroaxis"
1084 (<= (prefix-numeric-value flag) 0)
1085 (not (calc-graph-find-command "noxzeroaxis")))
1088 (defun calc-graph-zero-y (flag)
1090 (calc-graph-set-command "noyzeroaxis"
1092 (<= (prefix-numeric-value flag) 0)
1093 (not (calc-graph-find-command "noyzeroaxis")))
1096 (defun calc-graph-name (name)
1097 (interactive "sTitle for current curve: ")
1100 (set-buffer calc-gnuplot-input)
1101 (or (calc-graph-find-plot nil nil)
1102 (error "No data points have been set!"))
1103 (let ((base (point))
1105 (re-search-forward "[,\n]\\|[ \t]+with")
1106 (setq end (match-beginning 0))
1108 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1110 (goto-char (match-beginning 1))
1111 (delete-region (point) end))
1113 (insert " title " (prin1-to-string name))))
1114 (calc-graph-view-commands))
1116 (defun calc-graph-hide (flag)
1119 (and (calc-graph-find-plot nil nil)
1121 (or (looking-at "{")
1122 (error "Can't hide this curve (wrong format)"))
1124 (if (looking-at "*")
1125 (if (or (null flag) (<= (prefix-numeric-value flag) 0))
1127 (if (or (null flag) (> (prefix-numeric-value flag) 0))
1130 (defun calc-graph-header (title)
1131 (interactive "sTitle for entire graph: ")
1132 (calc-graph-set-command "title" (if (not (equal title ""))
1133 (prin1-to-string title))))
1135 (defun calc-graph-border (flag)
1137 (calc-graph-set-command "noborder"
1139 (<= (prefix-numeric-value flag) 0)
1140 (not (calc-graph-find-command "noborder")))
1143 (defun calc-graph-grid (flag)
1145 (calc-graph-set-command "grid" (and (if flag
1146 (> (prefix-numeric-value flag) 0)
1147 (not (calc-graph-find-command "grid")))
1150 (defun calc-graph-key (flag)
1152 (calc-graph-set-command "key" (and (if flag
1153 (> (prefix-numeric-value flag) 0)
1154 (not (calc-graph-find-command "key")))
1157 (defun calc-graph-num-points (res flag)
1158 (interactive "sNumber of data points: \nP")
1160 (if (> (prefix-numeric-value flag) 0)
1162 (message "Default resolution is %d"
1163 calc-graph-default-resolution)
1164 (setq calc-graph-default-resolution (string-to-int res)))
1166 (message "Default 3D resolution is %d"
1167 calc-graph-default-resolution-3d)
1168 (setq calc-graph-default-resolution-3d (string-to-int res))))
1169 (calc-graph-set-command "samples" (if (not (equal res "")) res))))
1171 (defun calc-graph-device (name flag)
1172 (interactive "sDevice name: \nP")
1173 (if (equal name "?")
1175 (calc-gnuplot-command "set terminal")
1176 (calc-graph-view-trail))
1178 (if (> (prefix-numeric-value flag) 0)
1180 (message "Default GNUPLOT device is \"%s\""
1181 calc-gnuplot-default-device)
1182 (setq calc-gnuplot-default-device name))
1184 (message "GNUPLOT device for Print command is \"%s\""
1185 calc-gnuplot-print-device)
1186 (setq calc-gnuplot-print-device name)))
1187 (calc-graph-set-command "terminal" (if (not (equal name ""))
1190 (defun calc-graph-output (name flag)
1191 (interactive "FOutput file name: \np")
1192 (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
1194 ((string-match "\\<[tT][tT][yY]$" name)
1196 ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
1197 (setq name "STDOUT"))
1198 ((equal (file-name-nondirectory name) "")
1200 (t (setq name (expand-file-name name))))
1202 (if (> (prefix-numeric-value flag) 0)
1204 (message "Default GNUPLOT output file is \"%s\""
1205 calc-gnuplot-default-output)
1206 (setq calc-gnuplot-default-output name))
1208 (message "GNUPLOT output file for Print command is \"%s\""
1209 calc-gnuplot-print-output)
1210 (setq calc-gnuplot-print-output name)))
1211 (calc-graph-set-command "output" (if (not (equal name ""))
1212 (prin1-to-string name)))))
1214 (defun calc-graph-display (name)
1215 (interactive "sX display name: ")
1217 (message "Current X display is \"%s\""
1218 (or calc-gnuplot-display "<none>"))
1219 (setq calc-gnuplot-display name)
1220 (if (calc-gnuplot-alive)
1221 (calc-gnuplot-command "exit"))))
1223 (defun calc-graph-geometry (name)
1224 (interactive "sX geometry spec (or \"default\"): ")
1226 (message "Current X geometry is \"%s\""
1227 (or calc-gnuplot-geometry "default"))
1228 (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
1229 (if (calc-gnuplot-alive)
1230 (calc-gnuplot-command "exit"))))
1232 (defun calc-graph-find-command (cmd)
1235 (set-buffer calc-gnuplot-input)
1236 (goto-char (point-min))
1237 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
1238 (buffer-substring (match-beginning 1) (match-end 1)))))
1240 (defun calc-graph-set-command (cmd &rest args)
1243 (set-buffer calc-gnuplot-input)
1244 (goto-char (point-min))
1245 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
1249 (let ((end (point)))
1251 (delete-region (point) (1+ end))))
1252 (if (calc-graph-find-plot t t)
1253 (if (eq (preceding-char) ?\n)
1255 (goto-char (1- (point-max)))))
1256 (if (and args (car args))
1260 (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
1261 (calc-graph-view-commands))
1263 (defun calc-graph-command (cmd)
1264 (interactive "sGNUPLOT command: ")
1267 (calc-graph-view-trail)
1268 (calc-gnuplot-command cmd)
1269 (accept-process-output)
1270 (calc-graph-view-trail)))
1272 (defun calc-graph-kill (&optional no-view)
1274 (calc-graph-delete-temps)
1275 (if (calc-gnuplot-alive)
1277 (or no-view (calc-graph-view-trail))
1278 (let ((calc-graph-no-wait t))
1279 (calc-gnuplot-command "exit"))
1281 (if (process-status calc-gnuplot-process)
1282 (delete-process calc-gnuplot-process))
1283 (setq calc-gnuplot-process nil))))
1285 (defun calc-graph-quit ()
1287 (if (get-buffer-window calc-gnuplot-input)
1288 (calc-graph-view-commands t))
1289 (if (get-buffer-window calc-gnuplot-buffer)
1290 (calc-graph-view-trail t))
1291 (calc-graph-kill t))
1293 (defun calc-graph-view-commands (&optional no-need)
1295 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1296 (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
1298 (defun calc-graph-view-trail (&optional no-need)
1300 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1301 (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
1303 (defun calc-graph-view (buf other-buf need)
1305 (or calc-graph-no-auto-view
1306 (if (setq win (get-buffer-window buf))
1308 (and (eq buf calc-gnuplot-buffer)
1311 (not (pos-visible-in-window-p (point-max) win))))
1314 (bury-buffer other-buf)
1315 (let ((curwin (selected-window)))
1317 (switch-to-buffer nil)
1318 (select-window curwin))))
1319 (if (setq win (get-buffer-window other-buf))
1320 (set-window-buffer win buf)
1321 (if (eq major-mode 'calc-mode)
1323 (< (window-height) (1- (frame-height))))
1324 (display-buffer buf))
1325 (switch-to-buffer buf)))))
1328 (if (and (eq buf calc-gnuplot-buffer)
1329 (setq win (get-buffer-window buf))
1330 (not (pos-visible-in-window-p (point-max) win)))
1332 (goto-char (point-max))
1333 (vertical-motion (- 6 (window-height win)))
1334 (set-window-start win (point))
1335 (goto-char (point-max)))))
1336 (or calc-graph-no-auto-view (sit-for 0))))
1338 (defun calc-gnuplot-check-for-errors ()
1342 (set-buffer calc-gnuplot-buffer)
1343 (goto-char calc-gnuplot-last-error-pos))
1344 (re-search-forward "^[ \t]+\\^$" nil t)
1345 (goto-char (point-max))
1346 (setq calc-gnuplot-last-error-pos (point-max))))
1347 (calc-graph-view-trail)))
1349 (defun calc-gnuplot-command (&rest args)
1351 (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
1352 (accept-process-output)
1354 (set-buffer calc-gnuplot-buffer)
1355 (calc-gnuplot-check-for-errors)
1356 (goto-char (point-max))
1357 (setq calc-gnuplot-trail-mark (point))
1358 (or (>= calc-gnuplot-version 3)
1360 (set-marker (process-mark calc-gnuplot-process) (point))
1361 (process-send-string calc-gnuplot-process cmd)
1362 (if (get-buffer-window calc-gnuplot-buffer)
1363 (calc-graph-view-trail))
1364 (accept-process-output (and (not calc-graph-no-wait)
1365 calc-gnuplot-process))
1366 (calc-gnuplot-check-for-errors)
1367 (if (get-buffer-window calc-gnuplot-buffer)
1368 (calc-graph-view-trail)))))
1370 (defun calc-graph-init-buffers ()
1371 (or (and calc-gnuplot-buffer
1372 (buffer-name calc-gnuplot-buffer))
1373 (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
1374 (or (and calc-gnuplot-input
1375 (buffer-name calc-gnuplot-input))
1376 (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
1378 (defun calc-graph-init ()
1379 (or (calc-gnuplot-alive)
1380 (let ((process-connection-type t)
1382 (if calc-gnuplot-process
1384 (delete-process calc-gnuplot-process)
1385 (setq calc-gnuplot-process nil)))
1386 (calc-graph-init-buffers)
1388 (set-buffer calc-gnuplot-buffer)
1389 (insert "\nStarting gnuplot...\n")
1390 (setq origin (point)))
1391 (setq calc-graph-last-device nil)
1392 (setq calc-graph-last-output nil)
1394 (let ((args (append (and calc-gnuplot-display
1395 (not (equal calc-gnuplot-display
1396 (getenv "DISPLAY")))
1398 calc-gnuplot-display))
1399 (and calc-gnuplot-geometry
1401 calc-gnuplot-geometry)))))
1402 (setq calc-gnuplot-process
1403 (apply 'start-process
1408 (process-kill-without-query calc-gnuplot-process))
1410 (error "Sorry, can't find \"%s\" on your system"
1411 calc-gnuplot-name)))
1413 (set-buffer calc-gnuplot-buffer)
1414 (while (and (not (save-excursion
1416 (search-forward "gnuplot> " nil t)))
1417 (memq (process-status calc-gnuplot-process) '(run stop)))
1418 (accept-process-output calc-gnuplot-process))
1419 (or (memq (process-status calc-gnuplot-process) '(run stop))
1420 (error "Unable to start GNUPLOT process"))
1424 "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
1425 (setq calc-gnuplot-version (string-to-int (buffer-substring
1428 (setq calc-gnuplot-version 1))
1429 (goto-char (point-max)))))
1431 (set-buffer calc-gnuplot-input)
1432 (if (= (buffer-size) 0)
1433 (insert "# Commands for running gnuplot\n\n\n")
1434 (or calc-graph-no-auto-view
1435 (eq (char-after (1- (point-max))) ?\n)
1437 (goto-char (point-max))
1440 ;;; calc-graph.el ends here