source: project/release/5/slib-charplot/trunk/slib-charplot.scm @ 38724

Last change on this file since 38724 was 38724, checked in by Kon Lovett, 6 months ago

common local binding

File size: 3.8 KB
Line 
1;;;; slib-charplot.scm
2;;;; Kon Lovett, Mar '20
3
4(module slib-charplot
5
6(;export
7  plot-dimensions
8  plot-left-margin
9  xborder-char
10  yborder-char
11  xaxis-char
12  yaxis-char
13  xtick-char
14  bar-char
15  curves-chars
16  histograph
17  plot)
18
19(import scheme)
20(import (chicken module))
21(import (only (chicken base)
22  include
23  let-values let-optionals
24  error identity
25  warning make-parameter))
26(import (chicken type))
27(import (only (chicken port) terminal-size))
28(import (only (chicken platform) features))
29(import (only (chicken keyword) string->keyword))
30(import (only (srfi 1) last-pair))
31(import (srfi 63))
32(import slib-arraymap)
33;FIXME chicken-install has the feature but after that ...
34(cond-expand (utf8 (import utf8) (warning "Using utf8 Extension")) (else))
35
36;; Types
37
38(define-type array-strict (struct array))                     ;SRFI 63
39(define-type array (or string vector array-strict))
40
41(define-type plotdims (list fixnum fixnum))                   ;(H W)
42(define-type plotdata (or vector list array-strict))          ;Nd elms
43(define-type histdata (or (vector number) (list number)))     ;1d elms
44
45(: plot-dimensions (#!optional (or boolean plotdims) -> (or boolean plotdims)))
46(: plot-left-margin (#!optional (or boolean fixnum) -> fixnum))
47
48(: xborder-char (#!optional (or boolean char) -> char))
49(: yborder-char (#!optional (or boolean char) -> char))
50(: xaxis-char (#!optional (or boolean char) -> char))
51(: yaxis-char (#!optional (or boolean char) -> char))
52(: xtick-char (#!optional (or boolean char) -> char))
53(: bar-char (#!optional (or boolean char) -> char))
54
55(: curves-chars (#!optional (or boolean string) -> string))
56
57;only works due to slib plot . args (?)
58(: plot (or (plotdata #!optional string string boolean -> void)
59            ((number -> float) #!optional number number fixnum -> void)))
60
61(: histograph (histdata string -> void))
62
63;;
64
65(include "slib-compat")
66
67(include "charplot")
68
69;;
70
71;optional axis labels
72(define slib:plot plot)
73(set! plot
74  (lambda (data . args)
75    (if (procedure? data)
76      (let-optionals args ((lo 0) (hi 1) (npts 64))
77        (slib:plot data lo hi npts))
78      (let-optionals args ((xaxis "") (yaxis "") (histogram? #f))
79        (slib:plot data xaxis yaxis histogram?)))))
80
81;; Parameters (replacements for SLIB graph part globals)
82
83(define plot-dimensions (make-parameter charplot:dimensions (lambda (x)
84  (cond
85    ((not x) x)
86    ((and (list? x) (<= (length x) 2)) x)
87    (else
88      (warning 'plot-dimensions "not a list (H W)")
89      (plot-dimensions) ) ) ) ) )
90
91(define plot-left-margin (make-parameter charplot:left-margin (lambda (x)
92  (cond
93    ((not x) 2)
94    ((and (exact? x) (integer? x) (<= 2 x)) x)
95    (else
96      (warning 'plot-left-margin "not an exact-integer of at least 2")
97      (plot-left-margin) ) ) ) ) )
98
99(define-syntax char-warning-predicate
100  (syntax-rules ()
101    ((char-warning-predicate ?loc ?def)
102      (lambda (x)
103        (cond
104          ((not x) ?def)
105          ((char? x) x)
106          (else
107            (warning '?loc "not a character")
108            (?loc) ) ) ) ) ) )
109
110(define xborder-char (make-parameter #f (char-warning-predicate xborder-char char:xborder)))
111(define yborder-char (make-parameter #f (char-warning-predicate yborder-char char:yborder)))
112(define xaxis-char   (make-parameter #f (char-warning-predicate xaxis-char char:xaxis)))
113(define yaxis-char   (make-parameter #f (char-warning-predicate yaxis-char char:yaxis)))
114(define xtick-char   (make-parameter #f (char-warning-predicate xtick-char char:xtick)))
115(define bar-char     (make-parameter #f (char-warning-predicate bar-char char:bar)))
116
117(define curves-chars (make-parameter #f (lambda (x)
118  (cond
119    ((not x) char:curves)
120    ((and (string? x) (<= 1 (string-length x))) x)
121    (else
122      (warning 'curves-chars "not a string of at least length 1")
123      (curves-chars) ) ) ) ) )
124
125) ;module slib-charplot
Note: See TracBrowser for help on using the repository browser.