Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding true color ansi support

Browse source
This commit is contained in:
Alex Shinn 2019-03-13 23:57:22 +08:00
parent cf1f333731
commit cd10668b3c
3 changed files with 59 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lib/chibi/term/ansi-test.sld
View file

@ -127,6 +127,7 @@
(test-wrap-procedure (rgb 5 5 5) "\x1B;[38;5;231mFOO\x1b;[39m")
(test-wrap-procedure (gray 0) "\x1B;[38;5;232mFOO\x1b;[39m")
(test-wrap-procedure (gray 23) "\x1B;[38;5;255mFOO\x1b;[39m")
(test-wrap-procedure (rgb24 #xA6 #x7B #x5B) "\x1B;[38;2;166;123;91mFOO\x1b;[39m")
(test-escape-procedure black-background-escape "\x1b;[40m")
(test-escape-procedure red-background-escape "\x1b;[41m")

55
lib/chibi/term/ansi.scm
View file

@ -82,6 +82,26 @@
(number->string (+ gray-level 232))
"m"))
;;> The true-color equivalent of \scheme{rgb-escape}. Return a string
;;> consisting of an ANSI escape code to select the text color
;;> specified by the \var{red-level}, \var{green-level}, and
;;> \var{blue-level} arguments, each of which must be an exact integer
;;> in the range [0, 255].
(define (rgb24-escape red-level green-level blue-level)
(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)))
(error "invalid green-level value" green-level))
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 255)))
(error "invalid blue-level value" blue-level))
(string-append
"\x1B;[38;2;"
(number->string red-level) ";"
(number->string green-level) ";"
(number->string blue-level)
"m"))
;;> Return a string consisting of an ANSI escape code to select the
;;> default text color.
@ -157,6 +177,13 @@
(make-wrap-procedure (gray-escape gray-level)
(reset-color-escape)))
;;> The true-color equivalent of \scheme{rbg}, extending the ranges
;;> to [0, 255].
(define (rgb24 red-level green-level blue-level)
(make-wrap-procedure (rgb24-escape red-level green-level blue-level)
(reset-color-escape)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define black-background-escape
@ -214,6 +241,26 @@
(number->string (+ gray-level 232))
"m"))
;;> The true-color equivalent of \scheme{rgb-background-escape}.
;;> Return a string consisting of an ANSI escape code to select the
;;> text color specified by the \var{red-level}, \var{green-level},
;;> and \var{blue-level} arguments, each of which must be an exact
;;> integer in the range [0, 255].
(define (rgb24-background-escape red-level green-level blue-level)
(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)))
(error "invalid green-level value" green-level))
(when (not (and (exact-integer? blue-level) (<= 0 blue-level 255)))
(error "invalid blue-level value" blue-level))
(string-append
"\x1B;[48;5;"
(number->string red-level) ";"
(number->string green-level) ";"
(number->string blue-level)
"m"))
;;> \procedure{(reset-background-color-escape)}
;;>
;;> Return a string consisting of an ANSI escape code to select the
@ -291,6 +338,14 @@
(make-wrap-procedure (gray-background-escape gray-level)
(reset-background-color-escape)))
;;> The true-color equivalent of \scheme{rbg-background}, extending
;;> the ranges to [0, 255].
(define (rgb24-background red-level green-level blue-level)
(make-wrap-procedure
(rgb24-background-escape red-level green-level blue-level)
(reset-background-color-escape)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;> Return a string consisting of an ANSI escape code to select bold

3
lib/chibi/term/ansi.sld
View file

@ -5,6 +5,7 @@
blue-escape cyan-escape magenta-escape white-escape
rgb-escape
gray-escape
rgb24-escape
reset-color-escape
black-background-escape red-background-escape
@ -13,6 +14,7 @@
magenta-background-escape white-background-escape
rgb-background-escape
gray-background-escape
rgb24-background-escape
reset-background-color-escape
black red yellow green
@ -24,6 +26,7 @@
negative
rgb rgb-background
gray gray-background
rgb24 rgb24-background
bold-escape reset-bold-escape
underline-escape reset-underline-escape
negative-escape reset-negative-escape