blob: ced6be3a026e3c68e5256d54ce68e4ba332aa36c (
plain)
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
|
(define-module (fmt-stack)
#:export (get-attr
set-fg set-bg set-style
make-fmt-frame empty-fmt-frame
fmt-frame->ansi-esc)
#:use-module (control monad)
#:use-module (control monad state)
#:use-module (data optional)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu))
(define-immutable-record-type fmt-frame
(make-fmt-frame style fg bg)
fmt-frame?
(style get-style set-style)
(fg get-fg set-fg)
(bg get-bg set-bg))
(define (empty-fmt-frame)
(make-fmt-frame #f #f #f))
(define (fmt-frame->ansi-esc frame)
(string-append
"\x1b[m"
(case (get-fg frame)
((B) "\x1b[0;34m")
((Y) "\x1b[0;33m")
((C) "\x1b[0;36m")
(else ""))
(case (get-bg frame)
((B) "\x1b[44m")
((Y) "\x1b[43m")
((C) "\x1b[46m")
(else ""))
(case (get-style frame)
((underline) "\x1b[4m")
((italic) "\x1b[3m")
((bold) "\x1b[1m")
(else ""))))
(define (get-attr)
(do stack <- (get)
(return-state
(fmt-frame->ansi-esc
(make-fmt-frame
(get-style (find get-style stack))
(get-fg (find get-fg stack))
(get-bg (find get-bg stack)))))))
|
