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

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

use original name

File size: 3.4 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
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(: plot (or (plotdata string string #!optional boolean -> void)
58            ((number -> float) number number #!optional fixnum -> void)))
59
60(: histograph (histdata string -> void))
61
62;;
63
64(include "slib-compat")
65
66(include "charplot")
67
68;; Parameters (replacements for SLIB graph part globals)
69
70(define plot-dimensions (make-parameter charplot:dimensions (lambda (x)
71  (cond
72    ((not x) x)
73    ((and (list? x) (<= (length x) 2)) x)
74    (else
75      (warning 'plot-dimensions "not a list (H W)")
76      (plot-dimensions) ) ) ) ) )
77
78(define plot-left-margin (make-parameter charplot:left-margin (lambda (x)
79  (cond
80    ((not x) 2)
81    ((and (exact? x) (integer? x) (<= 2 x)) x)
82    (else
83      (warning 'plot-left-margin "not an exact-integer of at least 2")
84      (plot-left-margin) ) ) ) ) )
85
86(define-syntax char-warning-predicate
87  (syntax-rules ()
88    ((char-warning-predicate ?loc ?def)
89      (lambda (x)
90        (cond
91          ((not x) ?def)
92          ((char? x) x)
93          (else
94            (warning '?loc "not a character")
95            (?loc) ) ) ) ) ) )
96
97(define xborder-char (make-parameter #f (char-warning-predicate xborder-char char:xborder)))
98(define yborder-char (make-parameter #f (char-warning-predicate yborder-char char:yborder)))
99(define xaxis-char   (make-parameter #f (char-warning-predicate xaxis-char char:xaxis)))
100(define yaxis-char   (make-parameter #f (char-warning-predicate yaxis-char char:yaxis)))
101(define xtick-char   (make-parameter #f (char-warning-predicate xtick-char char:xtick)))
102(define bar-char     (make-parameter #f (char-warning-predicate bar-char char:bar)))
103
104(define curves-chars (make-parameter #f (lambda (x)
105  (cond
106    ((not x) char:curves)
107    ((and (string? x) (<= 1 (string-length x))) x)
108    (else
109      (warning 'curves-chars "not a string of at least length 1")
110      (curves-chars) ) ) ) ) )
111
112) ;module slib-charplot
Note: See TracBrowser for help on using the repository browser.