Initial commit

1 files changed, 53 insertions, 0 deletions

diff --git a/irc/fancy.rkt b/irc/fancy.rkt
new file mode 100644
index 0000000..362ce74
--- /dev/null
+++ b/irc/fancy.rkt
@@ -0,0 +1,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)) "," (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"))