summaryrefslogtreecommitdiffstats
path: root/grapheps.scm
diff options
context:
space:
mode:
authorThomas Bushnell, BSG <tb@debian.org>2006-04-26 23:08:39 -0700
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:34 -0800
commit0aec178b52e42086df31cc52558bba0ef22b8439 (patch)
tree6e58dcbfcaf56e5d6595f5d6fb7e83810bf8d760 /grapheps.scm
parentff9cb66fee88a090869a2fb452ad49d858fe3b0c (diff)
parent237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff)
downloadslib-0aec178b52e42086df31cc52558bba0ef22b8439.tar.gz
slib-0aec178b52e42086df31cc52558bba0ef22b8439.zip
Import Debian changes 3a3-1debian/3a3-1
slib (3a3-1) unstable; urgency=low * New upstream release. Change to guile.init for module correctness (from 3a2-5) is now in upstream. We'll drop the path-search misfeature at this point, and stick to upstream's version, unless this causes actual difficulties. * Makefile: Repeat $(htmldir)slib_toc.html changes from 3a2-1. * debian/postinst: Fix typos in comments. (Closes: #337571)
Diffstat (limited to 'grapheps.scm')
-rw-r--r--grapheps.scm53
1 files changed, 40 insertions, 13 deletions
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