]> code.delx.au - gnu-emacs/blob - lisp/calc/calc-graph.el
delx.au / code / gnu-emacs / blob


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