1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
#lang racket/base
(require racket/contract racket/draw racket/class unstable/contract unstable/latent-contract
unstable/latent-contract/defthing)
(provide (except-out (all-defined-out)
maybe-function/c maybe-apply
plot-colors/c pen-widths/c plot-pen-styles/c plot-brush-styles/c alphas/c
labels/c)
(activate-contract-out
maybe-function/c maybe-apply
plot-colors/c pen-widths/c plot-pen-styles/c plot-brush-styles/c alphas/c
labels/c)
(rename-out [natural-number/c nat/c])
font-family/c
truth/c)
;; ===================================================================================================
;; Plot-specific contracts
(defcontract anchor/c (one-of/c 'top-left 'top 'top-right
'left 'center 'right
'bottom-left 'bottom 'bottom-right))
(defcontract color/c (or/c (list/c real? real? real?)
string? symbol?
(is-a?/c color%)))
(defcontract plot-color/c (or/c exact-integer? color/c))
(defcontract plot-pen-style/c (or/c exact-integer?
(one-of/c 'transparent 'solid 'dot 'long-dash
'short-dash 'dot-dash)))
(defcontract plot-brush-style/c (or/c exact-integer?
(one-of/c 'transparent 'solid
'bdiagonal-hatch 'fdiagonal-hatch 'crossdiag-hatch
'horizontal-hatch 'vertical-hatch 'cross-hatch)))
(defthing known-point-symbols (listof symbol?) #:document-value
(list 'dot 'point 'pixel
'plus 'times 'asterisk
'5asterisk 'odot 'oplus
'otimes 'oasterisk 'o5asterisk
'circle 'square 'diamond
'triangle 'fullcircle 'fullsquare
'fulldiamond 'fulltriangle 'triangleup
'triangledown 'triangleleft 'triangleright
'fulltriangleup 'fulltriangledown 'fulltriangleleft
'fulltriangleright 'rightarrow 'leftarrow
'uparrow 'downarrow '4star
'5star '6star '7star
'8star 'full4star 'full5star
'full6star 'full7star 'full8star
'circle1 'circle2 'circle3
'circle4 'circle5 'circle6
'circle7 'circle8 'bullet
'fullcircle1 'fullcircle2 'fullcircle3
'fullcircle4 'fullcircle5 'fullcircle6
'fullcircle7 'fullcircle8))
(defcontract point-sym/c (or/c char? string? integer? (apply one-of/c known-point-symbols)))
(defcontract (maybe-function/c [in-contract contract?] [out-contract contract?])
(or/c out-contract (in-contract . -> . out-contract)))
(defproc (maybe-apply [f (maybe-function/c any/c any/c)]
[arg any/c]) any/c
(cond [(procedure? f) (f arg)]
[else f]))
(defcontract (plot-colors/c [in-contract contract?])
(maybe-function/c in-contract (listof plot-color/c)))
(defcontract (pen-widths/c [in-contract contract?])
(maybe-function/c in-contract (listof (>=/c 0))))
(defcontract (plot-pen-styles/c [in-contract contract?])
(maybe-function/c in-contract (listof plot-pen-style/c)))
(defcontract (plot-brush-styles/c [in-contract contract?])
(maybe-function/c in-contract (listof plot-brush-style/c)))
(defcontract (alphas/c [in-contract contract?])
(maybe-function/c in-contract (listof (real-in 0 1))))
(defcontract (labels/c [in-contract contract?])
(maybe-function/c in-contract (listof (or/c string? #f))))
|
