summaryrefslogtreecommitdiffstats
path: root/charplot.scm
diff options
context:
space:
mode:
authorJames LewisMoss <dres@debian.org>2001-07-27 23:45:29 -0400
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commitf559c149c83da84d0b1c285f0298c84aec564af9 (patch)
treef1c91bcb9bb5e6dad87b643127c3f878d80d89ee /charplot.scm
parentc394920caedf3dac1981bb6b10eeb47fd6e4bb21 (diff)
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-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.scm65
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)