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