summaryrefslogtreecommitdiffstats
path: root/charplot.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:28 -0800
commit87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (patch)
tree1eb4f87abd38bea56e08335d939e8171d5e7bfc7 /charplot.scm
parentbd9733926076885e3417b74de76e4c9c7bc56254 (diff)
downloadslib-87b82b5822ca54228cfa6df29be3ad9d4bc47d16.tar.gz
slib-87b82b5822ca54228cfa6df29be3ad9d4bc47d16.zip
Import Upstream version 2d2upstream/2d2
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)