diff options
| author | James LewisMoss <dres@debian.org> | 2001-07-27 23:45:29 -0400 | 
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:29 -0800 | 
| commit | f559c149c83da84d0b1c285f0298c84aec564af9 (patch) | |
| tree | f1c91bcb9bb5e6dad87b643127c3f878d80d89ee /charplot.scm | |
| parent | c394920caedf3dac1981bb6b10eeb47fd6e4bb21 (diff) | |
| parent | 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff) | |
| download | slib-f559c149c83da84d0b1c285f0298c84aec564af9.tar.gz slib-f559c149c83da84d0b1c285f0298c84aec564af9.zip  | |
Import Debian changes 2d2-1debian/2d2-1
slib (2d2-1) unstable; urgency=low
  * New upstream version
  * Revert back to free.  Is now so.
slib (2d1-1) unstable; urgency=low
  * New upstream version.
  * Move to non-free.  FSF pointed out license doesn't allow modified
    versions to be distributed.
  * Get a complete list of copyrights that apply to the source into
    copyright file.
  * Remove setup for guile 1.3.
  * Remove postrm.  Just calling install-info (lintian)  Move install-info
    call to prerm since doc-base doesn't do install-info.
slib (2c9-3) unstable; urgency=low
  * Change info location to section "The Algorithmic Language Scheme" to
    match up with where guile puts it's files.
  * Postinst is running slibconfig now.  (Closes: #75891)
slib (2c9-2) unstable; urgency=low
  * Stop installing slibconfig (for guile).
  * In postinst if /usr/sbin/slibconnfig exists call it (Close: #75843
    #75891).
slib (2c9-1) unstable; urgency=low
  * New upstream (Closes: #74760)
  * replace string-index with strsrch:string-index in http-cgi.scm.
  * Add doc-base support (Closes: #31163)
Diffstat (limited to 'charplot.scm')
| -rw-r--r-- | charplot.scm | 65 | 
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)  | 
