-
Notifications
You must be signed in to change notification settings - Fork 12
Expand file tree
/
Copy pathplotter-styles.lisp
More file actions
114 lines (103 loc) · 6.5 KB
/
plotter-styles.lisp
File metadata and controls
114 lines (103 loc) · 6.5 KB
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
;; plotter-styles.lisp -- Normalize the various keyword options
;;
;; DM/RAL 02/24
;; ----------------------------------------------------------------
(in-package :plotter)
;; ----------------------------------------------------------------
;; Take in the various keyword options and produce a summary
;; PLOT-STYLE containing a LINE-STYLE, SYMBOL-STYLE, and LEGEND
;; struct.
(defun get-plot-style (&key
(color #.(color:make-rgb 0.0 0.5 0.0))
(line-color color)
alpha
(line-alpha alpha)
thick
(linewidth (or thick 1))
(line-thick linewidth)
line-dashing
(line-type :interpolated)
symbol
symbol-for-legend
plot-joined
(border-color color)
(border-alpha alpha)
symbol-filled
(fill-color color)
(fill-alpha alpha)
(border-thick linewidth)
bar-width
bar-offset
legend
plot-style
line-style
symbol-style
&allow-other-keys)
(setf symbol (or symbol symbol-for-legend))
(cond ((consp plot-style)
(let ((line-style (getf plot-style :line-style))
(symbol-style (getf plot-style :symbol-style))
(legend (or legend
(getf plot-style :legend))))
(make-instance 'plot-style
:line-style (and line-style
(apply 'make-instance 'line-style line-style))
:symbol-style (and symbol-style
(apply 'make-instance 'symbol-style symbol-style))
:legend (and legend
(plusp (length legend))
legend)
)))
(plot-style)
(t
(let ((sym (or symbol
(and symbol-style
(or (and (consp symbol-style)
(getf symbol-style :symbol))
(plot-symbol symbol-style))))))
(make-instance 'plot-style
:line-style (cond ((consp line-style)
(apply 'make-instance 'line-styleline-style))
(line-style)
((or (null sym)
(eq sym :sampled-data)
plot-joined)
(make-instance 'line-style
:thick line-thick
:dashing line-dashing
:color line-color
:alpha line-alpha
:type line-type)))
:symbol-style (cond ((consp symbol-style)
(apply 'make-instance 'symbol-style symbol-style))
(symbol-style)
(symbol
(make-instance 'symbol-style
:symbol (case symbol
(:filled-circle :circle)
((:filled-square :filled-box) :square)
((:filled-triangle :filled-up-triangle) :up-triangle)
(:filled-down-triangle :down-triangle)
(otherwise symbol))
:fill-color (or fill-color
(and (or symbol-filled
(member symbol
'(:filled-circle
:sampled-data
:filled-square
:filled-box
:filled-triangle
:filled-up-triangle
:filled-down-triangle)))
color))
:fill-alpha fill-alpha
:border-color border-color
:border-alpha border-alpha
:border-thick border-thick
:bar-width bar-width
:bar-offset bar-offset)))
:legend (and legend
(plusp (length legend))
legend)
)))
))