?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Update commentary.
[emacs.git] / lisp / calc / calc-graph.el
blobd52dc6d84b00e58d869363f849ee1017a7909c94
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 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, or (at your option)
14 ;; 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; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
25
26 ;;; Commentary:
27
28 ;;; Code:
29
30 ;; This file is autoloaded from calc-ext.el.
31
32 (require 'calc-ext)
33 (require 'calc-macs)
34
35 ;;; Graphics
36
37 ;; The following three variables are customizable and defined in calc.el.
38 (defvar calc-gnuplot-name)
39 (defvar calc-gnuplot-plot-command)
40 (defvar calc-gnuplot-print-command)
41
42 (defvar calc-gnuplot-tempfile "calc")
43
44 (defvar calc-gnuplot-default-device)
45 (defvar calc-gnuplot-default-output)
46 (defvar calc-gnuplot-print-device)
47 (defvar calc-gnuplot-print-output)
48 (defvar calc-gnuplot-keep-outfile nil)
49 (defvar calc-gnuplot-version nil)
50
51 (defvar calc-gnuplot-display (getenv "DISPLAY"))
52 (defvar calc-gnuplot-geometry)
53
54 (defvar calc-graph-default-resolution)
55 (defvar calc-graph-default-resolution-3d)
56 (defvar calc-graph-default-precision 5)
57
58 (defvar calc-gnuplot-buffer nil)
59 (defvar calc-gnuplot-input nil)
60
61 (defvar calc-gnuplot-last-error-pos 1)
62 (defvar calc-graph-last-device nil)
63 (defvar calc-graph-last-output nil)
64 (defvar calc-graph-file-cache nil)
65 (defvar calc-graph-var-cache nil)
66 (defvar calc-graph-data-cache nil)
67 (defvar calc-graph-data-cache-limit 10)
68 (defvar calc-graph-no-auto-view nil)
69 (defvar calc-graph-no-wait nil)
70 (defvar calc-gnuplot-trail-mark)
71
72 (defun calc-graph-fast (many)
73 (interactive "P")
74 (let ((calc-graph-no-auto-view t))
75 (calc-graph-delete t)
76 (calc-graph-add many)
77 (calc-graph-plot nil)))
78
79 (defun calc-graph-fast-3d (many)
80 (interactive "P")
81 (let ((calc-graph-no-auto-view t))
82 (calc-graph-delete t)
83 (calc-graph-add-3d many)
84 (calc-graph-plot nil)))
85
86 (defun calc-graph-delete (all)
87 (interactive "P")
88 (calc-wrapper
89 (calc-graph-init)
90 (save-excursion
91 (set-buffer calc-gnuplot-input)
92 (and (calc-graph-find-plot t all)
93 (progn
94 (if (looking-at "s?plot")
95 (progn
96 (setq calc-graph-var-cache nil)
97 (delete-region (point) (point-max)))
98 (delete-region (point) (1- (point-max)))))))
99 (calc-graph-view-commands)))
100
101 (defun calc-graph-find-plot (&optional before all)
102 (goto-char (point-min))
103 (and (re-search-forward "^s?plot[ \t]+" nil t)
104 (let ((beg (point)))
105 (goto-char (point-max))
106 (if (or all
107 (not (search-backward "," nil t))
108 (< (point) beg))
109 (progn
110 (goto-char beg)
111 (if before
112 (beginning-of-line)))
113 (or before
114 (re-search-forward ",[ \t]+")))
115 t)))
116
117 (defun calc-graph-add (many)
118 (interactive "P")
119 (calc-wrapper
120 (calc-graph-init)
121 (cond ((null many)
122 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
123 (calc-graph-lookup (calc-top-n 1))))
124 ((or (consp many) (eq many 0))
125 (let ((xdata (calc-graph-lookup (calc-top-n 2)))
126 (ylist (calc-top-n 1)))
127 (or (eq (car-safe ylist) 'vec)
128 (error "Y argument must be a vector"))
129 (while (setq ylist (cdr ylist))
130 (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
131 ((> (setq many (prefix-numeric-value many)) 0)
132 (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
133 (while (> many 0)
134 (calc-graph-add-curve xdata
135 (calc-graph-lookup (calc-top-n many)))
136 (setq many (1- many)))))
137 (t
138 (let (pair)
139 (setq many (- many))
140 (while (> many 0)
141 (setq pair (calc-top-n many))
142 (or (and (eq (car-safe pair) 'vec)
143 (= (length pair) 3))
144 (error "Argument must be an [x,y] vector"))
145 (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
146 (calc-graph-lookup (nth 2 pair)))
147 (setq many (1- many))))))
148 (calc-graph-view-commands)))
149
150 (defun calc-graph-add-3d (many)
151 (interactive "P")
152 (calc-wrapper
153 (calc-graph-init)
154 (cond ((null many)
155 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
156 (calc-graph-lookup (calc-top-n 2))
157 (calc-graph-lookup (calc-top-n 1))))
158 ((or (consp many) (eq many 0))
159 (let ((xdata (calc-graph-lookup (calc-top-n 3)))
160 (ydata (calc-graph-lookup (calc-top-n 2)))
161 (zlist (calc-top-n 1)))
162 (or (eq (car-safe zlist) 'vec)
163 (error "Z argument must be a vector"))
164 (while (setq zlist (cdr zlist))
165 (calc-graph-add-curve xdata ydata
166 (calc-graph-lookup (car zlist))))))
167 ((> (setq many (prefix-numeric-value many)) 0)
168 (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
169 (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
170 (while (> many 0)
171 (calc-graph-add-curve xdata ydata
172 (calc-graph-lookup (calc-top-n many)))
173 (setq many (1- many)))))
174 (t
175 (let (curve)
176 (setq many (- many))
177 (while (> many 0)
178 (setq curve (calc-top-n many))
179 (or (and (eq (car-safe curve) 'vec)
180 (= (length curve) 4))
181 (error "Argument must be an [x,y,z] vector"))
182 (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
183 (calc-graph-lookup (nth 2 curve))
184 (calc-graph-lookup (nth 3 curve)))
185 (setq many (1- many))))))
186 (calc-graph-view-commands)))
187
188 (defun calc-graph-add-curve (xdata ydata &optional zdata)
189 (let ((num (calc-graph-count-curves))
190 (pstyle (calc-var-value 'var-PointStyles))
191 (lstyle (calc-var-value 'var-LineStyles)))
192 (save-excursion
193 (set-buffer calc-gnuplot-input)
194 (goto-char (point-min))
195 (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
196 nil t)
197 (error "Can't mix 2d and 3d curves on one graph"))
198 (if (re-search-forward "^s?plot[ \t]" nil t)
199 (progn
200 (end-of-line)
201 (insert ", "))
202 (goto-char (point-max))
203 (or (eq (preceding-char) ?\n)
204 (insert "\n"))
205 (insert (if zdata "splot" "plot") " \n")
206 (forward-char -1))
207 (insert "{" (symbol-name (nth 1 xdata))
208 ":" (symbol-name (nth 1 ydata)))
209 (if zdata
210 (insert ":" (symbol-name (nth 1 zdata))))
211 (insert "} "
212 "title \"" (symbol-name (nth 1 ydata)) "\" "
213 "with dots")
214 (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
215 (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle))))
216 (calc-graph-set-styles
217 (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
218 0)
219 (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
220 (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
221 0 -1))
222 (math-contains-sdev-p (eval (nth 2 ydata))))))
223
224 (defun calc-graph-lookup (thing)
225 (if (and (eq (car-safe thing) 'var)
226 (calc-var-value (nth 2 thing)))
227 thing
228 (let ((found (assoc thing calc-graph-var-cache)))
229 (or found
230 (let ((varname (concat "PlotData"
231 (int-to-string
232 (1+ (length calc-graph-var-cache))))))
233 (setq var (list 'var (intern varname)
234 (intern (concat "var-" varname)))
235 found (cons thing var)
236 calc-graph-var-cache (cons found calc-graph-var-cache))
237 (set (nth 2 var) thing)))
238 (cdr found))))
239
240 (defun calc-graph-juggle (arg)
241 (interactive "p")
242 (calc-graph-init)
243 (save-excursion
244 (set-buffer calc-gnuplot-input)
245 (if (< arg 0)
246 (let ((num (calc-graph-count-curves)))
247 (if (> num 0)
248 (while (< arg 0)
249 (setq arg (+ arg num))))))
250 (while (>= (setq arg (1- arg)) 0)
251 (calc-graph-do-juggle))))
252
253 (defun calc-graph-count-curves ()
254 (save-excursion
255 (set-buffer calc-gnuplot-input)
256 (if (re-search-forward "^s?plot[ \t]" nil t)
257 (let ((num 1))
258 (goto-char (point-min))
259 (while (search-forward "," nil t)
260 (setq num (1+ num)))
261 num)
262 0)))
263
264 (defun calc-graph-do-juggle ()
265 (let (base)
266 (and (calc-graph-find-plot t t)
267 (progn
268 (setq base (point))
269 (calc-graph-find-plot t nil)
270 (or (eq base (point))
271 (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
272 (delete-region (point) (1- (point-max)))
273 (goto-char (+ base 5))
274 (insert str ", ")))))))
275
276 (defun calc-graph-print (flag)
277 (interactive "P")
278 (calc-graph-plot flag t))
279
280 (defvar var-DUMMY)
281 (defvar var-DUMMY2)
282 (defvar var-PlotRejects)
283
284 ;; The following variables are local to calc-graph-plot, but are
285 ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
286 ;; calc-graph-recompute-2d, calc-graph-compute-3d and
287 ;; calc-graph-format-data, which are called by calc-graph-plot.
288 (defvar calc-graph-yvalue)
289 (defvar calc-graph-yvec)
290 (defvar calc-graph-numsteps)
291 (defvar calc-graph-numsteps3)
292 (defvar calc-graph-xvalue)
293 (defvar calc-graph-xvec)
294 (defvar calc-graph-xname)
295 (defvar calc-graph-yname)
296 (defvar calc-graph-xstep)
297 (defvar calc-graph-ycache)
298 (defvar calc-graph-ycacheptr)
299 (defvar calc-graph-refine)
300 (defvar calc-graph-keep-file)
301 (defvar calc-graph-xval)
302 (defvar calc-graph-xlow)
303 (defvar calc-graph-xhigh)
304 (defvar calc-graph-yval)
305 (defvar calc-graph-yp)
306 (defvar calc-graph-xp)
307 (defvar calc-graph-zp)
308 (defvar calc-graph-yvector)
309 (defvar calc-graph-resolution)
310 (defvar calc-graph-y3value)
311 (defvar calc-graph-y3name)
312 (defvar calc-graph-y3step)
313 (defvar calc-graph-zval)
314 (defvar calc-graph-stepcount)
315 (defvar calc-graph-is-splot)
316 (defvar calc-graph-surprise-splot)
317 (defvar calc-graph-blank)
318 (defvar calc-graph-non-blank)
319 (defvar calc-graph-curve-num)
320
321 (defun calc-graph-plot (flag &optional printing)
322 (interactive "P")
323 (calc-slow-wrapper
324 (let ((calcbuf (current-buffer))
325 (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
326 (tempbuftop 1)
327 (tempoutfile nil)
328 (calc-graph-curve-num 0)
329 (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
330 (recompute (and flag (< (prefix-numeric-value flag) 0)))
331 (calc-graph-surprise-splot nil)
332 (tty-output nil)
333 cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos)
334 (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)
335 (save-excursion
336 (calc-graph-init)
337 (set-buffer tempbuf)
338 (erase-buffer)
339 (set-buffer calc-gnuplot-input)
340 (goto-char (point-min))
341 (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t))
342 (let ((str (buffer-string))
343 (ver calc-gnuplot-version))
344 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
345 (erase-buffer)
346 (insert "# (Note: This is a temporary copy---do not edit!)\n")
347 (if (>= ver 2)
348 (insert "set noarrow\nset nolabel\n"
349 "set autoscale xy\nset nologscale xy\n"
350 "set xlabel\nset ylabel\nset title\n"
351 "set noclip points\nset clip one\nset clip two\n"
352 "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
353 "set data style linespoints\n"
354 "set nogrid\nset nokey\nset nopolar\n"))
355 (if (>= ver 3)
356 (insert "set surface\nset nocontour\n"
357 "set " (if calc-graph-is-splot "" "no") "parametric\n"
358 "set notime\nset border\nset ztics\nset zeroaxis\n"
359 "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
360 (setq samples-pos (point))
361 (insert "\n\n" str))
362 (goto-char (point-min))
363 (if calc-graph-is-splot
364 (if calc-graph-refine
365 (error "This option works only for 2d plots")
366 (setq recompute t)))
367 (let ((calc-gnuplot-input (current-buffer))
368 (calc-graph-no-auto-view t))
369 (if printing
370 (setq device calc-gnuplot-print-device
371 output calc-gnuplot-print-output)
372 (setq device (calc-graph-find-command "terminal")
373 output (calc-graph-find-command "output"))
374 (or device
375 (setq device calc-gnuplot-default-device))
376 (if output
377 (setq output (car (read-from-string output)))
378 (setq output calc-gnuplot-default-output)))
379 (if (or (equal device "") (equal device "default"))
380 (setq device (if printing
381 "postscript"
382 (if (or (eq window-system 'x) (getenv "DISPLAY"))
383 "x11"
384 (if (>= calc-gnuplot-version 3)
385 "dumb" "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")
408 ""
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-backward-char 1))))
435 (save-excursion
436 (set-buffer calcbuf)
437 (setq cache-env (list calc-angle-mode
438 calc-complex-mode
439 calc-simplify-mode
440 calc-infinite-mode
441 calc-word-size
442 precision calc-graph-is-splot))
443 (if (and (not recompute)
444 (equal (cdr (car calc-graph-data-cache)) cache-env))
445 (while (> (length calc-graph-data-cache)
446 calc-graph-data-cache-limit)
447 (setcdr calc-graph-data-cache
448 (cdr (cdr calc-graph-data-cache))))
449 (setq calc-graph-data-cache (list (cons nil cache-env)))))
450 (calc-graph-find-plot t t)
451 (while (re-search-forward
452 (if calc-graph-is-splot
453 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
454 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
455 nil t)
456 (setq calc-graph-curve-num (1+ calc-graph-curve-num))
457 (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1)))
458 (xvar (intern (concat "var-" calc-graph-xname)))
459 (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar)))
460 (calc-graph-y3name (and calc-graph-is-splot
461 (buffer-substring (match-beginning 2)
462 (match-end 2))))
463 (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name))))
464 (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var)))
465 (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3)))
466 (yvar (intern (concat "var-" calc-graph-yname)))
467 (calc-graph-yvalue (calc-var-value yvar))
468 filename)
469 (delete-region (match-beginning 0) (match-end 0))
470 (setq filename (calc-temp-file-name calc-graph-curve-num))
471 (save-excursion
472 (set-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 (entry (and (not calc-graph-is-splot)
509 (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps))))
510 (or (equal entry
511 (nth 1 (nth (1+ calc-graph-curve-num)
512 calc-graph-file-cache)))
513 (setq calc-graph-keep-file nil))
514 (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache))
515 entry)
516 (or calc-graph-keep-file
517 (calc-graph-format-data)))
518 (or calc-graph-keep-file
519 (progn
520 (or calc-graph-non-blank
521 (error "No valid data points for %s:%s"
522 calc-graph-xname calc-graph-yname))
523 (write-region tempbuftop (point-max) filename
524 nil 'quiet))))))
525 (insert (prin1-to-string filename))))
526 (if calc-graph-surprise-splot
527 (setcdr cache-env nil))
528 (if (= calc-graph-curve-num 0)
529 (progn
530 (calc-gnuplot-command "clear")
531 (calc-clear-command-flag 'clear-message)
532 (message "No data to plot!"))
533 (setq calc-graph-data-cache-limit (max calc-graph-curve-num
534 calc-graph-data-cache-limit)
535 filename (calc-temp-file-name 0))
536 (write-region (point-min) (point-max) filename nil 'quiet)
537 (calc-gnuplot-command "load" (prin1-to-string filename))
538 (or (equal output "STDOUT")
539 calc-gnuplot-keep-outfile
540 (progn ; need to close the output file before printing/plotting
541 (setq calc-graph-last-output "STDOUT")
542 (calc-gnuplot-command "set output")))
543 (let ((command (if printing
544 calc-gnuplot-print-command
545 (or calc-gnuplot-plot-command
546 (and (string-match "^dumb" device)
547 'calc-graph-show-dumb)
548 (and tty-output
549 'calc-graph-show-tty)))))
550 (if command
551 (if (stringp command)
552 (calc-gnuplot-command
553 "!" (format command
554 (or tempoutfile
555 calc-gnuplot-print-output)))
556 (if (symbolp command)
557 (funcall command output)
558 (eval command))))))))))
559
560 (defun calc-graph-compute-2d ()
561 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
562 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
563 (error "Can't plot an empty vector")
564 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
565 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
566 (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname))
567 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
568 (math-constp calc-graph-xvalue))
569 (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue)
570 (nth 2 calc-graph-xvalue))
571 (1- calc-graph-numsteps))
572 calc-graph-xvalue (nth 2 calc-graph-xvalue))
573 (if (math-realp calc-graph-xvalue)
574 (setq calc-graph-xstep 1)
575 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))))
576 (or (math-realp calc-graph-yvalue)
577 (let ((arglist nil))
578 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
579 (calc-default-formula-arglist calc-graph-yvalue)
580 (or arglist
581 (error "%s does not contain any unassigned variables" calc-graph-yname))
582 (and (cdr arglist)
583 (error "%s contains more than one variable: %s"
584 calc-graph-yname arglist))
585 (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue
586 (math-build-var-name (car arglist))
587 '(var DUMMY var-DUMMY)))))
588 (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache))
589 (delq calc-graph-ycache calc-graph-data-cache)
590 (nconc calc-graph-data-cache
591 (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue)))))
592 (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)))
593 calc-graph-refine (cdr (cdr calc-graph-ycache)))
594 (calc-graph-refine-2d)
595 (calc-graph-recompute-2d))))
596
597 (defun calc-graph-refine-2d ()
598 (setq calc-graph-keep-file nil
599 calc-graph-ycacheptr (cdr calc-graph-ycache))
600 (if (and (setq calc-graph-xval (calc-graph-find-command "xrange"))
601 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
602 calc-graph-xval))
603 (let ((b2 (match-beginning 2))
604 (e2 (match-end 2)))
605 (setq calc-graph-xlow (math-read-number (substring calc-graph-xval
606 (match-beginning 1)
607 (match-end 1)))
608 calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2))))
609 (if calc-graph-xlow
610 (while (and (cdr calc-graph-ycacheptr)
611 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow))
612 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))))
613 (setq math-working-step-2 (1- (length calc-graph-ycacheptr)))
614 (while (and (cdr calc-graph-ycacheptr)
615 (or (not calc-graph-xhigh)
616 (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh)))
617 (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr))
618 (car (nth 1 calc-graph-ycacheptr)))
619 2)
620 math-working-step (1+ math-working-step)
621 calc-graph-yval (math-evaluate-expr calc-graph-yvalue))
622 (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval)
623 (cdr calc-graph-ycacheptr)))
624 (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr))))
625 (setq calc-graph-yp calc-graph-ycache
626 calc-graph-numsteps 1000000))
627
628 (defun calc-graph-recompute-2d ()
629 (setq calc-graph-ycacheptr calc-graph-ycache)
630 (if calc-graph-xvec
631 (setq calc-graph-numsteps (1- (length calc-graph-xvalue))
632 calc-graph-yvector nil)
633 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
634 (math-constp calc-graph-xvalue))
635 (setq calc-graph-numsteps calc-graph-resolution
636 calc-graph-yp nil
637 calc-graph-xlow (nth 2 calc-graph-xvalue)
638 calc-graph-xhigh (nth 3 calc-graph-xvalue)
639 calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow)
640 (1- calc-graph-numsteps))
641 calc-graph-xvalue (nth 2 calc-graph-xvalue))
642 (error "%s is not a suitable basis for %s"
643 calc-graph-xname calc-graph-yname)))
644 (setq math-working-step-2 calc-graph-numsteps)
645 (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0)
646 (setq math-working-step (1+ math-working-step))
647 (if calc-graph-xvec
648 (progn
649 (setq calc-graph-xp (cdr calc-graph-xp)
650 calc-graph-xval (car calc-graph-xp))
651 (and (not (eq calc-graph-ycacheptr calc-graph-ycache))
652 (consp (car calc-graph-ycacheptr))
653 (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval))
654 (setq calc-graph-ycacheptr calc-graph-ycache)))
655 (if (= calc-graph-numsteps 0)
656 (setq calc-graph-xval calc-graph-xhigh) ; avoid cumulative roundoff
657 (setq calc-graph-xval calc-graph-xvalue
658 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep))))
659 (while (and (cdr calc-graph-ycacheptr)
660 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
661 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))
662 (or (and (cdr calc-graph-ycacheptr)
663 (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
664 (progn
665 (setq calc-graph-keep-file nil
666 var-DUMMY calc-graph-xval)
667 (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue))
668 (cdr calc-graph-ycacheptr)))))
669 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))
670 (if calc-graph-xvec
671 (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector))
672 (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr))))
673 (if calc-graph-xvec
674 (setq calc-graph-xp calc-graph-xvalue
675 calc-graph-yvec t
676 calc-graph-yp (cons 'vec (nreverse calc-graph-yvector))
677 calc-graph-numsteps (1- (length calc-graph-xp)))
678 (setq calc-graph-numsteps 1000000)))
679
680 (defun calc-graph-compute-3d ()
681 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
682 (if (math-matrixp calc-graph-yvalue)
683 (progn
684 (setq calc-graph-numsteps (1- (length calc-graph-yvalue))
685 calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue))))
686 (if (eq (car-safe calc-graph-xvalue) 'vec)
687 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
688 (error "%s has wrong length" calc-graph-xname))
689 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
690 (math-constp calc-graph-xvalue))
691 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps
692 (nth 2 calc-graph-xvalue)
693 (math-div
694 (math-sub (nth 3 calc-graph-xvalue)
695 (nth 2 calc-graph-xvalue))
696 (1- calc-graph-numsteps))))
697 (if (math-realp calc-graph-xvalue)
698 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1))
699 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))
700 (if (eq (car-safe calc-graph-y3value) 'vec)
701 (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3)
702 (error "%s has wrong length" calc-graph-y3name))
703 (if (and (eq (car-safe calc-graph-y3value) 'intv)
704 (math-constp calc-graph-y3value))
705 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3
706 (nth 2 calc-graph-y3value)
707 (math-div
708 (math-sub (nth 3 calc-graph-y3value)
709 (nth 2 calc-graph-y3value))
710 (1- calc-graph-numsteps3))))
711 (if (math-realp calc-graph-y3value)
712 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1))
713 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))))
714 (setq calc-graph-xp nil
715 calc-graph-yp nil
716 calc-graph-zp nil
717 calc-graph-xvec t)
718 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue))
719 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
720 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
721 calc-graph-zp (nconc calc-graph-zp (cons '(skip)
722 (copy-sequence (cdr (car calc-graph-yvalue)))))))
723 (setq calc-graph-numsteps (1- (* calc-graph-numsteps
724 (1+ calc-graph-numsteps3)))))
725 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
726 (error "Can't plot an empty vector"))
727 (or (and (eq (car-safe calc-graph-xvalue) 'vec)
728 (= (1- (length calc-graph-xvalue)) calc-graph-numsteps))
729 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))
730 (or (and (eq (car-safe calc-graph-y3value) 'vec)
731 (= (1- (length calc-graph-y3value)) calc-graph-numsteps))
732 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))
733 (setq calc-graph-xp calc-graph-xvalue
734 calc-graph-yp calc-graph-y3value
735 calc-graph-zp calc-graph-yvalue
736 calc-graph-xvec t))
737 (or (math-realp calc-graph-yvalue)
738 (let ((arglist nil))
739 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
740 (calc-default-formula-arglist calc-graph-yvalue)
741 (setq arglist (sort arglist 'string-lessp))
742 (or (cdr arglist)
743 (error "%s does not contain enough unassigned variables" calc-graph-yname))
744 (and (cdr (cdr arglist))
745 (error "%s contains too many variables: %s" calc-graph-yname arglist))
746 (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue
747 (mapcar 'math-build-var-name
748 arglist)
749 '((var DUMMY var-DUMMY)
750 (var DUMMY2 var-DUMMY2))))))
751 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
752 (setq calc-graph-numsteps (1- (length calc-graph-xvalue)))
753 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
754 (math-constp calc-graph-xvalue))
755 (setq calc-graph-numsteps calc-graph-resolution
756 calc-graph-xvalue (calcFunc-index calc-graph-numsteps
757 (nth 2 calc-graph-xvalue)
758 (math-div (math-sub (nth 3 calc-graph-xvalue)
759 (nth 2 calc-graph-xvalue))
760 (1- calc-graph-numsteps))))
761 (error "%s is not a suitable basis for %s"
762 calc-graph-xname calc-graph-yname)))
763 (if (eq (car-safe calc-graph-y3value) 'vec)
764 (setq calc-graph-numsteps3 (1- (length calc-graph-y3value)))
765 (if (and (eq (car-safe calc-graph-y3value) 'intv)
766 (math-constp calc-graph-y3value))
767 (setq calc-graph-numsteps3 calc-graph-resolution
768 calc-graph-y3value (calcFunc-index calc-graph-numsteps3
769 (nth 2 calc-graph-y3value)
770 (math-div (math-sub (nth 3 calc-graph-y3value)
771 (nth 2 calc-graph-y3value))
772 (1- calc-graph-numsteps3))))
773 (error "%s is not a suitable basis for %s"
774 calc-graph-y3name calc-graph-yname)))
775 (setq calc-graph-xp nil
776 calc-graph-yp nil
777 calc-graph-zp nil
778 calc-graph-xvec t)
779 (setq math-working-step 0)
780 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue))
781 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
782 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
783 calc-graph-zp (cons '(skip) calc-graph-zp)
784 calc-graph-y3step calc-graph-y3value
785 var-DUMMY (car calc-graph-xvalue)
786 math-working-step-2 0
787 math-working-step (1+ math-working-step))
788 (while (setq calc-graph-y3step (cdr calc-graph-y3step))
789 (setq math-working-step-2 (1+ math-working-step-2)
790 var-DUMMY2 (car calc-graph-y3step)
791 calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp))))
792 (setq calc-graph-zp (nreverse calc-graph-zp)
793 calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3))))))
794
795 (defun calc-graph-format-data ()
796 (if (math-contains-sdev-p calc-graph-yp)
797 (let ((yp calc-graph-yp))
798 (setq calc-graph-yp (cons 'vec (mapcar 'math-get-value (cdr yp))))
799 (setq calc-graph-zp (cons 'vec (mapcar 'math-get-sdev (cdr yp))))))
800 (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps)
801 (if calc-graph-xvec
802 (setq calc-graph-xp (cdr calc-graph-xp)
803 calc-graph-xval (car calc-graph-xp)
804 calc-graph-yp (cdr calc-graph-yp)
805 calc-graph-yval (car calc-graph-yp)
806 calc-graph-zp (cdr calc-graph-zp)
807 calc-graph-zval (car calc-graph-zp))
808 (if calc-graph-yvec
809 (setq calc-graph-xval calc-graph-xvalue
810 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)
811 calc-graph-yp (cdr calc-graph-yp)
812 calc-graph-yval (car calc-graph-yp))
813 (setq calc-graph-xval (car (car calc-graph-yp))
814 calc-graph-yval (cdr (car calc-graph-yp))
815 calc-graph-yp (cdr calc-graph-yp))
816 (if (or (not calc-graph-yp)
817 (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh)))
818 (setq calc-graph-numsteps 0))))
819 (if calc-graph-is-splot
820 (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz)
821 (= (length calc-graph-zval) 4))
822 (setq calc-graph-xval (nth 1 calc-graph-zval)
823 calc-graph-yval (nth 2 calc-graph-zval)
824 calc-graph-zval (nth 3 calc-graph-zval)))
825 (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz)
826 (= (length calc-graph-yval) 4))
827 (progn
828 (or calc-graph-surprise-splot
829 (save-excursion
830 (set-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 (save-excursion
1070 (set-buffer calc-gnuplot-input)
1071 (or (calc-graph-find-plot nil nil)
1072 (error "No data points have been set!"))
1073 (let ((base (point))
1074 (mode nil) (lstyle nil) (pstyle nil)
1075 start end lenbl penbl errform)
1076 (re-search-forward "[,\n]")
1077 (forward-char -1)
1078 (setq end (point) start end)
1079 (goto-char base)
1080 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1081 (progn
1082 (setq start (match-beginning 1))
1083 (goto-char (match-end 0))
1084 (if (looking-at "[ \t]+\\([a-z]+\\)")
1085 (setq mode (buffer-substring (match-beginning 1)
1086 (match-end 1))))
1087 (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1088 (setq lstyle (string-to-number
1089 (buffer-substring (match-beginning 1)
1090 (match-end 1)))))
1091 (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1092 (setq pstyle (string-to-number
1093 (buffer-substring (match-beginning 1)
1094 (match-end 1)))))))
1095 (unless yerr
1096 (setq lenbl (or (equal mode "lines")
1097 (equal mode "linespoints"))
1098 penbl (or (equal mode "points")
1099 (equal mode "linespoints")))
1100 (if lines
1101 (or (eq lines t)
1102 (setq lstyle lines
1103 lenbl (>= lines 0)))
1104 (setq lenbl (not lenbl)))
1105 (if points
1106 (or (eq points t)
1107 (setq pstyle points
1108 penbl (>= points 0)))
1109 (setq penbl (not penbl))))
1110 (delete-region start end)
1111 (goto-char start)
1112 (setq errform
1113 (condition-case nil
1114 (math-contains-sdev-p
1115 (eval (intern
1116 (concat "var-"
1117 (save-excursion
1118 (re-search-backward ":\\(.*\\)\\}")
1119 (match-string 1))))))
1120 (error nil)))
1121 (if yerr
1122 (insert " with yerrorbars")
1123 (insert " with "
1124 (if (and errform
1125 (equal mode "dots")
1126 (eq lines t))
1127 "yerrorbars"
1128 (if lenbl
1129 (if penbl "linespoints" "lines")
1130 (if penbl "points" "dots"))))
1131 (if (and pstyle (> pstyle 0))
1132 (insert " "
1133 (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1134 " " (int-to-string pstyle))
1135 (if (and lstyle (> lstyle 0))
1136 (insert " " (int-to-string lstyle)))))))
1137 (calc-graph-view-commands))
1138
1139 (defun calc-graph-zero-x (flag)
1140 (interactive "P")
1141 (calc-graph-set-command "noxzeroaxis"
1142 (and (if flag
1143 (<= (prefix-numeric-value flag) 0)
1144 (not (calc-graph-find-command "noxzeroaxis")))
1145 " ")))
1146
1147 (defun calc-graph-zero-y (flag)
1148 (interactive "P")
1149 (calc-graph-set-command "noyzeroaxis"
1150 (and (if flag
1151 (<= (prefix-numeric-value flag) 0)
1152 (not (calc-graph-find-command "noyzeroaxis")))
1153 " ")))
1154
1155 (defun calc-graph-name (name)
1156 (interactive "sTitle for current curve: ")
1157 (calc-graph-init)
1158 (save-excursion
1159 (set-buffer calc-gnuplot-input)
1160 (or (calc-graph-find-plot nil nil)
1161 (error "No data points have been set!"))
1162 (let ((base (point))
1163 start
1164 end)
1165 (re-search-forward "[,\n]\\|[ \t]+with")
1166 (setq end (match-beginning 0))
1167 (goto-char base)
1168 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1169 (progn
1170 (goto-char (match-beginning 1))
1171 (delete-region (point) end))
1172 (goto-char end))
1173 (insert " title " (prin1-to-string name))))
1174 (calc-graph-view-commands))
1175
1176 (defun calc-graph-hide (flag)
1177 (interactive "P")
1178 (calc-graph-init)
1179 (and (calc-graph-find-plot nil nil)
1180 (progn
1181 (or (looking-at "{")
1182 (error "Can't hide this curve (wrong format)"))
1183 (forward-char 1)
1184 (if (looking-at "*")
1185 (if (or (null flag) (<= (prefix-numeric-value flag) 0))
1186 (delete-char 1))
1187 (if (or (null flag) (> (prefix-numeric-value flag) 0))
1188 (insert "*"))))))
1189
1190 (defun calc-graph-header (title)
1191 (interactive "sTitle for entire graph: ")
1192 (calc-graph-set-command "title" (if (not (equal title ""))
1193 (prin1-to-string title))))
1194
1195 (defun calc-graph-border (flag)
1196 (interactive "P")
1197 (calc-graph-set-command "noborder"
1198 (and (if flag
1199 (<= (prefix-numeric-value flag) 0)
1200 (not (calc-graph-find-command "noborder")))
1201 " ")))
1202
1203 (defun calc-graph-grid (flag)
1204 (interactive "P")
1205 (calc-graph-set-command "grid" (and (if flag
1206 (> (prefix-numeric-value flag) 0)
1207 (not (calc-graph-find-command "grid")))
1208 " ")))
1209
1210 (defun calc-graph-key (flag)
1211 (interactive "P")
1212 (calc-graph-set-command "key" (and (if flag
1213 (> (prefix-numeric-value flag) 0)
1214 (not (calc-graph-find-command "key")))
1215 " ")))
1216
1217 (defun calc-graph-num-points (res flag)
1218 (interactive "sNumber of data points: \nP")
1219 (if flag
1220 (if (> (prefix-numeric-value flag) 0)
1221 (if (equal res "")
1222 (message "Default resolution is %d"
1223 calc-graph-default-resolution)
1224 (setq calc-graph-default-resolution (string-to-number res)))
1225 (if (equal res "")
1226 (message "Default 3D resolution is %d"
1227 calc-graph-default-resolution-3d)
1228 (setq calc-graph-default-resolution-3d (string-to-number res))))
1229 (calc-graph-set-command "samples" (if (not (equal res "")) res))))
1230
1231 (defun calc-graph-device (name flag)
1232 (interactive "sDevice name: \nP")
1233 (if (equal name "?")
1234 (progn
1235 (calc-gnuplot-command "set terminal")
1236 (calc-graph-view-trail))
1237 (if flag
1238 (if (> (prefix-numeric-value flag) 0)
1239 (if (equal name "")
1240 (message "Default GNUPLOT device is \"%s\""
1241 calc-gnuplot-default-device)
1242 (setq calc-gnuplot-default-device name))
1243 (if (equal name "")
1244 (message "GNUPLOT device for Print command is \"%s\""
1245 calc-gnuplot-print-device)
1246 (setq calc-gnuplot-print-device name)))
1247 (calc-graph-set-command "terminal" (if (not (equal name ""))
1248 name)))))
1249
1250 (defun calc-graph-output (name flag)
1251 (interactive "FOutput file name: \np")
1252 (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
1253 (setq name "auto"))
1254 ((string-match "\\<[tT][tT][yY]$" name)
1255 (setq name "tty"))
1256 ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
1257 (setq name "STDOUT"))
1258 ((equal (file-name-nondirectory name) "")
1259 (setq name ""))
1260 (t (setq name (expand-file-name name))))
1261 (if flag
1262 (if (> (prefix-numeric-value flag) 0)
1263 (if (equal name "")
1264 (message "Default GNUPLOT output file is \"%s\""
1265 calc-gnuplot-default-output)
1266 (setq calc-gnuplot-default-output name))
1267 (if (equal name "")
1268 (message "GNUPLOT output file for Print command is \"%s\""
1269 calc-gnuplot-print-output)
1270 (setq calc-gnuplot-print-output name)))
1271 (calc-graph-set-command "output" (if (not (equal name ""))
1272 (prin1-to-string name)))))
1273
1274 (defun calc-graph-display (name)
1275 (interactive "sX display name: ")
1276 (if (equal name "")
1277 (message "Current X display is \"%s\""
1278 (or calc-gnuplot-display "<none>"))
1279 (setq calc-gnuplot-display name)
1280 (if (calc-gnuplot-alive)
1281 (calc-gnuplot-command "exit"))))
1282
1283 (defun calc-graph-geometry (name)
1284 (interactive "sX geometry spec (or \"default\"): ")
1285 (if (equal name "")
1286 (message "Current X geometry is \"%s\""
1287 (or calc-gnuplot-geometry "default"))
1288 (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
1289 (if (calc-gnuplot-alive)
1290 (calc-gnuplot-command "exit"))))
1291
1292 (defun calc-graph-find-command (cmd)
1293 (calc-graph-init)
1294 (save-excursion
1295 (set-buffer calc-gnuplot-input)
1296 (goto-char (point-min))
1297 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
1298 (buffer-substring (match-beginning 1) (match-end 1)))))
1299
1300 (defun calc-graph-set-command (cmd &rest args)
1301 (calc-graph-init)
1302 (save-excursion
1303 (set-buffer calc-gnuplot-input)
1304 (goto-char (point-min))
1305 (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
1306 (progn
1307 (forward-char -1)
1308 (end-of-line)
1309 (let ((end (point)))
1310 (beginning-of-line)
1311 (delete-region (point) (1+ end))))
1312 (if (calc-graph-find-plot t t)
1313 (if (eq (preceding-char) ?\n)
1314 (forward-char -1))
1315 (goto-char (1- (point-max)))))
1316 (if (and args (car args))
1317 (progn
1318 (or (bolp)
1319 (insert "\n"))
1320 (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
1321 (calc-graph-view-commands))
1322
1323 (defun calc-graph-command (cmd)
1324 (interactive "sGNUPLOT command: ")
1325 (calc-wrapper
1326 (calc-graph-init)
1327 (calc-graph-view-trail)
1328 (calc-gnuplot-command cmd)
1329 (accept-process-output)
1330 (calc-graph-view-trail)))
1331
1332 (defun calc-graph-kill (&optional no-view)
1333 (interactive)
1334 (calc-graph-delete-temps)
1335 (if (calc-gnuplot-alive)
1336 (calc-wrapper
1337 (or no-view (calc-graph-view-trail))
1338 (let ((calc-graph-no-wait t))
1339 (calc-gnuplot-command "exit"))
1340 (sit-for 1)
1341 (if (process-status calc-gnuplot-process)
1342 (delete-process calc-gnuplot-process))
1343 (setq calc-gnuplot-process nil))))
1344
1345 (defun calc-graph-quit ()
1346 (interactive)
1347 (if (get-buffer-window calc-gnuplot-input)
1348 (calc-graph-view-commands t))
1349 (if (get-buffer-window calc-gnuplot-buffer)
1350 (calc-graph-view-trail t))
1351 (calc-graph-kill t))
1352
1353 (defun calc-graph-view-commands (&optional no-need)
1354 (interactive "p")
1355 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1356 (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
1357
1358 (defun calc-graph-view-trail (&optional no-need)
1359 (interactive "p")
1360 (or calc-graph-no-auto-view (calc-graph-init-buffers))
1361 (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
1362
1363 (defun calc-graph-view (buf other-buf need)
1364 (let (win)
1365 (or calc-graph-no-auto-view
1366 (if (setq win (get-buffer-window buf))
1367 (or need
1368 (and (eq buf calc-gnuplot-buffer)
1369 (save-excursion
1370 (set-buffer buf)
1371 (not (pos-visible-in-window-p (point-max) win))))
1372 (progn
1373 (bury-buffer buf)
1374 (bury-buffer other-buf)
1375 (let ((curwin (selected-window)))
1376 (select-window win)
1377 (switch-to-buffer nil)
1378 (select-window curwin))))
1379 (if (setq win (get-buffer-window other-buf))
1380 (set-window-buffer win buf)
1381 (if (eq major-mode 'calc-mode)
1382 (if (or need
1383 (< (window-height) (1- (frame-height))))
1384 (display-buffer buf))
1385 (switch-to-buffer buf)))))
1386 (save-excursion
1387 (set-buffer buf)
1388 (if (and (eq buf calc-gnuplot-buffer)
1389 (setq win (get-buffer-window buf))
1390 (not (pos-visible-in-window-p (point-max) win)))
1391 (progn
1392 (goto-char (point-max))
1393 (vertical-motion (- 6 (window-height win)))
1394 (set-window-start win (point))
1395 (goto-char (point-max)))))
1396 (or calc-graph-no-auto-view (sit-for 0))))
1397
1398 (defun calc-gnuplot-check-for-errors ()
1399 (if (save-excursion
1400 (prog2
1401 (progn
1402 (set-buffer calc-gnuplot-buffer)
1403 (goto-char calc-gnuplot-last-error-pos))
1404 (re-search-forward "^[ \t]+\\^$" nil t)
1405 (goto-char (point-max))
1406 (setq calc-gnuplot-last-error-pos (point-max))))
1407 (calc-graph-view-trail)))
1408
1409 (defun calc-gnuplot-command (&rest args)
1410 (calc-graph-init)
1411 (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
1412 (accept-process-output)
1413 (save-excursion
1414 (set-buffer calc-gnuplot-buffer)
1415 (calc-gnuplot-check-for-errors)
1416 (goto-char (point-max))
1417 (setq calc-gnuplot-trail-mark (point))
1418 (or (>= calc-gnuplot-version 3)
1419 (insert cmd))
1420 (set-marker (process-mark calc-gnuplot-process) (point))
1421 (process-send-string calc-gnuplot-process cmd)
1422 (if (get-buffer-window calc-gnuplot-buffer)
1423 (calc-graph-view-trail))
1424 (accept-process-output (and (not calc-graph-no-wait)
1425 calc-gnuplot-process))
1426 (calc-gnuplot-check-for-errors)
1427 (if (get-buffer-window calc-gnuplot-buffer)
1428 (calc-graph-view-trail)))))
1429
1430 (defun calc-graph-init-buffers ()
1431 (or (and calc-gnuplot-buffer
1432 (buffer-name calc-gnuplot-buffer))
1433 (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
1434 (or (and calc-gnuplot-input
1435 (buffer-name calc-gnuplot-input))
1436 (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
1437
1438 (defun calc-graph-init ()
1439 (or (calc-gnuplot-alive)
1440 (let ((process-connection-type t)
1441 origin)
1442 (if calc-gnuplot-process
1443 (progn
1444 (delete-process calc-gnuplot-process)
1445 (setq calc-gnuplot-process nil)))
1446 (calc-graph-init-buffers)
1447 (save-excursion
1448 (set-buffer calc-gnuplot-buffer)
1449 (insert "\nStarting gnuplot...\n")
1450 (setq origin (point)))
1451 (setq calc-graph-last-device nil)
1452 (setq calc-graph-last-output nil)
1453 (condition-case err
1454 (let ((args (append (and calc-gnuplot-display
1455 (not (equal calc-gnuplot-display
1456 (getenv "DISPLAY")))
1457 (list "-display"
1458 calc-gnuplot-display))
1459 (and calc-gnuplot-geometry
1460 (list "-geometry"
1461 calc-gnuplot-geometry)))))
1462 (setq calc-gnuplot-process
1463 (apply 'start-process
1464 "gnuplot"
1465 calc-gnuplot-buffer
1466 calc-gnuplot-name
1467 args))
1468 (set-process-query-on-exit-flag calc-gnuplot-process nil))
1469 (file-error
1470 (error "Sorry, can't find \"%s\" on your system"
1471 calc-gnuplot-name)))
1472 (save-excursion
1473 (set-buffer calc-gnuplot-buffer)
1474 (while (and (not (save-excursion
1475 (goto-char origin)
1476 (search-forward "gnuplot> " nil t)))
1477 (memq (process-status calc-gnuplot-process) '(run stop)))
1478 (accept-process-output calc-gnuplot-process))
1479 (or (memq (process-status calc-gnuplot-process) '(run stop))
1480 (error "Unable to start GNUPLOT process"))
1481 (if (save-excursion
1482 (goto-char origin)
1483 (re-search-forward
1484 "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
1485 (setq calc-gnuplot-version (string-to-number (buffer-substring
1486 (match-beginning 1)
1487 (match-end 1))))
1488 (setq calc-gnuplot-version 1))
1489 (goto-char (point-max)))))
1490 (save-excursion
1491 (set-buffer calc-gnuplot-input)
1492 (if (= (buffer-size) 0)
1493 (insert "# Commands for running gnuplot\n\n\n")
1494 (or calc-graph-no-auto-view
1495 (eq (char-after (1- (point-max))) ?\n)
1496 (progn
1497 (goto-char (point-max))
1498 (insert "\n"))))))
1499
1500 (provide 'calc-graph)
1501
1502 ;;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2
1503 ;;; calc-graph.el ends here
Emacs repository mirror