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) |