summaryrefslogtreecommitdiff
path: root/irc/fancy.rkt
blob: ad9e6693ddfd2b715c51a45aafb597c9be444675 (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
#lang racket/base
(require racket/format)
(provide clear fg bg col bold italic underline)

(define colors
  '((white  "00")
    (black  "01")
    (blue   "02")
    (green  "03")
    (red    "04")
    (brown  "05")
    (purple "06")
    (orange "07")
    (yellow "08")
    (lime   "09")
    (teal   "10")
    (lcyan  "11")
    (lblue  "12")
    (pink   "13")
    (grey   "14")
    (lgrey  "15")
    (transp "99")))

(define (clear . args)
  (string-append "\x0F" (apply string-append (map ~a args)) "\x0F"))

(define (fg f . args)
  (let ([col (cond [(symbol? f)
                    (let ([l (cadr (assv f colors))])
                      (if l l (raise (list "color " f " is invalid"))))]
                   [else (~a f)])])
    (string-append "\x03" col (apply string-append (map ~a args)) "\x03")))

(define (bg b . args)
  (let ([col (cond [(symbol? b)
                    (let ([l (cadr (assv b colors))])
                      (if l l (raise (list "color " b " is invalid"))))]
                   [else (~a b)])])
    (string-append "\x03," col (apply string-append (map ~a args)) "\x03")))

(define (col f b . args)
  (string-append "\x03"
    (cadr (assv f colors)) "," (cadr (assv b colors))
    (apply string-append (map ~a args)) "\x03"))

(define (bold . args)
  (string-append "\x02" (apply string-append (map ~a args)) "\x02"))

(define (italic . args)
  (string-append "\x1D" (apply string-append (map ~a args)) "\x1D"))

(define (underline . args)
  (string-append "\x1F" (apply string-append (map ~a args)) "\x1F"))