From 39344bcaa05cb47ea5f7a899ba4ea16f4997d93d Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Fri, 3 Jul 2020 10:42:11 +0900
Subject: [PATCH] adding background colors, as-italic

---
 lib/srfi/166.sld       |  5 ++++-
 lib/srfi/166/color.scm | 38 ++++++++++++++++++++++++++++++++------
 lib/srfi/166/color.sld | 15 +++++++++++----
 3 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/lib/srfi/166.sld b/lib/srfi/166.sld
index 11fc1576..c29497a6 100644
--- a/lib/srfi/166.sld
+++ b/lib/srfi/166.sld
@@ -31,6 +31,9 @@
    ;; color
    as-red as-blue as-green as-cyan as-yellow
    as-magenta as-white as-black
-   as-bold as-underline
+   as-bold as-italic as-underline
    as-color as-true-color
+   on-red on-blue on-green on-cyan on-yellow
+   on-magenta on-white on-black
+   on-color on-true-color
    ))
diff --git a/lib/srfi/166/color.scm b/lib/srfi/166/color.scm
index 6d919363..c20a5f62 100644
--- a/lib/srfi/166/color.scm
+++ b/lib/srfi/166/color.scm
@@ -6,6 +6,7 @@
   (case x
     ((bold) "1")
     ((dark) "2")
+    ((italic) "3")
     ((underline) "4")
     ((black) "30")
     ((red) "31")
@@ -16,6 +17,15 @@
     ((cyan) "36")
     ((white) "37")
     ((reset) "39")
+    ((on-black) "40")
+    ((on-red) "41")
+    ((on-green) "42")
+    ((on-yellow) "43")
+    ((on-blue) "44")
+    ((on-magenta) "45")
+    ((on-cyan) "46")
+    ((on-white) "47")
+    ((on-reset) "49")
     (else "0")))
 
 (define (ansi-escape color)
@@ -43,9 +53,19 @@
 (define (as-white . args) (colored 'white (each-in-list args)))
 (define (as-black . args) (colored 'black (each-in-list args)))
 (define (as-bold . args) (colored 'bold (each-in-list args)))
+(define (as-italic . args) (colored 'italic (each-in-list args)))
 (define (as-underline . args) (colored 'underline (each-in-list args)))
 
-(define (rgb-escape red-level green-level blue-level)
+(define (on-red . args) (colored 'on-red (each-in-list args)))
+(define (on-blue . args) (colored 'on-blue (each-in-list args)))
+(define (on-green . args) (colored 'on-green (each-in-list args)))
+(define (on-cyan . args) (colored 'on-cyan (each-in-list args)))
+(define (on-yellow . args) (colored 'on-yellow (each-in-list args)))
+(define (on-magenta . args) (colored 'on-magenta (each-in-list args)))
+(define (on-white . args) (colored 'on-white (each-in-list args)))
+(define (on-black . args) (colored 'on-black (each-in-list args)))
+
+(define (rgb-escape red-level green-level blue-level bg?)
   (when (not (and (exact-integer? red-level) (<= 0 red-level 5)))
     (error "invalid red-level value" red-level))
   (when (not (and (exact-integer? green-level) (<= 0 green-level 5)))
@@ -53,11 +73,11 @@
   (when (not (and (exact-integer? blue-level) (<= 0 blue-level 5)))
     (error "invalid blue-level value" blue-level))
   (string-append
-   "\x1B;[38;5;"
+   (if bg? "\x1B;[48;5;" "\x1B;[38;5;")
    (number->string (+ (* 36 red-level) (* 6 green-level) blue-level 16))
    "m"))
 
-(define (rgb24-escape red-level green-level blue-level)
+(define (rgb24-escape red-level green-level blue-level bg?)
   (when (not (and (exact-integer? red-level) (<= 0 red-level 255)))
     (error "invalid red-level value" red-level))
   (when (not (and (exact-integer? green-level) (<= 0 green-level 255)))
@@ -65,14 +85,20 @@
   (when (not (and (exact-integer? blue-level) (<= 0 blue-level 255)))
     (error "invalid blue-level value" blue-level))
   (string-append
-   "\x1B;[38;2;"
+   (if bg? "\x1B;[48;2;" "\x1B;[38;2;")
    (number->string red-level) ";"
    (number->string green-level) ";"
    (number->string blue-level)
    "m"))
 
 (define (as-color red green blue . fmt)
-  (colored (rgb-escape red green blue) (each-in-list fmt)))
+  (colored (rgb-escape red green blue #f) (each-in-list fmt)))
 
 (define (as-true-color red green blue . fmt)
-  (colored (rgb24-escape red green blue) (each-in-list fmt)))
+  (colored (rgb24-escape red green blue #f) (each-in-list fmt)))
+
+(define (on-color red green blue . fmt)
+  (colored (rgb-escape red green blue #t) (each-in-list fmt)))
+
+(define (on-true-color red green blue . fmt)
+  (colored (rgb24-escape red green blue #t) (each-in-list fmt)))
diff --git a/lib/srfi/166/color.sld b/lib/srfi/166/color.sld
index 8448a6bb..98cda3b5 100644
--- a/lib/srfi/166/color.sld
+++ b/lib/srfi/166/color.sld
@@ -1,10 +1,17 @@
 
 (define-library (srfi 166 color)
   (import (scheme base) (srfi 130) (srfi 165) (srfi 166 base))
-  (export as-red as-blue as-green as-cyan as-yellow
-          as-magenta as-white as-black
-          as-bold as-underline
-          as-color as-true-color)
+  (export
+   ;; foreground
+   as-red as-blue as-green as-cyan as-yellow
+   as-magenta as-white as-black
+   as-bold as-italic as-underline
+   as-color as-true-color
+   ;; background
+   on-red on-blue on-green on-cyan on-yellow
+   on-magenta on-white on-black
+   on-color on-true-color
+   )
   (begin
     (define color
       (make-computation-environment-variable 'color #f #f)))