Import Upstream version 2d2upstream/2d2

1 files changed, 38 insertions, 27 deletions

diff --git a/charplot.scm b/charplot.scm
index 2c64615..3e0e019 100644
--- a/charplot.scm
+++ b/charplot.scm
@@ -1,9 +1,9 @@
 ;;;; "charplot.scm", plotting on character devices for Scheme
-;;; Copyright (C) 1992, 1993 Aubrey Jaffer.
+;;; Copyright (C) 1992, 1993 Aubrey Jaffer
 ;
-;Permission to copy this software, to redistribute it, and to use it
-;for any purpose is granted, subject to the following restrictions and
-;understandings.
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
 ;
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
@@ -19,6 +19,8 @@
 
 (require 'sort)
 (require 'printf)
+(require 'array)
+(require 'array-for-each)
 
 (define charplot:rows 24)
 (define charplot:columns (output-port-width (current-output-port)))
@@ -47,31 +49,33 @@
 (define (charplot:number->string x)
   (sprintf #f "%g" x))
 
-(define (scale-it z scale)
+(define (charplot:scale-it z scale)
   (if (and (exact? z) (integer? z))
       (quotient (* z (car scale)) (cadr scale))
       (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
 
-(define (find-scale isize delta)
-  (if (inexact? delta) (set! isize (exact->inexact isize)))
+(define (charplot:find-scale isize delta)
+  (define (fs2)
+    (cond ((< (* delta 8) isize) 8)
+	  ((< (* delta 6) isize) 6)
+	  ((< (* delta 5) isize) 5)
+	  ((< (* delta 4) isize) 4)
+	  ((< (* delta 3) isize) 3)
+	  ((< (* delta 2) isize) 2)
+	  (else 1)))
+  (cond ((zero? delta) (set! delta 1))
+	((inexact? delta) (set! isize (exact->inexact isize))))
   (do ((d 1 (* d 10)))
       ((<= delta isize)
        (do ((n 1 (* n 10)))
 	   ((>= (* delta 10) isize)
-	    (list (* n (cond ((< (* delta 8) isize) 8)
-			     ((< (* delta 6) isize) 6)
-			     ((< (* delta 5) isize) 5)
-			     ((< (* delta 4) isize) 4)
-			     ((< (* delta 3) isize) 3)
-			     ((< (* delta 2) isize) 2)
-			     (else 1)))
-		  d))
+	    (list (* n (fs2)) d))
 	 (set! delta (* delta 10))))
     (set! isize (* isize 10))))
 
 (define (charplot:iplot! data xlabel ylabel xmin xscale ymin yscale)
-  (define xaxis (- (scale-it ymin yscale)))
-  (define yaxis (- (scale-it xmin xscale)))
+  (define xaxis (- (charplot:scale-it ymin yscale)))
+  (define yaxis (- (charplot:scale-it xmin xscale)))
   (charplot:center-print! ylabel 11)
   (charplot:printn! (+ charplot:width 1) charplot:xborder)
   (newline)
@@ -122,7 +126,7 @@
     (display charplot:yborder) (newline)
     (charplot:center-print! xlabel (+ 12 fudge (- xstep/2)))
     (do ((i fudge (+ i xstep)))
-	((> (+ i xstep) charplot:width))
+	((>= i charplot:width))
       (charplot:center-print! (charplot:number->string
 			       (/ (* (- i yaxis) (cadr xscale))
 				  (car xscale)))
@@ -131,23 +135,30 @@
 
 (define (charplot:plot! data xlabel ylabel)
   (cond ((array? data)
-	 (set! data (map (lambda (lst) (cons (car lst) (cadr lst)))
-			 (array->list data)))))
+	 (case (array-rank data)
+	   ((1) (set! data (map cons
+				(let ((ra (apply make-array #f
+						 (array-shape data))))
+				  (array-index-map! ra identity)
+				  (array->list ra))
+				(array->list data))))
+	   ((2) (set! data (map (lambda (lst) (cons (car lst) (cadr lst)))
+				(array->list data)))))))
   (let* ((xmax (apply max (map car data)))
 	 (xmin (apply min (map car data)))
-	 (xscale (find-scale charplot:width (- xmax xmin)))
+	 (xscale (charplot:find-scale charplot:width (- xmax xmin)))
 	 (ymax (apply max (map cdr data)))
 	 (ymin (apply min (map cdr data)))
-	 (yscale (find-scale charplot:height (- ymax ymin)))
-	 (ixmin (scale-it xmin xscale))
-	 (iymin (scale-it ymin yscale)))
+	 (yscale (charplot:find-scale charplot:height (- ymax ymin)))
+	 (ixmin (charplot:scale-it xmin xscale))
+	 (iymin (charplot:scale-it ymin yscale)))
     (charplot:iplot! (map (lambda (p)
-			    (cons (- (scale-it (car p) xscale) ixmin)
-				  (- (scale-it (cdr p) yscale) iymin)))
+			    (cons (- (charplot:scale-it (car p) xscale) ixmin)
+				  (- (charplot:scale-it (cdr p) yscale) iymin)))
 			  data)
 		     xlabel ylabel xmin xscale ymin yscale)))
 
-(define (plot-function func vlo vhi . npts)
+(define (plot-function! func vlo vhi . npts)
   (set! npts (if (null? npts) 100 (car npts)))
   (let ((dats (make-array 0.0 npts 2)))
     (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts)