-
Notifications
You must be signed in to change notification settings - Fork 1
/
swatch.ss
executable file
·193 lines (175 loc) · 14 KB
/
swatch.ss
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
#!/usr/bin/env mzscheme
#lang scheme
(require "main.ss")
; Helpers ----------------------------------------
; natural natural [style] -> range
(define (make-matrix width height [style empty-style])
(make-union (for*/list ([x (in-range 0 width)]
[y (in-range 0 height)])
(make-part (make-cell (format "~a,~a" x y) #:max-width 4) x y))
width height style))
; style
(define heading-style
(make-compiled-style #:font (make-font #:name "Trebuchet MS"
#:size 24
#:color (rgb 1 .5 0)
#:bold? #t)))
; Number formats ---------------------------------
; Fonts ------------------------------------------
; Fills ------------------------------------------
(define fill-sheet
(make-worksheet
"Fill"
(vl-append (make-cell "FILL TESTS" heading-style)
(apply ht-append
(make-cell "SOLID")
(let ([step 0.1])
(for/list ([r (in-range 0 1.01 step)])
(apply vc-append
(for/list ([g (in-range 0 1.01 step)])
(apply hc-append
(for/list ([b (in-range 0 1.01 step)])
(let* ([color (make-rgba-color r g b 1)]
[fill (make-solid-fill color)])
(make-cell (rgba-color-hex color)
(make-compiled-style #:fill fill))))))))))
(ht-append (make-cell "TODO: Patterns"))
(ht-append (make-cell "TODO: Linear gradients"))
(ht-append (make-cell "TODO: Path gradients")))))
; Borders ----------------------------------------
(define border-sheet
(make-worksheet
"Border"
(vl-append (make-cell "BORDER TESTS" heading-style)
(t-pad (apply ht-append
(make-cell "STYLES")
(for/list ([style (in-list border-styles)])
(l-pad (make-cell style (make-compiled-style #:border (make-border #:bottom (make-line style))))))))
(t-pad (ht-append (make-cell "SIDES")
(l-pad (make-cell "top" (make-compiled-style #:border (make-border #:top (make-line)))))
(l-pad (make-cell "right" (make-compiled-style #:border (make-border #:right (make-line)))))
(l-pad (make-cell "bottom" (make-compiled-style #:border (make-border #:bottom (make-line)))))
(l-pad (make-cell "left" (make-compiled-style #:border (make-border #:left (make-line)))))
(l-pad (make-cell "horizontal" (make-compiled-style #:border (make-border #:horizontal (make-line)))))
(l-pad (make-cell "vertical" (make-compiled-style #:border (make-border #:vertical (make-line)))))
(l-pad (make-cell "diagonal default" (make-compiled-style #:border (make-border #:diagonal (make-line)))))
(l-pad (make-cell "diagonal down" (make-compiled-style #:border (make-border #:diagonal (make-line)
#:diagonal-down? #t))))
(l-pad (make-cell "diagonal up" (make-compiled-style #:border (make-border #:diagonal (make-line)
#:diagonal-up? #t))))
(l-pad (make-cell "diagonal both" (make-compiled-style #:border (make-border #:diagonal (make-line)
#:diagonal-down? #t
#:diagonal-up? #t))))
(l-pad (make-cell "trbl" (make-compiled-style #:border (make-border #:top (make-line)
#:right (make-line)
#:bottom (make-line)
#:left (make-line)))))
(l-pad (make-cell "everything" (make-compiled-style #:border (make-border #:top (make-line)
#:right (make-line)
#:bottom (make-line)
#:left (make-line)
#:horizontal (make-line)
#:vertical (make-line)
#:diagonal (make-line)
#:diagonal-down? #t
#:diagonal-up? #t))))))
(t-pad (ht-append (make-cell "REGIONS")
(l-pad (vl-append "Default"
(outline-range (make-matrix 3 3))))
(l-pad (vl-append "Thick"
(outline-range (make-matrix 3 3)
(border-style thick))))
(l-pad (vl-append "Thick red"
(outline-range (make-matrix 3 3)
(border-style thick)
(rgb 1 0 0)))))))))
(define compound-sheet
(make-worksheet
"Compound"
(vl-append (make-cell "COMPOUND TESTS" heading-style)
(l-pad (t-pad (vl-append "Tabulate"
(t-pad (tabulate (make-matrix 10 20)
(make-matrix 10 1)
(make-matrix 1 20)))))))))
; Alignment --------------------------------------
(define alignment-sheet
(make-worksheet
"Alignment"
(vl-append (make-cell "ALIGNMENT TESTS" heading-style)
(ht-append (make-cell "HORIZONTAL")
(make-cell "General" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment general))))
(make-cell "Left" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment left))))
(make-cell "Right" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment right))))
(make-cell "Center" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment center))))
(make-cell "Center continuous" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment center-continuous))))
(make-cell "Distributed" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment distributed))))
(make-cell "Justify" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment justify))))
(make-cell "Fill" (make-compiled-style #:alignment (make-alignment #:horizontal (horizontal-alignment fill)))))
(ht-append (make-cell "VERTICAL")
(make-cell "Top" (make-compiled-style #:alignment (make-alignment #:vertical (vertical-alignment top))))
(make-cell "Bottom" (make-compiled-style #:alignment (make-alignment #:vertical (vertical-alignment bottom))))
(make-cell "Center" (make-compiled-style #:alignment (make-alignment #:vertical (vertical-alignment center))))
(make-cell "Distributed" (make-compiled-style #:alignment (make-alignment #:vertical (vertical-alignment distributed))))
(make-cell "Justify" (make-compiled-style #:alignment (make-alignment #:vertical (vertical-alignment justify)))))
(ht-append (make-cell "MIXED")
(apply hc-append (for/list ([h (in-list horizontal-alignments)])
(apply vc-append (for/list ([v (in-list vertical-alignments)])
(let* ([align (make-alignment #:horizontal h #:vertical v)]
[style (make-compiled-style #:alignment align)])
(make-cell (format "~a ~a" h v) style)))))))
(ht-append (make-cell "WRAP/SHRINK")
(make-cell "Wrapped: this is a very long cell value." (make-compiled-style #:alignment (make-alignment #:wrap? #t)))
(make-cell "Shrunk: this is a very long cell value." (make-compiled-style #:alignment (make-alignment #:shrink? #t))))
(apply ht-append
(make-cell "ANGLE")
(for/list ([a (in-range 0 181 45)])
(make-cell (format "Angle: ~a" a) (make-compiled-style #:alignment (make-alignment #:rotation a)))))
(apply ht-append
(make-cell "READING ORDER")
(for/list ([o (in-list reading-orders)])
(make-cell (format "Order: ~a" o) (make-compiled-style #:alignment (make-alignment #:reading-order o))))))))
; Conditional formatting -------------------------
(define conditional-format-sheet
(make-worksheet
"Conditional formatting"
(vl-append (make-cell "CONDITIONAL FORMATTING" heading-style)
(t-pad (vl-append (ht-append "Cell-is-style formatting"
(let ([cfs (list (cf< 0 (make-compiled-style #:fill (make-solid-fill (rgb 1 0 0))))
(cf= 0 (make-compiled-style #:fill (make-solid-fill (rgb 1 1 0))))
(cf> 0 (make-compiled-style #:fill (make-solid-fill (rgb 0 1 0)))))])
(l-pad (vl-append (make-cell -1 empty-style #:cf cfs)
(make-cell 0 empty-style #:cf cfs)
(make-cell +1 empty-style #:cf cfs)))))
#f
(ht-append "Expression-style formatting"
(let* ([src (make-cell 100)]
[cfs (list (cf (fx (= src 100)) (make-compiled-style #:fill (make-solid-fill (rgb 0 1 0)))))]
[des (make-cell "src=100?" empty-style #:cf cfs)])
(l-pad (vc-append src des))))
#f
(ht-append "Validation"
(let ([custom-validate
(lambda (style)
(validate (fx (= (!this) 100))
#:error-style style
#:error-title "Must be 100"
#:error-message "The value must be 100"
#:prompt-title "Must be 100"
#:prompt-message "The value must be 100"))])
(l-pad (vl-append (hc-append "Error" (make-cell 100 empty-style #:validate (custom-validate 'stop)))
(hc-append "Warning" (make-cell 100 empty-style #:validate (custom-validate 'warning)))
(hc-append "Info" (make-cell 100 empty-style #:validate (custom-validate 'information))))))))))))
(define split-sheet
(make-worksheet
"Split"
(make-matrix 10 10)
#:split (make-split (cons 3 3) (cons 5 5) #t)))
; Workbook ---------------------------------------
(write-workbook (make-workbook (list fill-sheet
border-sheet
alignment-sheet
compound-sheet
conditional-format-sheet
split-sheet))
(build-path (current-directory) "swatch.xlsx")
#:exists 'replace)