Simplify make-progress-reporter vs float-time
[emacs.git] / lisp / calc / calc-graph.el
blobc0598e6015a2ef96002669c5a3916941dfcf67b8
1 ;;; calc-graph.el --- graph output functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2017 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
22 ;;; Commentary:
24 ;;; Code:
26 ;; This file is autoloaded from calc-ext.el.
28 (require 'calc-ext)
29 (require 'calc-macs)
31 ;;; Graphics
33 ;; The following three variables are customizable and defined in calc.el.
34 (defvar calc-gnuplot-name)
35 (defvar calc-gnuplot-plot-command)
36 (defvar calc-gnuplot-print-command)
38 (defvar calc-gnuplot-tempfile "calc")
40 (defvar calc-gnuplot-default-device)
41 (defvar calc-gnuplot-default-output)
42 (defvar calc-gnuplot-print-device)
43 (defvar calc-gnuplot-print-output)
44 (defvar calc-gnuplot-keep-outfile nil)
45 (defvar calc-gnuplot-version nil)
47 (defvar calc-gnuplot-display (getenv "DISPLAY"))
48 (defvar calc-gnuplot-geometry)
50 (defvar calc-graph-default-resolution)
51 (defvar calc-graph-default-resolution-3d)
52 (defvar calc-graph-default-precision 5)
54 (defvar calc-gnuplot-buffer nil)
55 (defvar calc-gnuplot-input nil)
57 (defvar calc-gnuplot-last-error-pos 1)
58 (defvar calc-graph-last-device nil)
59 (defvar calc-graph-last-output nil)
60 (defvar calc-graph-file-cache nil)
61 (defvar calc-graph-var-cache nil)
62 (defvar calc-graph-data-cache nil)
63 (defvar calc-graph-data-cache-limit 10)
64 (defvar calc-graph-no-auto-view nil)
65 (defvar calc-graph-no-wait nil)
66 (defvar calc-gnuplot-trail-mark)
68 (defun calc-graph-fast (many)
69 (interactive "P")
70 (let ((calc-graph-no-auto-view t))
71 (calc-graph-delete t)
72 (calc-graph-add many)
73 (calc-graph-plot nil)))
75 (defun calc-graph-fast-3d (many)
76 (interactive "P")
77 (let ((calc-graph-no-auto-view t))
78 (calc-graph-delete t)
79 (calc-graph-add-3d many)
80 (calc-graph-plot nil)))
82 (defun calc-graph-delete (all)
83 (interactive "P")
84 (calc-wrapper
85 (calc-graph-init)
86 (with-current-buffer calc-gnuplot-input
87 (and (calc-graph-find-plot t all)
88 (progn
89 (if (looking-at "s?plot")
90 (progn
91 (setq calc-graph-var-cache nil)
92 (delete-region (point) (point-max)))
93 (delete-region (point) (1- (point-max)))))))
94 (calc-graph-view-commands)))
96 (defun calc-graph-find-plot (&optional before all)
97 (goto-char (point-min))
98 (and (re-search-forward "^s?plot[ \t]+" nil t)
99 (let ((beg (point)))
100 (goto-char (point-max))
101 (if (or all
102 (not (search-backward "," nil t))
103 (< (point) beg))
104 (progn
105 (goto-char beg)
106 (if before
107 (beginning-of-line)))
108 (or before
109 (re-search-forward ",[ \t]+")))
110 t)))
112 (defun calc-graph-add (many)
113 (interactive "P")
114 (calc-wrapper
115 (calc-graph-init)
116 (cond ((null many)
117 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
118 (calc-graph-lookup (calc-top-n 1))))
119 ((or (consp many) (eq many 0))
120 (let ((xdata (calc-graph-lookup (calc-top-n 2)))
121 (ylist (calc-top-n 1)))
122 (or (eq (car-safe ylist) 'vec)
123 (error "Y argument must be a vector"))
124 (while (setq ylist (cdr ylist))
125 (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
126 ((> (setq many (prefix-numeric-value many)) 0)
127 (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
128 (while (> many 0)
129 (calc-graph-add-curve xdata
130 (calc-graph-lookup (calc-top-n many)))
131 (setq many (1- many)))))
133 (let (pair)
134 (setq many (- many))
135 (while (> many 0)
136 (setq pair (calc-top-n many))
137 (or (and (eq (car-safe pair) 'vec)
138 (= (length pair) 3))
139 (error "Argument must be an [x,y] vector"))
140 (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
141 (calc-graph-lookup (nth 2 pair)))
142 (setq many (1- many))))))
143 (calc-graph-view-commands)))
145 (defun calc-graph-add-3d (many)
146 (interactive "P")
147 (calc-wrapper
148 (calc-graph-init)
149 (cond ((null many)
150 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
151 (calc-graph-lookup (calc-top-n 2))
152 (calc-graph-lookup (calc-top-n 1))))
153 ((or (consp many) (eq many 0))
154 (let ((xdata (calc-graph-lookup (calc-top-n 3)))
155 (ydata (calc-graph-lookup (calc-top-n 2)))
156 (zlist (calc-top-n 1)))
157 (or (eq (car-safe zlist) 'vec)
158 (error "Z argument must be a vector"))
159 (while (setq zlist (cdr zlist))
160 (calc-graph-add-curve xdata ydata
161 (calc-graph-lookup (car zlist))))))
162 ((> (setq many (prefix-numeric-value many)) 0)
163 (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
164 (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
165 (while (> many 0)
166 (calc-graph-add-curve xdata ydata
167 (calc-graph-lookup (calc-top-n many)))
168 (setq many (1- many)))))
170 (let (curve)
171 (setq many (- many))
172 (while (> many 0)
173 (setq curve (calc-top-n many))
174 (or (and (eq (car-safe curve) 'vec)
175 (= (length curve) 4))
176 (error "Argument must be an [x,y,z] vector"))
177 (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
178 (calc-graph-lookup (nth 2 curve))
179 (calc-graph-lookup (nth 3 curve)))
180 (setq many (1- many))))))
181 (calc-graph-view-commands)))
183 (defun calc-graph-add-curve (xdata ydata &optional zdata)
184 (let ((num (calc-graph-count-curves))
185 (pstyle (calc-var-value 'var-PointStyles))
186 (lstyle (calc-var-value 'var-LineStyles)))
187 (with-current-buffer calc-gnuplot-input
188 (goto-char (point-min))
189 (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
190 nil t)
191 (error "Can't mix 2d and 3d curves on one graph"))
192 (if (re-search-forward "^s?plot[ \t]" nil t)
193 (progn
194 (end-of-line)
195 (insert ", "))
196 (goto-char (point-max))
197 (or (eq (preceding-char) ?\n)
198 (insert "\n"))
199 (insert (if zdata "splot" "plot") " \n")
200 (forward-char -1))
201 (insert "{" (symbol-name (nth 1 xdata))
202 ":" (symbol-name (nth 1 ydata)))
203 (if zdata
204 (insert ":" (symbol-name (nth 1 zdata))))
205 (insert "} "
206 "title \"" (symbol-name (nth 1 ydata)) "\" "
207 "with dots")
208 (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
209 (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle))))
210 (calc-graph-set-styles
211 (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
213 (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
214 (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
215 0 -1))
216 (math-contains-sdev-p (eval (nth 2 ydata))))))
218 (defun calc-graph-lookup (thing)
219 (if (and (eq (car-safe thing) 'var)
220 (calc-var-value (nth 2 thing)))
221 thing
222 (let ((found (assoc thing calc-graph-var-cache)))
223 (or found
224 (let ((varname (concat "PlotData"
225 (int-to-string
226 (1+ (length calc-graph-var-cache)))))
227 var)
228 (setq var (list 'var (intern varname)
229 (intern (concat "var-" varname)))
230 found (cons thing var)
231 calc-graph-var-cache (cons found calc-graph-var-cache))
232 (set (nth 2 var) thing)))
233 (cdr found))))
235 (defun calc-graph-juggle (arg)
236 (interactive "p")
237 (calc-graph-init)
238 (with-current-buffer calc-gnuplot-input
239 (if (< arg 0)
240 (let ((num (calc-graph-count-curves)))
241 (if (> num 0)
242 (while (< arg 0)
243 (setq arg (+ arg num))))))
244 (while (>= (setq arg (1- arg)) 0)
245 (calc-graph-do-juggle))))
247 (defun calc-graph-count-curves ()
248 (with-current-buffer calc-gnuplot-input
249 (if (re-search-forward "^s?plot[ \t]" nil t)
250 (let ((num 1))
251 (goto-char (point-min))
252 (while (search-forward "," nil t)
253 (setq num (1+ num)))
254 num)
255 0)))
257 (defun calc-graph-do-juggle ()
258 (let (base)
259 (and (calc-graph-find-plot t t)
260 (progn
261 (setq base (point))
262 (calc-graph-find-plot t nil)
263 (or (eq base (point))
264 (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
265 (delete-region (point) (1- (point-max)))
266 (goto-char (+ base 5))
267 (insert str ", ")))))))
269 (defun calc-graph-print (flag)
270 (interactive "P")
271 (calc-graph-plot flag t))
273 (defvar var-DUMMY)
274 (defvar var-DUMMY2)
275 (defvar var-PlotRejects)
277 ;; The following variables are local to calc-graph-plot, but are
278 ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
279 ;; calc-graph-recompute-2d, calc-graph-compute-3d and
280 ;; calc-graph-format-data, which are called by calc-graph-plot.
281 (defvar calc-graph-yvalue)
282 (defvar calc-graph-yvec)
283 (defvar calc-graph-numsteps)
284 (defvar calc-graph-numsteps3)
285 (defvar calc-graph-xvalue)
286 (defvar calc-graph-xvec)
287 (defvar calc-graph-xname)
288 (defvar calc-graph-yname)
289 (defvar calc-graph-xstep)
290 (defvar calc-graph-ycache)
291 (defvar calc-graph-ycacheptr)
292 (defvar calc-graph-refine)
293 (defvar calc-graph-keep-file)
294 (defvar calc-graph-xval)
295 (defvar calc-graph-xlow)
296 (defvar calc-graph-xhigh)
297 (defvar calc-graph-yval)
298 (defvar calc-graph-yp)
299 (defvar calc-graph-xp)
300 (defvar calc-graph-zp)
301 (defvar calc-graph-yvector)
302 (defvar calc-graph-resolution)
303 (defvar calc-graph-y3value)
304 (defvar calc-graph-y3name)
305 (defvar calc-graph-y3step)
306 (defvar calc-graph-zval)
307 (defvar calc-graph-stepcount)
308 (defvar calc-graph-is-splot)
309 (defvar calc-graph-surprise-splot)
310 (defvar calc-graph-blank)
311 (defvar calc-graph-non-blank)
312 (defvar calc-graph-curve-num)
314 (defun calc-graph-plot (flag &optional printing)
315 (interactive "P")
316 (calc-slow-wrapper
317 (let ((calcbuf (current-buffer))
318 (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
319 (tempbuftop 1)
320 (tempoutfile nil)
321 (calc-graph-curve-num 0)
322 (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
323 (recompute (and flag (< (prefix-numeric-value flag) 0)))
324 (calc-graph-surprise-splot nil)
325 (tty-output nil)
326 cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos)
327 (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)
328 (save-excursion
329 (calc-graph-init)
330 (set-buffer tempbuf)
331 (erase-buffer)
332 (set-buffer calc-gnuplot-input)
333 (goto-char (point-min))
334 (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t))
335 (let ((str (buffer-string))
336 (ver calc-gnuplot-version))
337 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
338 (erase-buffer)
339 (insert "# (Note: This is a temporary copy---do not edit!)\n")
340 (if (>= ver 2)
341 (insert "set noarrow\nset nolabel\n"
342 "set autoscale xy\nset nologscale xy\n"
343 "set xlabel\nset ylabel\nset title\n"
344 "set noclip points\nset clip one\nset clip two\n"
345 "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
346 "set style data linespoints\n"
347 "set nogrid\nset nokey\nset nopolar\n"))
348 (if (>= ver 3)
349 (insert "set surface\nset nocontour\n"
350 "set " (if calc-graph-is-splot "" "no") "parametric\n"
351 "set notime\nset border\nset ztics\nset zeroaxis\n"
352 "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
353 (setq samples-pos (point))
354 (insert "\n\n" str))
355 (goto-char (point-min))
356 (if calc-graph-is-splot
357 (if calc-graph-refine
358 (error "This option works only for 2d plots")
359 (setq recompute t)))
360 (let ((calc-gnuplot-input (current-buffer))
361 (calc-graph-no-auto-view t))
362 (if printing
363 (setq device calc-gnuplot-print-device
364 output calc-gnuplot-print-output)
365 (setq device (calc-graph-find-command "terminal")
366 output (calc-graph-find-command "output"))
367 (or device
368 (setq device calc-gnuplot-default-device))
369 (if output
370 (setq output (car (read-from-string output)))
371 (setq output calc-gnuplot-default-output)))
372 (if (or (equal device "") (equal device "default"))
373 (setq device
374 (cond
375 (printing "postscript")
376 ;; Check MS-Windows before X, in case they have
377 ;; $DISPLAY set for some reason (e.g., Cygwin or
378 ;; whatever)
379 ((string= calc-gnuplot-name "pgnuplot")
380 "windows")
381 ((or (eq window-system 'x) (getenv "DISPLAY"))
382 "x11")
383 ((>= calc-gnuplot-version 3)
384 "dumb")
385 (t "postscript"))))
386 (if (equal device "dumb")
387 (setq device (format "dumb %d %d"
388 (1- (frame-width)) (1- (frame-height)))))
389 (if (equal device "big")
390 (setq device (format "dumb %d %d"
391 (* 4 (- (frame-width) 3))
392 (* 4 (- (frame-height) 3)))))
393 (if (stringp output)
394 (if (or (equal output "auto")
395 (and (equal output "tty") (setq tty-output t)))
396 (setq tempoutfile (calc-temp-file-name -1)
397 output tempoutfile))
398 (setq output (eval output)))
399 (or (equal device calc-graph-last-device)
400 (progn
401 (setq calc-graph-last-device device)
402 (calc-gnuplot-command "set terminal" device)))
403 (or (equal output calc-graph-last-output)
404 (progn
405 (setq calc-graph-last-output output)
406 (calc-gnuplot-command "set output"
407 (if (equal output "STDOUT")
409 (prin1-to-string output)))))
410 (setq calc-graph-resolution (calc-graph-find-command "samples"))
411 (if calc-graph-resolution
412 (setq calc-graph-resolution (string-to-number calc-graph-resolution))
413 (setq calc-graph-resolution (if calc-graph-is-splot
414 calc-graph-default-resolution-3d
415 calc-graph-default-resolution)))
416 (setq precision (calc-graph-find-command "precision"))
417 (if precision
418 (setq precision (string-to-number precision))
419 (setq precision calc-graph-default-precision))
420 (calc-graph-set-command "terminal")
421 (calc-graph-set-command "output")
422 (calc-graph-set-command "samples")
423 (calc-graph-set-command "precision"))
424 (goto-char samples-pos)
425 (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200)
426 (+ 5 calc-graph-resolution))) "\n")
427 (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
428 (delete-region (match-beginning 0) (match-end 0))
429 (if (looking-at ",")
430 (delete-char 1)
431 (while (memq (preceding-char) '(?\s ?\t))
432 (forward-char -1))
433 (if (eq (preceding-char) ?\,)
434 (delete-char -1))))
435 (with-current-buffer calcbuf
436 (setq cache-env (list calc-angle-mode
437 calc-complex-mode
438 calc-simplify-mode
439 calc-infinite-mode
440 calc-word-size
441 precision calc-graph-is-splot))
442 (if (and (not recompute)
443 (equal (cdr (car calc-graph-data-cache)) cache-env))
444 (while (> (length calc-graph-data-cache)
445 calc-graph-data-cache-limit)
446 (setcdr calc-graph-data-cache
447 (cdr (cdr calc-graph-data-cache))))
448 (setq calc-graph-data-cache (list (cons nil cache-env)))))
449 (calc-graph-find-plot t t)
450 (while (re-search-forward
451 (if calc-graph-is-splot
452 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
453 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
454 nil t)
455 (setq calc-graph-curve-num (1+ calc-graph-curve-num))
456 (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1)))
457 (xvar (intern (concat "var-" calc-graph-xname)))
458 (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar)))
459 (calc-graph-y3name (and calc-graph-is-splot
460 (buffer-substring (match-beginning 2)
461 (match-end 2))))
462 (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name))))
463 (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var)))
464 (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3)))
465 (yvar (intern (concat "var-" calc-graph-yname)))
466 (calc-graph-yvalue (calc-var-value yvar))
467 filename)
468 (delete-region (match-beginning 0) (match-end 0))
469 (setq filename (calc-temp-file-name calc-graph-curve-num))
470 (with-current-buffer calcbuf
471 (let (tempbuftop
472 (calc-graph-xp calc-graph-xvalue)
473 (calc-graph-yp calc-graph-yvalue)
474 (calc-graph-zp nil)
475 (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
476 calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
477 y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
478 calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
479 calc-graph-numsteps calc-graph-numsteps3
480 (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
481 (calc-graph-stepcount 0)
482 (calc-symbolic-mode nil)
483 (calc-prefer-frac nil)
484 (calc-internal-prec (max 3 precision))
485 (calc-simplify-mode (and (not (memq calc-simplify-mode
486 '(none num)))
487 calc-simplify-mode))
488 (calc-graph-blank t)
489 (calc-graph-non-blank nil)
490 (math-working-step 0)
491 (math-working-step-2 nil))
492 (save-excursion
493 (if calc-graph-is-splot
494 (calc-graph-compute-3d)
495 (calc-graph-compute-2d))
496 (set-buffer tempbuf)
497 (goto-char (point-max))
498 (insert "\n" calc-graph-xname)
499 (if calc-graph-is-splot
500 (insert ":" calc-graph-y3name))
501 (insert ":" calc-graph-yname "\n\n")
502 (setq tempbuftop (point))
503 (let ((calc-group-digits nil)
504 (calc-leading-zeros nil)
505 (calc-number-radix 10)
506 (calc-twos-complement-mode nil)
507 (entry (and (not calc-graph-is-splot)
508 (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps))))
509 (or (equal entry
510 (nth 1 (nth (1+ calc-graph-curve-num)
511 calc-graph-file-cache)))
512 (setq calc-graph-keep-file nil))
513 (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache))
514 entry)
515 (or calc-graph-keep-file
516 (calc-graph-format-data)))
517 (or calc-graph-keep-file
518 (progn
519 (or calc-graph-non-blank
520 (error "No valid data points for %s:%s"
521 calc-graph-xname calc-graph-yname))
522 (write-region tempbuftop (point-max) filename
523 nil 'quiet))))))
524 (insert (prin1-to-string filename))))
525 (if calc-graph-surprise-splot
526 (setcdr cache-env nil))
527 (if (= calc-graph-curve-num 0)
528 (progn
529 (calc-gnuplot-command "clear")
530 (calc-clear-command-flag 'clear-message)
531 (message "No data to plot!"))
532 (setq calc-graph-data-cache-limit (max calc-graph-curve-num
533 calc-graph-data-cache-limit))
534 (let ((filename (calc-temp-file-name 0)))
535 (write-region (point-min) (point-max) filename nil 'quiet)
536 (calc-gnuplot-command "load" (prin1-to-string filename)))
537 (or (equal output "STDOUT")
538 calc-gnuplot-keep-outfile
539 (progn ; need to close the output file before printing/plotting
540 (setq calc-graph-last-output "STDOUT")
541 (calc-gnuplot-command "set output")))
542 (let ((command (if printing
543 calc-gnuplot-print-command
544 (or calc-gnuplot-plot-command
545 (and (string-match "^dumb" device)
546 'calc-graph-show-dumb)
547 (and tty-output
548 'calc-graph-show-tty)))))
549 (if command
550 (if (stringp command)
551 (calc-gnuplot-command
552 "!" (format command
553 (or tempoutfile
554 calc-gnuplot-print-output)))
555 (if (symbolp command)
556 (funcall command output)
557 (eval command))))))))))
559 (defun calc-graph-compute-2d ()
560 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
561 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
562 (error "Can't plot an empty vector")
563 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
564 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
565 (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname))
566 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
567 (math-constp calc-graph-xvalue))
568 (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue)
569 (nth 2 calc-graph-xvalue))
570 (1- calc-graph-numsteps))
571 calc-graph-xvalue (nth 2 calc-graph-xvalue))
572 (if (math-realp calc-graph-xvalue)
573 (setq calc-graph-xstep 1)
574 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))))
575 (or (math-realp calc-graph-yvalue)
576 (let ((math-arglist nil))
577 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
578 (calc-default-formula-arglist calc-graph-yvalue)
579 (or math-arglist
580 (error "%s does not contain any unassigned variables" calc-graph-yname))
581 (and (cdr math-arglist)
582 (error "%s contains more than one variable: %s"
583 calc-graph-yname math-arglist))
584 (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue
585 (math-build-var-name (car math-arglist))
586 '(var DUMMY var-DUMMY)))))
587 (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache))
588 (delq calc-graph-ycache calc-graph-data-cache)
589 (nconc calc-graph-data-cache
590 (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue)))))
591 (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)))
592 calc-graph-refine (cdr (cdr calc-graph-ycache)))
593 (calc-graph-refine-2d)
594 (calc-graph-recompute-2d))))
596 (defun calc-graph-refine-2d ()
597 (setq calc-graph-keep-file nil
598 calc-graph-ycacheptr (cdr calc-graph-ycache))
599 (if (and (setq calc-graph-xval (calc-graph-find-command "xrange"))
600 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
601 calc-graph-xval))
602 (let ((b2 (match-beginning 2))
603 (e2 (match-end 2)))
604 (setq calc-graph-xlow (math-read-number (substring calc-graph-xval
605 (match-beginning 1)
606 (match-end 1)))
607 calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2))))
608 (if calc-graph-xlow
609 (while (and (cdr calc-graph-ycacheptr)
610 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow))
611 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))))
612 (setq math-working-step-2 (1- (length calc-graph-ycacheptr)))
613 (while (and (cdr calc-graph-ycacheptr)
614 (or (not calc-graph-xhigh)
615 (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh)))
616 (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr))
617 (car (nth 1 calc-graph-ycacheptr)))
619 math-working-step (1+ math-working-step)
620 calc-graph-yval (math-evaluate-expr calc-graph-yvalue))
621 (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval)
622 (cdr calc-graph-ycacheptr)))
623 (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr))))
624 (setq calc-graph-yp calc-graph-ycache
625 calc-graph-numsteps 1000000))
627 (defun calc-graph-recompute-2d ()
628 (setq calc-graph-ycacheptr calc-graph-ycache)
629 (if calc-graph-xvec
630 (setq calc-graph-numsteps (1- (length calc-graph-xvalue))
631 calc-graph-yvector nil)
632 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
633 (math-constp calc-graph-xvalue))
634 (setq calc-graph-numsteps calc-graph-resolution
635 calc-graph-yp nil
636 calc-graph-xlow (nth 2 calc-graph-xvalue)
637 calc-graph-xhigh (nth 3 calc-graph-xvalue)
638 calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow)
639 (1- calc-graph-numsteps))
640 calc-graph-xvalue (nth 2 calc-graph-xvalue))
641 (error "%s is not a suitable basis for %s"
642 calc-graph-xname calc-graph-yname)))
643 (setq math-working-step-2 calc-graph-numsteps)
644 (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0)
645 (setq math-working-step (1+ math-working-step))
646 (if calc-graph-xvec
647 (progn
648 (setq calc-graph-xp (cdr calc-graph-xp)
649 calc-graph-xval (car calc-graph-xp))
650 (and (not (eq calc-graph-ycacheptr calc-graph-ycache))
651 (consp (car calc-graph-ycacheptr))
652 (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval))
653 (setq calc-graph-ycacheptr calc-graph-ycache)))
654 (if (= calc-graph-numsteps 0)
655 (setq calc-graph-xval calc-graph-xhigh) ; avoid cumulative roundoff
656 (setq calc-graph-xval calc-graph-xvalue
657 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep))))
658 (while (and (cdr calc-graph-ycacheptr)
659 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
660 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))
661 (or (and (cdr calc-graph-ycacheptr)
662 (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
663 (progn
664 (setq calc-graph-keep-file nil
665 var-DUMMY calc-graph-xval)
666 (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue))
667 (cdr calc-graph-ycacheptr)))))
668 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))
669 (if calc-graph-xvec
670 (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector))
671 (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr))))
672 (if calc-graph-xvec
673 (setq calc-graph-xp calc-graph-xvalue
674 calc-graph-yvec t
675 calc-graph-yp (cons 'vec (nreverse calc-graph-yvector))
676 calc-graph-numsteps (1- (length calc-graph-xp)))
677 (setq calc-graph-numsteps 1000000)))
679 (defun calc-graph-compute-3d ()
680 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
681 (if (math-matrixp calc-graph-yvalue)
682 (progn
683 (setq calc-graph-numsteps (1- (length calc-graph-yvalue))
684 calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue))))
685 (if (eq (car-safe calc-graph-xvalue) 'vec)
686 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
687 (error "%s has wrong length" calc-graph-xname))
688 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
689 (math-constp calc-graph-xvalue))
690 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps
691 (nth 2 calc-graph-xvalue)
692 (math-div
693 (math-sub (nth 3 calc-graph-xvalue)
694 (nth 2 calc-graph-xvalue))
695 (1- calc-graph-numsteps))))
696 (if (math-realp calc-graph-xvalue)
697 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1))
698 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))
699 (if (eq (car-safe calc-graph-y3value) 'vec)
700 (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3)
701 (error "%s has wrong length" calc-graph-y3name))
702 (if (and (eq (car-safe calc-graph-y3value) 'intv)
703 (math-constp calc-graph-y3value))
704 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3
705 (nth 2 calc-graph-y3value)
706 (math-div
707 (math-sub (nth 3 calc-graph-y3value)
708 (nth 2 calc-graph-y3value))
709 (1- calc-graph-numsteps3))))
710 (if (math-realp calc-graph-y3value)
711 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1))
712 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))))
713 (setq calc-graph-xp nil
714 calc-graph-yp nil
715 calc-graph-zp nil
716 calc-graph-xvec t)
717 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue))
718 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
719 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
720 calc-graph-zp (nconc calc-graph-zp (cons '(skip)
721 (copy-sequence (cdr (car calc-graph-yvalue)))))))
722 (setq calc-graph-numsteps (1- (* calc-graph-numsteps
723 (1+ calc-graph-numsteps3)))))
724 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
725 (error "Can't plot an empty vector"))
726 (or (and (eq (car-safe calc-graph-xvalue) 'vec)
727 (= (1- (length calc-graph-xvalue)) calc-graph-numsteps))
728 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))
729 (or (and (eq (car-safe calc-graph-y3value) 'vec)
730 (= (1- (length calc-graph-y3value)) calc-graph-numsteps))
731 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))
732 (setq calc-graph-xp calc-graph-xvalue
733 calc-graph-yp calc-graph-y3value
734 calc-graph-zp calc-graph-yvalue
735 calc-graph-xvec t))
736 (or (math-realp calc-graph-yvalue)
737 (let ((math-arglist nil))
738 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
739 (calc-default-formula-arglist calc-graph-yvalue)
740 (setq math-arglist (sort math-arglist 'string-lessp))
741 (or (cdr math-arglist)
742 (error "%s does not contain enough unassigned variables" calc-graph-yname))
743 (and (cdr (cdr math-arglist))
744 (error "%s contains too many variables: %s" calc-graph-yname math-arglist))
745 (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue
746 (mapcar 'math-build-var-name
747 math-arglist)
748 '((var DUMMY var-DUMMY)
749 (var DUMMY2 var-DUMMY2))))))
750 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
751 (setq calc-graph-numsteps (1- (length calc-graph-xvalue)))
752 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
753 (math-constp calc-graph-xvalue))
754 (setq calc-graph-numsteps calc-graph-resolution
755 calc-graph-xvalue (calcFunc-index calc-graph-numsteps
756 (nth 2 calc-graph-xvalue)
757 (math-div (math-sub (nth 3 calc-graph-xvalue)
758 (nth 2 calc-graph-xvalue))
759 (1- calc-graph-numsteps))))
760 (error "%s is not a suitable basis for %s"
761 calc-graph-xname calc-graph-yname)))
762 (if (eq (car-safe calc-graph-y3value) 'vec)
763 (setq calc-graph-numsteps3 (1- (length calc-graph-y3value)))
764 (if (and (eq (car-safe calc-graph-y3value) 'intv)
765 (math-constp calc-graph-y3value))
766 (setq calc-graph-numsteps3 calc-graph-resolution
767 calc-graph-y3value (calcFunc-index calc-graph-numsteps3
768 (nth 2 calc-graph-y3value)
769 (math-div (math-sub (nth 3 calc-graph-y3value)
770 (nth 2 calc-graph-y3value))
771 (1- calc-graph-numsteps3))))
772 (error "%s is not a suitable basis for %s"
773 calc-graph-y3name calc-graph-yname)))
774 (setq calc-graph-xp nil
775 calc-graph-yp nil
776 calc-graph-zp nil
777 calc-graph-xvec t)
778 (setq math-working-step 0)
779 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue))
780 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
781 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
782 calc-graph-zp (cons '(skip) calc-graph-zp)
783 calc-graph-y3step calc-graph-y3value
784 var-DUMMY (car calc-graph-xvalue)
785 math-working-step-2 0
786 math-working-step (1+ math-working-step))
787 (while (setq calc-graph-y3step (cdr calc-graph-y3step))
788 (setq math-working-step-2 (1+ math-working-step-2)
789 var-DUMMY2 (car calc-graph-y3step)
790 calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp))))
791 (setq calc-graph-zp (nreverse calc-graph-zp)
792 calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3))))))
794 (defun calc-graph-format-data ()
795 (if (math-contains-sdev-p calc-graph-yp)
796 (let ((yp calc-graph-yp))
797 (setq calc-graph-yp (cons 'vec (mapcar 'math-get-value (cdr yp))))
798 (setq calc-graph-zp (cons 'vec (mapcar 'math-get-sdev (cdr yp))))))
799 (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps)
800 (if calc-graph-xvec
801 (setq calc-graph-xp (cdr calc-graph-xp)
802 calc-graph-xval (car calc-graph-xp)
803 calc-graph-yp (cdr calc-graph-yp)
804 calc-graph-yval (car calc-graph-yp)
805 calc-graph-zp (cdr calc-graph-zp)
806 calc-graph-zval (car calc-graph-zp))
807 (if calc-graph-yvec
808 (setq calc-graph-xval calc-graph-xvalue
809 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)
810 calc-graph-yp (cdr calc-graph-yp)
811 calc-graph-yval (car calc-graph-yp))
812 (setq calc-graph-xval (car (car calc-graph-yp))
813 calc-graph-yval (cdr (car calc-graph-yp))
814 calc-graph-yp (cdr calc-graph-yp))
815 (if (or (not calc-graph-yp)
816 (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh)))
817 (setq calc-graph-numsteps 0))))
818 (if calc-graph-is-splot
819 (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz)
820 (= (length calc-graph-zval) 4))
821 (setq calc-graph-xval (nth 1 calc-graph-zval)
822 calc-graph-yval (nth 2 calc-graph-zval)
823 calc-graph-zval (nth 3 calc-graph-zval)))
824 (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz)
825 (= (length calc-graph-yval) 4))
826 (progn
827 (or calc-graph-surprise-splot
828 (with-current-buffer (get-buffer-create "*Gnuplot Temp*")
829 (save-excursion
830 (goto-char (point-max))
831 (re-search-backward "^plot[ \t]")
832 (insert "set parametric\ns")
833 (setq calc-graph-surprise-splot t))))
834 (setq calc-graph-xval (nth 1 calc-graph-yval)
835 calc-graph-zval (nth 3 calc-graph-yval)
836 calc-graph-yval (nth 2 calc-graph-yval)))
837 (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy)
838 (= (length calc-graph-yval) 3))
839 (setq calc-graph-xval (nth 1 calc-graph-yval)
840 calc-graph-yval (nth 2 calc-graph-yval)))))
841 (if (and (Math-realp calc-graph-xval)
842 (Math-realp calc-graph-yval)
843 (or (not calc-graph-zval) (Math-realp calc-graph-zval)))
844 (progn
845 (setq calc-graph-blank nil
846 calc-graph-non-blank t)
847 (if (Math-integerp calc-graph-xval)
848 (insert (math-format-number calc-graph-xval))
849 (if (eq (car calc-graph-xval) 'frac)
850 (setq calc-graph-xval (math-float calc-graph-xval)))
851 (insert (math-format-number (nth 1 calc-graph-xval))
852 "e" (int-to-string (nth 2 calc-graph-xval))))
853 (insert " ")
854 (if (Math-integerp calc-graph-yval)
855 (insert (math-format-number calc-graph-yval))
856 (if (eq (car calc-graph-yval) 'frac)
857 (setq calc-graph-yval (math-float calc-graph-yval)))
858 (insert (math-format-number (nth 1 calc-graph-yval))
859 "e" (int-to-string (nth 2 calc-graph-yval))))
860 (if calc-graph-zval
861 (progn
862 (insert " ")
863 (if (Math-integerp calc-graph-zval)
864 (insert (math-format-number calc-graph-zval))
865 (if (eq (car calc-graph-zval) 'frac)
866 (setq calc-graph-zval (math-float calc-graph-zval)))
867 (insert (math-format-number (nth 1 calc-graph-zval))
868 "e" (int-to-string (nth 2 calc-graph-zval))))))
869 (insert "\n"))
870 (and (not (equal calc-graph-zval '(skip)))
871 (boundp 'var-PlotRejects)
872 (eq (car-safe var-PlotRejects) 'vec)
873 (nconc var-PlotRejects
874 (list (list 'vec
875 calc-graph-curve-num
876 calc-graph-stepcount
877 calc-graph-xval calc-graph-yval)))
878 (calc-refresh-evaltos 'var-PlotRejects))
879 (or calc-graph-blank
880 (progn
881 (insert "\n")
882 (setq calc-graph-blank t))))))
884 (defun calc-temp-file-name (num)
885 (while (<= (length calc-graph-file-cache) (1+ num))
886 (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
887 (car (or (nth (1+ num) calc-graph-file-cache)
888 (setcar (nthcdr (1+ num) calc-graph-file-cache)
889 (list (make-temp-file
890 (concat calc-gnuplot-tempfile
891 (if (<= num 0)
892 (char-to-string (- ?A num))
893 (int-to-string num))))
894 nil)))))
896 (defun calc-graph-delete-temps ()
897 (while calc-graph-file-cache
898 (and (car calc-graph-file-cache)
899 (file-exists-p (car (car calc-graph-file-cache)))
900 (condition-case err
901 (delete-file (car (car calc-graph-file-cache)))
902 (error nil)))
903 (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
905 (defun calc-graph-kill-hook ()
906 (calc-graph-delete-temps))
908 (defun calc-graph-show-tty (output)
909 "Default calc-gnuplot-plot-command for \"tty\" output mode.
910 This is useful for tek40xx and other graphics-terminal types."
911 (call-process shell-file-name nil calc-gnuplot-buffer nil
912 shell-command-switch
913 (format "cat %s >/dev/tty; rm %s" output output)))
915 (defvar calc-dumb-map nil
916 "The keymap for the \"dumb\" terminal plot.")
918 (defun calc-graph-show-dumb (&optional output)
919 "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
920 This \"dumb\" driver will be present in Gnuplot 3.0."
921 (interactive)
922 (save-window-excursion
923 (switch-to-buffer calc-gnuplot-buffer)
924 (delete-other-windows)
925 (goto-char calc-gnuplot-trail-mark)
926 (or (search-forward "\f" nil t)
927 (sleep-for 1))
928 (goto-char (point-max))
929 (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
930 (if (looking-at "\f")
931 (progn
932 (forward-char 1)
933 (if (eolp) (forward-line 1))
934 (or (calc-graph-find-command "time")
935 (calc-graph-find-command "title")
936 (calc-graph-find-command "ylabel")
937 (let ((pt (point)))
938 (insert-before-markers (format "(%s)" (current-time-string)))
939 (goto-char pt)))
940 (set-window-start (selected-window) (point))
941 (goto-char (point-max)))
942 (end-of-line)
943 (backward-char 1)
944 (recenter '(4)))
945 (or calc-dumb-map
946 (progn
947 (setq calc-dumb-map (make-sparse-keymap))
948 (define-key calc-dumb-map "\n" 'scroll-up-command)
949 (define-key calc-dumb-map " " 'scroll-up-command)
950 (define-key calc-dumb-map [?\S-\ ] 'scroll-down-command)
951 (define-key calc-dumb-map "\177" 'scroll-down-command)
952 (define-key calc-dumb-map "<" 'scroll-left)
953 (define-key calc-dumb-map ">" 'scroll-right)
954 (define-key calc-dumb-map "{" 'scroll-down-command)
955 (define-key calc-dumb-map "}" 'scroll-up-command)
956 (define-key calc-dumb-map "q" 'exit-recursive-edit)
957 (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
958 (use-local-map calc-dumb-map)
959 (setq truncate-lines t)
960 (message "Type `q' or `C-c C-c' to return to Calc")
961 (recursive-edit)
962 (bury-buffer "*Gnuplot Trail*")))
964 (defun calc-graph-clear ()
965 (interactive)
966 (if calc-graph-last-device
967 (if (or (equal calc-graph-last-device "x11")
968 (equal calc-graph-last-device "X11"))
969 (calc-gnuplot-command "set output"
970 (if (equal calc-graph-last-output "STDOUT")
972 (prin1-to-string calc-graph-last-output)))
973 (calc-gnuplot-command "clear"))))
975 (defun calc-graph-title-x (title)
976 (interactive "sX axis title: ")
977 (calc-graph-set-command "xlabel" (if (not (equal title ""))
978 (prin1-to-string title))))
980 (defun calc-graph-title-y (title)
981 (interactive "sY axis title: ")
982 (calc-graph-set-command "ylabel" (if (not (equal title ""))
983 (prin1-to-string title))))
985 (defun calc-graph-title-z (title)
986 (interactive "sZ axis title: ")
987 (calc-graph-set-command "zlabel" (if (not (equal title ""))
988 (prin1-to-string title))))
990 (defun calc-graph-range-x (range)
991 (interactive "sX axis range: ")
992 (calc-graph-set-range "xrange" range))
994 (defun calc-graph-range-y (range)
995 (interactive "sY axis range: ")
996 (calc-graph-set-range "yrange" range))
998 (defun calc-graph-range-z (range)
999 (interactive "sZ axis range: ")
1000 (calc-graph-set-range "zrange" range))
1002 (defun calc-graph-set-range (cmd range)
1003 (if (equal range "$")
1004 (calc-wrapper
1005 (let ((val (calc-top-n 1)))
1006 (if (and (eq (car-safe val) 'intv) (math-constp val))
1007 (setq range (concat
1008 (math-format-number (math-float (nth 2 val))) ":"
1009 (math-format-number (math-float (nth 3 val)))))
1010 (if (and (eq (car-safe val) 'vec)
1011 (= (length val) 3))
1012 (setq range (concat
1013 (math-format-number (math-float (nth 1 val))) ":"
1014 (math-format-number (math-float (nth 2 val)))))
1015 (error "Range specification must be an interval or 2-vector")))
1016 (calc-pop-stack 1))))
1017 (if (string-match "\\[.+\\]" range)
1018 (setq range (substring range 1 -1)))
1019 (if (and (not (string-match ":" range))
1020 (or (string-match "," range)
1021 (string-match " " range)))
1022 (aset range (match-beginning 0) ?\:))
1023 (calc-graph-set-command cmd (if (not (equal range ""))
1024 (concat "[" range "]"))))
1026 (defun calc-graph-log-x (flag)
1027 (interactive "P")
1028 (calc-graph-set-log flag 0 0))
1030 (defun calc-graph-log-y (flag)
1031 (interactive "P")
1032 (calc-graph-set-log 0 flag 0))
1034 (defun calc-graph-log-z (flag)
1035 (interactive "P")
1036 (calc-graph-set-log 0 0 flag))
1038 (defun calc-graph-set-log (xflag yflag zflag)
1039 (let* ((old (or (calc-graph-find-command "logscale") ""))
1040 (xold (string-match "x" old))
1041 (yold (string-match "y" old))
1042 (zold (string-match "z" old))
1043 str)
1044 (setq str (concat (if (if xflag
1045 (if (eq xflag 0) xold
1046 (> (prefix-numeric-value xflag) 0))
1047 (not xold)) "x" "")
1048 (if (if yflag
1049 (if (eq yflag 0) yold
1050 (> (prefix-numeric-value yflag) 0))
1051 (not yold)) "y" "")
1052 (if (if zflag
1053 (if (eq zflag 0) zold
1054 (> (prefix-numeric-value zflag) 0))
1055 (not zold)) "z" "")))
1056 (calc-graph-set-command "logscale" (if (not (equal str "")) str))))
1058 (defun calc-graph-line-style (style)
1059 (interactive "P")
1060 (calc-graph-set-styles (and style (prefix-numeric-value style)) t))
1062 (defun calc-graph-point-style (style)
1063 (interactive "P")
1064 (calc-graph-set-styles t (and style (prefix-numeric-value style))))
1066 (defun calc-graph-set-styles (lines points &optional yerr)
1067 (calc-graph-init)
1068 (with-current-buffer calc-gnuplot-input
1069 (or (calc-graph-find-plot nil nil)
1070 (error "No data points have been set!"))
1071 (let ((base (point))
1072 (mode nil) (lstyle nil) (pstyle nil)
1073 start end lenbl penbl errform)
1074 (re-search-forward "[,\n]")
1075 (forward-char -1)
1076 (setq end (point) start end)
1077 (goto-char base)
1078 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1079 (progn
1080 (setq start (match-beginning 1))
1081 (goto-char (match-end 0))
1082 (if (looking-at "[ \t]+\\([a-z]+\\)")
1083 (setq mode (buffer-substring (match-beginning 1)
1084 (match-end 1))))
1085 (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1086 (setq lstyle (string-to-number
1087 (buffer-substring (match-beginning 1)
1088 (match-end 1)))))
1089 (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1090 (setq pstyle (string-to-number
1091 (buffer-substring (match-beginning 1)
1092 (match-end 1)))))))
1093 (unless yerr
1094 (setq lenbl (or (equal mode "lines")
1095 (equal mode "linespoints"))
1096 penbl (or (equal mode "points")
1097 (equal mode "linespoints")))
1098 (if lines
1099 (or (eq lines t)
1100 (setq lstyle lines
1101 lenbl (>= lines 0)))
1102 (setq lenbl (not lenbl)))
1103 (if points
1104 (or (eq points t)
1105 (setq pstyle points
1106 penbl (>= points 0)))
1107 (setq penbl (not penbl))))
1108 (delete-region start end)
1109 (goto-char start)
1110 (setq errform
1111 (condition-case nil
1112 (math-contains-sdev-p
1113 (eval (intern
1114 (concat "var-"
1115 (save-excursion
1116 (re-search-backward ":\\(.*\\)\\}")
1117 (match-string 1))))))
1118 (error nil)))
1119 (if yerr
1120 (insert " with yerrorbars")
1121 (insert " with "
1122 (if (and errform
1123 (equal mode "dots")
1124 (eq lines t))
1125 "yerrorbars"
1126 (if lenbl
1127 (if penbl "linespoints" "lines")
1128 (if penbl "points" "dots"))))
1129 (if (and pstyle (> pstyle 0))
1130 (insert " "
1131 (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1132 " " (int-to-string pstyle))
1133 (if (and lstyle (> lstyle 0))
1134 (insert " " (int-to-string lstyle)))))))
1135 (calc-graph-view-commands))
1137 (defun calc-graph-zero-x (flag)
1138 (interactive "P")
1139 (calc-graph-set-command "noxzeroaxis"
1140 (and (if flag
1141 (<= (prefix-numeric-value flag) 0)
1142 (not (calc-graph-find-command "noxzeroaxis")))
1143 " ")))
1145 (defun calc-graph-zero-y (flag)
1146 (interactive "P")
1147 (calc-graph-set-command "noyzeroaxis"
1148 (and (if flag
1149 (<= (prefix-numeric-value flag) 0)
1150 (not (calc-graph-find-command "noyzeroaxis")))
1151 " ")))
1153 (defun calc-graph-name (name)
1154 (interactive "sTitle for current curve: ")
1155 (calc-graph-init)
1156 (with-current-buffer calc-gnuplot-input
1157 (or (calc-graph-find-plot nil nil)
1158 (error "No data points have been set!"))
1159 (let ((base (point))
1160 start
1161 end)
1162 (re-search-forward "[,\n]\\|[ \t]+with")
1163 (setq end (match-beginning 0))
1164 (goto-char base)
1165 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1166 (progn
1167 (goto-char (match-beginning 1))
1168 (delete-region (point) end))
1169 (goto-char end))
1170 (insert " title " (prin1-to-string name))))
1171 (calc-graph-view-commands))
1173 (defun calc-graph-hide (flag)
1174 (interactive "P")
1175 (calc-graph-init)
1176 (and (calc-graph-find-plot nil nil)
1177 (progn
1178 (or (looking-at "{")
1179 (error "Can't hide this curve (wrong format)"))
1180 (forward-char 1)
1181 (if (looking-at "*")
1182 (if (or (null flag) (<= (prefix-numeric-value flag) 0))
1183 (delete-char 1))
1184 (if (or (null flag) (> (prefix-numeric-value flag) 0))
1185 (insert "*"))))))
1187 (defun calc-graph-header (title)
1188 (interactive "sTitle for entire graph: ")
1189 (calc-graph-set-command "title" (if (not (equal title ""))
1190 (prin1-to-string title))))
1192 (defun calc-graph-border (flag)
1193 (interactive "P")
1194 (calc-graph-set-command "noborder"
1195 (and (if flag
1196 (<= (prefix-numeric-value flag) 0)
1197 (not (calc-graph-find-command "noborder")))
1198 " ")))
1200 (defun calc-graph-grid (flag)
1201 (interactive "P")
1202 (calc-graph-set-command "grid" (and (if flag
1203 (> (prefix-numeric-value flag) 0)
1204 (not (calc-graph-find-command "grid")))
1205 " ")))
1207 (defun calc-graph-key (flag)
1208 (interactive "P")
1209 (calc-graph-set-command "key" (and (if flag
1210 (> (prefix-numeric-value flag) 0)
1211 (not (calc-graph-find-command "key")))
1212 " ")))
1214 (defun calc-graph-num-points (res flag)
1215 (interactive "sNumber of data points: \nP")
1216 (if flag
1217 (if (> (prefix-numeric-value flag) 0)
1218 (if (equal res "")
1219 (message "Default resolution is %d"
1220 calc-graph-default-resolution)
1221 (setq calc-graph-default-resolution (string-to-number res)))
1222 (if (equal res "")
1223 (message "Default 3D resolution is %d"
1224 calc-graph-default-resolution-3d)
1225 (setq calc-graph-default-resolution-3d (string-to-number res))))
1226 (calc-graph-set-command "samples" (if (not (equal res "")) res))))
1228 (defun calc-graph-device (name flag)
1229 (interactive "sDevice name: \nP")
1230 (if (equal name "?")
1231 (progn
1232 (calc-gnuplot-command "set terminal")
1233 (calc-graph-view-trail))
1234 (if flag
1235 (if (> (prefix-numeric-value flag) 0)
1236 (if (equal name "")
1237 (message "Default GNUPLOT device is \"%s\""
1238 calc-gnuplot-default-device)
1239 (setq calc-gnuplot-default-device name))
1240 (if (equal name "")
1241 (message "GNUPLOT device for Print command is \"%s\""
1242 calc-gnuplot-print-device)
1243 (setq calc-gnuplot-print-device name)))
1244 (calc-graph-set-command "terminal" (if (not (equal name ""))
1245 name)))))
1247 (defun calc-graph-output (name flag)
1248 (interactive "FOutput file name: \np")
1249 (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
1250 (setq name "auto"))
1251 ((string-match "\\<[tT][tT][yY]$" name)
1252 (setq name "tty"))
1253 ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
1254 (setq name "STDOUT"))
1255 ((equal (file-name-nondirectory name) "")
1256 (setq name ""))
1257 (t (setq name (expand-file-name name))))
1258 (if flag
1259 (if (> (prefix-numeric-value flag) 0)
1260 (if (equal name "")
1261 (message "Default GNUPLOT output file is \"%s\""
1262 calc-gnuplot-default-output)
1263 (setq calc-gnuplot-default-output name))
1264 (if (equal name "")
1265 (message "GNUPLOT output file for Print command is \"%s\""
1266 calc-gnuplot-print-output)
1267 (setq calc-gnuplot-print-output name)))
1268 (calc-graph-set-command "output" (if (not (equal name ""))
1269 (prin1-to-string name)))))
1271 (defun calc-graph-display (name)
1272 (interactive "sX display name: ")
1273 (if (equal name "")
1274 (message "Current X display is \"%s\""
1275 (or calc-gnuplot-display "<none>"))
1276 (setq calc-gnuplot-display name)
1277 (if (calc-gnuplot-alive)
1278 (calc-gnuplot-command "exit"))))
1280 (defun calc-graph-geometry (name)
1281 (interactive "sX geometry spec (or \"default\"): ")
1282 (if (equal name "")
1283 (message "Current X geometry is \"%s\""
1284 (or calc-gnuplot-geometry "default"))
1285 (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
1286 (if (calc-gnuplot-alive)
1287 (calc-gnuplot-command "exit"))))
1289 (defun calc-graph-find-command (cmd)
1290 (calc-graph-init)
1291 (with-current-buffer calc-gnuplot-input
1292 (goto-char (point-min))
1293 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
1294 (buffer-substring (match-beginning 1) (match-end 1)))))
1296 (defun calc-graph-set-command (cmd &rest args)
1297 (calc-graph-init)
1298 (with-current-buffer calc-gnuplot-input
1299 (goto-char (point-min))
1300 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
1301 (progn
1302 (forward-char -1)
1303 (end-of-line)
1304 (let ((end (point)))
1305 (beginning-of-line)
1306 (delete-region (point) (1+ end))))
1307 (if (calc-graph-find-plot t t)
1308 (if (eq (preceding-char) ?\n)
1309 (forward-char -1))
1310 (goto-char (1- (point-max)))))
1311 (if (and args (car args))
1312 (progn
1313 (or (bolp)
1314 (insert "\n"))
1315 (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
1316 (calc-graph-view-commands))
1318 (defun calc-graph-command (cmd)
1319 (interactive "sGNUPLOT command: ")
1320 (calc-wrapper
1321 (calc-graph-init)
1322 (calc-graph-view-trail)
1323 (calc-gnuplot-command cmd)
1324 (or (string= calc-gnuplot-name "pgnuplot")
1325 (progn
1326 (accept-process-output)
1327 (calc-graph-view-trail)))))
1329 (defun calc-graph-kill (&optional no-view)
1330 (interactive)
1331 (calc-graph-delete-temps)
1332 (if (calc-gnuplot-alive)
1333 (calc-wrapper
1334 (or no-view (calc-graph-view-trail))
1335 (let ((calc-graph-no-wait t))
1336 (calc-gnuplot-command "exit"))
1337 (sit-for 1)
1338 (if (process-status calc-gnuplot-process)
1339 (delete-process calc-gnuplot-process))
1340 (setq calc-gnuplot-process nil))))
1342 (defun calc-graph-quit ()
1343 (interactive)
1344 (if (get-buffer-window calc-gnuplot-input)
1345 (calc-graph-view-commands t))
1346 (if (get-buffer-window calc-gnuplot-buffer)
1347 (calc-graph-view-trail t))
1348 (calc-graph-kill t))
1350 (defun calc-graph-view-commands (&optional no-need)
1351 (interactive "p")
1352 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1353 (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
1355 (defun calc-graph-view-trail (&optional no-need)
1356 (interactive "p")
1357 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1358 (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
1360 (defun calc-graph-view (buf other-buf need)
1361 (let (win)
1362 (or calc-graph-no-auto-view
1363 (if (setq win (get-buffer-window buf))
1364 (or need
1365 (and (eq buf calc-gnuplot-buffer)
1366 (with-current-buffer buf
1367 (not (pos-visible-in-window-p (point-max) win))))
1368 (progn
1369 (bury-buffer buf)
1370 (bury-buffer other-buf)
1371 (let ((curwin (selected-window)))
1372 (select-window win)
1373 (switch-to-buffer nil)
1374 (select-window curwin))))
1375 (if (setq win (get-buffer-window other-buf))
1376 (set-window-buffer win buf)
1377 (if (eq major-mode 'calc-mode)
1378 (if (or need
1379 (not (window-full-height-p)))
1380 (display-buffer buf))
1381 (switch-to-buffer buf)))))
1382 (with-current-buffer buf
1383 (if (and (eq buf calc-gnuplot-buffer)
1384 (setq win (get-buffer-window buf))
1385 (not (pos-visible-in-window-p (point-max) win)))
1386 (progn
1387 (goto-char (point-max))
1388 (vertical-motion (- 6 (window-height win)))
1389 (set-window-start win (point))
1390 (goto-char (point-max)))))
1391 (or calc-graph-no-auto-view (sit-for 0))))
1393 (defun calc-gnuplot-check-for-errors ()
1394 (if (save-excursion
1395 (prog2
1396 (progn
1397 (set-buffer calc-gnuplot-buffer)
1398 (goto-char calc-gnuplot-last-error-pos))
1399 (re-search-forward "^[ \t]+\\^$" nil t)
1400 (goto-char (point-max))
1401 (setq calc-gnuplot-last-error-pos (point-max))))
1402 (calc-graph-view-trail)))
1404 (defun calc-gnuplot-command (&rest args)
1405 (calc-graph-init)
1406 (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
1407 (or (string= calc-gnuplot-name "pgnuplot")
1408 (accept-process-output))
1409 (with-current-buffer calc-gnuplot-buffer
1410 (calc-gnuplot-check-for-errors)
1411 (goto-char (point-max))
1412 (setq calc-gnuplot-trail-mark (point))
1413 (or (>= calc-gnuplot-version 3)
1414 (insert cmd))
1415 (set-marker (process-mark calc-gnuplot-process) (point))
1416 (process-send-string calc-gnuplot-process cmd)
1417 (if (get-buffer-window calc-gnuplot-buffer)
1418 (calc-graph-view-trail))
1419 (or (string= calc-gnuplot-name "pgnuplot")
1420 (accept-process-output (and (not calc-graph-no-wait)
1421 calc-gnuplot-process)))
1422 (calc-gnuplot-check-for-errors)
1423 (if (get-buffer-window calc-gnuplot-buffer)
1424 (calc-graph-view-trail)))))
1426 (defun calc-graph-init-buffers ()
1427 (or (and calc-gnuplot-buffer
1428 (buffer-name calc-gnuplot-buffer))
1429 (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
1430 (or (and calc-gnuplot-input
1431 (buffer-name calc-gnuplot-input))
1432 (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
1434 (defun calc-graph-init ()
1435 (or (calc-gnuplot-alive)
1436 (let ((process-connection-type t)
1437 origin)
1438 (if calc-gnuplot-process
1439 (progn
1440 (delete-process calc-gnuplot-process)
1441 (setq calc-gnuplot-process nil)))
1442 (calc-graph-init-buffers)
1443 (with-current-buffer calc-gnuplot-buffer
1444 (insert "\nStarting gnuplot...\n")
1445 (setq origin (point)))
1446 (setq calc-graph-last-device nil)
1447 (setq calc-graph-last-output nil)
1448 (if (string= calc-gnuplot-name "pgnuplot")
1449 (let ((version-str (shell-command-to-string "pgnuplot -V")))
1450 (if (string-match "gnuplot \\([0-9]+\\)\\." version-str)
1451 (setq calc-gnuplot-version (string-to-number
1452 (substring version-str
1453 (match-beginning 1)
1454 (match-end 1))))
1455 (setq calc-gnuplot-version 1))))
1456 (condition-case err
1457 (let ((args (append (and calc-gnuplot-display
1458 (not (equal calc-gnuplot-display
1459 (getenv "DISPLAY")))
1460 (not (string= calc-gnuplot-name "pgnuplot"))
1461 (list "-display"
1462 calc-gnuplot-display))
1463 (and calc-gnuplot-geometry
1464 (not (string= calc-gnuplot-name "pgnuplot"))
1465 (list "-geometry"
1466 calc-gnuplot-geometry)))))
1467 (setq calc-gnuplot-process
1468 (apply 'start-process
1469 "gnuplot"
1470 calc-gnuplot-buffer
1471 calc-gnuplot-name
1472 args))
1473 (set-process-query-on-exit-flag calc-gnuplot-process nil))
1474 (file-error
1475 (error "Sorry, can't find \"%s\" on your system"
1476 calc-gnuplot-name)))
1477 (with-current-buffer calc-gnuplot-buffer
1478 (while (and (not (string= calc-gnuplot-name "pgnuplot"))
1479 (not (save-excursion
1480 (goto-char origin)
1481 (search-forward "gnuplot> " nil t)))
1482 (memq (process-status calc-gnuplot-process) '(run stop)))
1483 (accept-process-output calc-gnuplot-process))
1484 (or (memq (process-status calc-gnuplot-process) '(run stop))
1485 (error "Unable to start GNUPLOT process"))
1486 (if (not (string= calc-gnuplot-name "pgnuplot"))
1487 (if (save-excursion
1488 (goto-char origin)
1489 (re-search-forward
1490 "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
1491 (setq calc-gnuplot-version
1492 (string-to-number (buffer-substring
1493 (match-beginning 1)
1494 (match-end 1))))
1495 (setq calc-gnuplot-version 1)))
1496 (goto-char (point-max)))))
1497 (with-current-buffer calc-gnuplot-input
1498 (if (= (buffer-size) 0)
1499 (insert "# Commands for running gnuplot\n\n\n")
1500 (or calc-graph-no-auto-view
1501 (eq (char-after (1- (point-max))) ?\n)
1502 (progn
1503 (goto-char (point-max))
1504 (insert "\n"))))))
1506 (provide 'calc-graph)
1508 ;;; calc-graph.el ends here