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

Last change on this file since 40050 was 40050, checked in by Kon Lovett, 8 weeks ago

use include-relative, remove useless random wrapper in test

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