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#lang racket/base
(require racket/contract
racket/match)
(provide
make-color
make-gray
colorize)
(define color-axis/c
(integer-in 0 6))
(define/contract (make-color r g b)
(-> color-axis/c color-axis/c color-axis/c (integer-in 16 232))
(+ 16 (* 36 r) (* 6 g) b))
(define/contract (make-gray pct)
(-> (real-in 0 1) (integer-in 232 256))
(inexact->exact (+ 232 (* pct 24))))
(define (bg color)
(display "\e[48;5;")
(display color)
(display "m"))
(define (fg color)
(display "\e[38;5;")
(display color)
(display "m"))
(define (color spec [out (current-output-port)])
(parameterize ([current-output-port out])
(for ([pair (in-list spec)])
(match pair
[(list 'fg color) (fg color)]
[(list 'bg color) (bg color)]))))
(define (reset [out (current-output-port)])
(display #"\e[0m" out))
(define (call-with-colorized-output spec proc)
(dynamic-wind
(lambda _ (color spec))
(lambda _ (proc))
(lambda _ (reset))))
(define-syntax-rule (colorize spec body0 body ...)
(call-with-colorized-output spec (lambda _ body0 body ...)))
(module+ test
(require racket/port
rackunit)
(check-equal?
(with-output-to-string
(lambda _
(colorize
`((fg ,(make-color 5 0 0)))
(display "hello!"))))
"\e[38;5;196mhello!\e[0m")
(check-equal?
(with-output-to-string
(lambda _
(colorize
`((fg ,(make-color 5 0 0))
(bg ,(make-color 5 5 5)))
(display "hello!"))))
"\e[38;5;196m\e[48;5;231mhello!\e[0m"))