From 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:34 -0800
Subject: Import Upstream version 3a3

---
 grapheps.scm | 53 ++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 40 insertions(+), 13 deletions(-)

(limited to 'grapheps.scm')

diff --git a/grapheps.scm b/grapheps.scm
index 677ae34..d64262f 100644
--- a/grapheps.scm
+++ b/grapheps.scm
@@ -477,22 +477,42 @@
 		      idx 1))))
   (create-postscript-graph
    tmp (or graph:dimensions '(600 300))
-   (whole-page) (setup-plot (column-range data 0) (column-range data 1))
+   (whole-page)
+   (setup-plot (column-range data 0)
+	       (apply combine-ranges
+		      (do ((idx (+ -1 (cadr (array-dimensions data))) (+ -1 idx))
+			   (lst '() (cons (column-range data idx) lst)))
+			  ((< idx 1) lst))))
    (outline-rect plotrect)
    (x-axis) (y-axis)
-   (plot-column data 0 1 (if histogram? 'bargraph 'line))
+   (do ((idx (+ -1 (cadr (array-dimensions data))) (+ -1 idx))
+	(lst '() (cons 
+		  (plot-column data 0 idx (if histogram? 'bargraph 'line))
+		  lst)))
+       ((< idx 1) lst))
    (rule-vertical leftedge ylabel 10)
    (rule-horizontal bottomedge xlabel 10)))
 
-(define (graph:plot-function tmp func vlo vhi . npts)
-  (set! npts (if (null? npts) 200 (car npts)))
-  (let ((dats (make-array (A:floR64b) npts 2)))
-    (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts)
+(define (functions->array vlo vhi npts . funcs)
+  (let ((dats (make-array (A:floR32b) npts (+ 1 (length funcs)))))
+    (define jdx 1)
+    (array-index-map! (make-shared-array dats
+					 (lambda (idx) (list idx 0))
+					 npts)
 		      (lambda (idx)
 			(+ vlo (* (- vhi vlo) (/ idx (+ -1 npts))))))
-    (array-map! (make-shared-array dats (lambda (idx) (list idx 1)) npts)
-		func
-		(make-shared-array dats (lambda (idx) (list idx 0)) npts))
+    (for-each (lambda (func)
+		(array-map!
+		 (make-shared-array dats (lambda (idx) (list idx jdx)) npts)
+		 func
+		 (make-shared-array dats (lambda (idx) (list idx 0)) npts))
+		(set! jdx (+ 1 jdx)))
+	      funcs)
+    dats))
+
+(define (graph:plot-function tmp func vlo vhi . npts)
+  (set! npts (if (null? npts) 200 (car npts)))
+  (let ((dats (functions->array vlo vhi npts func)))
     (graph:plot tmp dats "" "")))
 
 ;;@body
@@ -507,6 +527,11 @@
 ;;over the range @2 to @3.  If the optional integer argument @4 is
 ;;supplied, it specifies the number of points to evaluate @1 at.
 ;;
+;;@defunx x1 x2 npts func1 func2 ...
+;;Creates and displays an encapsulated PostScript graph of the
+;;one-argument functions @var{func1}, @var{func2}, ... over the range
+;;@var{x1} to @var{x2} at @var{npts} points.
+;;
 ;;@defunx plot coords x-label y-label
 ;;@var{coords} is a list or vector of coordinates, lists of x and y
 ;;coordinates.  @var{x-label} and @var{y-label} are strings with which
@@ -514,13 +539,15 @@
 (define (plot . args)
   (call-with-tmpnam
    (lambda (tmp)
-     (if (procedure? (car args))
-	 (apply graph:plot-function tmp args)
-	 (apply graph:plot tmp args))
+     (cond ((procedure? (car args))
+	    (apply graph:plot-function tmp args))
+	   ((array? (car args))
+	    (apply graph:plot tmp args))
+	   (else (let ((dats (apply functions->array args)))
+		   (graph:plot tmp dats "" ""))))
      (system (string-append "gv '" tmp "'")))
    ".eps"))
 
-
 ;;@node Example Graph,  , Legacy Plotting, PostScript Graphing
 ;;@subsubsection Example Graph
 
-- 
cgit v1.2.3