diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2006-04-26 23:08:39 -0700 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:34 -0800 |
commit | 0aec178b52e42086df31cc52558bba0ef22b8439 (patch) | |
tree | 6e58dcbfcaf56e5d6595f5d6fb7e83810bf8d760 /grapheps.scm | |
parent | ff9cb66fee88a090869a2fb452ad49d858fe3b0c (diff) | |
parent | 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (diff) | |
download | slib-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.scm | 53 |
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 |