756 lines
22 KiB
Scheme
756 lines
22 KiB
Scheme
;;
|
|
;; sgr-state.scm
|
|
;;
|
|
;; ECMA-48 Set Graphics Rendition state management.
|
|
;;
|
|
;; ISC License
|
|
;;
|
|
;; Copyright 2023 Dominik Pantůček <dominik.pantucek@trustica.cz>
|
|
;;
|
|
;; Permission to use, copy, modify, and/or distribute this software
|
|
;; for any purpose with or without fee is hereby granted, provided
|
|
;; that the above copyright notice and this permission notice appear
|
|
;; in all copies.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
|
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
;;
|
|
|
|
(declare (unit sgr-state))
|
|
|
|
(module
|
|
sgr-state
|
|
(
|
|
sgr-color-valid?
|
|
sgr-truecolor?
|
|
make-sgr-truecolor
|
|
split-sgr-truecolor
|
|
|
|
make-sgr-state
|
|
empty-sgr-state
|
|
|
|
sgr-state?
|
|
|
|
sgr-state-intensity
|
|
set-sgr-state-intensity
|
|
|
|
sgr-state-italic
|
|
set-sgr-state-italic
|
|
|
|
sgr-state-underline
|
|
set-sgr-state-underline
|
|
|
|
sgr-state-blink
|
|
set-sgr-state-blink
|
|
|
|
sgr-state-reverse
|
|
set-sgr-state-reverse
|
|
|
|
sgr-state-crossed
|
|
set-sgr-state-crossed
|
|
|
|
sgr-state-foreground
|
|
sgr-state-background
|
|
|
|
set-sgr-state-foreground
|
|
set-sgr-state-background
|
|
|
|
sgr-state-change->string
|
|
|
|
parse-csi-sgr-sequence+pos
|
|
parse-csi-sgr-sequence
|
|
|
|
update-sgr-state-from-list
|
|
update-sgr-state-from-string
|
|
|
|
sgr-state-tests!
|
|
)
|
|
|
|
(import scheme
|
|
(chicken base)
|
|
(chicken bitwise)
|
|
(chicken string)
|
|
testing
|
|
racket-kwargs)
|
|
|
|
;; Checks whether this is indexed color or truecolor representation
|
|
;; validating the bit mask as well
|
|
(define (sgr-color-valid? c)
|
|
(or (< c 256)
|
|
(and (>= c #x1000000)
|
|
(<= c #x1ffffff))))
|
|
|
|
;; Returns true if given color is truecolor representation (assumes
|
|
;; #x1000000 bit set)
|
|
(define (sgr-truecolor? c)
|
|
(> c 255))
|
|
|
|
;; Creates valid truecolor representation
|
|
(define (make-sgr-truecolor r g b)
|
|
(bitwise-ior #x1000000
|
|
(arithmetic-shift (bitwise-and r 255) 16)
|
|
(arithmetic-shift (bitwise-and g 255) 8)
|
|
(bitwise-and b 255)))
|
|
|
|
;; Returns the separated RGB alues from SGR truecolor representation
|
|
(define (split-sgr-truecolor c)
|
|
(values (bitwise-and (arithmetic-shift c -16) 255)
|
|
(bitwise-and (arithmetic-shift c -8) 255)
|
|
(bitwise-and c 255)))
|
|
|
|
;; Creates empty SGR state
|
|
(define (make-sgr-state)
|
|
0)
|
|
|
|
;; Constant representing empty (default) SGR state
|
|
(define empty-sgr-state 0)
|
|
|
|
;; Returns #t if this is valid SGR state representation
|
|
(define (sgr-state? v)
|
|
(or (and (fixnum? v)
|
|
(= (bitwise-and v (bitwise-not sgr-state-bit-mask)) 0))
|
|
(and (pair? v)
|
|
(fixnum? (car v))
|
|
(= (bitwise-and (car v) (bitwise-not sgr-state-bit-mask)) 0)
|
|
(pair? (cdr v))
|
|
(or (not (cadr v))
|
|
(and (fixnum? (cadr v))
|
|
(= (bitwise-and (cadr v) (bitwise-not #x1ffffff)) 0)))
|
|
(or (not (cddr v))
|
|
(and (fixnum? (cddr v))
|
|
(= (bitwise-and (cddr v) (bitwise-not #x1ffffff)) 0))))))
|
|
|
|
;; Basic SGR state is just a number, extended state is a pair of
|
|
;; number and pair of fg/bg truecolors.
|
|
(define (sgr-state-bits s)
|
|
(if (pair? s)
|
|
(car s)
|
|
s))
|
|
|
|
;; Sets the bits part of given SGR state, if it is not a pair, just
|
|
;; returns the new bits as state value
|
|
(define (set-sgr-state-bits s b)
|
|
(if (pair? s)
|
|
(cons b (cdr s))
|
|
b))
|
|
|
|
;; Computes positional mask, creates getter and setter for given
|
|
;; numeric attribute at given bit-offset
|
|
(define-syntax define-sgr-num-attribute
|
|
(syntax-rules ()
|
|
((_ bit-offset bit-size mask getter setter)
|
|
(begin
|
|
(define mask (arithmetic-shift (sub1 (arithmetic-shift 1 bit-size))
|
|
bit-offset))
|
|
(define (getter s)
|
|
(let ((v (arithmetic-shift
|
|
(bitwise-and (sgr-state-bits s) mask)
|
|
(- bit-offset))))
|
|
(if (> v 0) v #f)))
|
|
(define (setter s vf)
|
|
(let ((v (case vf
|
|
((#f) 0)
|
|
((#t) 1)
|
|
(else vf)))
|
|
(b (sgr-state-bits s)))
|
|
(set-sgr-state-bits
|
|
s
|
|
(bitwise-ior
|
|
(bitwise-and (arithmetic-shift v bit-offset) mask)
|
|
(bitwise-and (bitwise-not mask) b)))))))))
|
|
|
|
;; Wrapper for defining all attributes iteratively, incrementing
|
|
;; bit-offset as needed
|
|
(define-syntax define-sgr-num-attribute+
|
|
(syntax-rules ()
|
|
((_ bit-offset total bit-size mask getter setter remaining ...)
|
|
(begin
|
|
(define-sgr-num-attribute bit-offset bit-size mask getter setter)
|
|
(define-sgr-num-attribute+ (+ bit-offset bit-size) total remaining ...)))
|
|
((_ bit-offset total)
|
|
(define total bit-offset))))
|
|
|
|
;; Wrapper for definer starting at bit offset 0
|
|
(define-syntax define-sgr-num-attributes
|
|
(syntax-rules ()
|
|
((_ total all ...)
|
|
(begin
|
|
(define-sgr-num-attribute+ 0 total all ...)))))
|
|
|
|
;; Define simple (numeric) attributes
|
|
(define-sgr-num-attributes
|
|
sgr-state-num-bits
|
|
;; 1: bold, 2: half-bright
|
|
2 sgr-state-intensity-mask sgr-state-intensity set-sgr-state-intensity
|
|
1 sgr-state-italic-mask sgr-state-italic set-sgr-state-italic
|
|
;; 1: single, 2: double
|
|
2 sgr-state-underline-mask sgr-state-underline set-sgr-state-underline
|
|
1 sgr-state-blink-mask sgr-state-blink set-sgr-state-blink
|
|
1 sgr-state-reverse-mask sgr-state-reverse set-sgr-state-reverse
|
|
1 sgr-state-crossed-mask sgr-state-crossed set-sgr-state-crossed
|
|
9 sgr-state-fg256-mask sgr-state-fg256 set-sgr-state-fg256
|
|
9 sgr-state-bg256-mask sgr-state-bg256 set-sgr-state-bg256)
|
|
|
|
;; Used in sgr-state? predicate
|
|
(define sgr-state-bit-mask (sub1 (arithmetic-shift 1 sgr-state-num-bits)))
|
|
|
|
;; Returns true, color 0-255 or RGB triplet with bit 17 set to 1 if
|
|
;; truecolor
|
|
(define (sgr-state-foreground s)
|
|
(if (pair? s)
|
|
(cadr s)
|
|
(let ((c+ (sgr-state-fg256 s)))
|
|
(if c+
|
|
(bitwise-and c+ 255)
|
|
#f))))
|
|
|
|
;; Returns true, color 0-255 or RGB triplet with bit 17 set to 1 if
|
|
;; truecolor
|
|
(define (sgr-state-background s)
|
|
(if (pair? s)
|
|
(cddr s)
|
|
(let ((c+ (sgr-state-bg256 s)))
|
|
(if c+
|
|
(bitwise-and c+ 255)
|
|
#f))))
|
|
|
|
;; Sets foreground color, possibly compacting the SGR state, #f is
|
|
;; valid value representing default color
|
|
(define (set-sgr-state-foreground s c)
|
|
(if (pair? s)
|
|
;; Initially it is a pair
|
|
(if c
|
|
;; Setting some foreground
|
|
(if (< c 256)
|
|
;; Foreground does not need pair
|
|
(if (and (cddr s)
|
|
(>= (cddr s) 256))
|
|
;; Background needs a pair, set foreground to bits
|
|
;; and cadr
|
|
(cons (set-sgr-state-fg256 (car s)
|
|
(bitwise-ior c 256))
|
|
(cons c (cddr s)))
|
|
;; Neither background nor foreground need pair,
|
|
;; switch to bit-only representation
|
|
(set-sgr-state-fg256 (car s) (bitwise-ior c 256)))
|
|
;; Foreground needs pair, just update cadr and reset
|
|
;; bits
|
|
(cons (set-sgr-state-fg256 (car s) 0)
|
|
(cons (bitwise-ior c #x1000000)
|
|
(cddr s))))
|
|
;; Removing foreground
|
|
(if (and (cddr s)
|
|
(>= (cddr s) 256))
|
|
;; Still pair needed for background, store both in bits
|
|
;; and cadr
|
|
(cons (set-sgr-state-fg256 (car s) 0)
|
|
(cons #f (cddr s)))
|
|
;; Just reset, no pair for background needed
|
|
(set-sgr-state-fg256 s 0)))
|
|
;; Initially it is a bit representation
|
|
(if c
|
|
;; Setting foreground
|
|
(if (< c 256)
|
|
;; Just set the bits
|
|
(set-sgr-state-fg256 s (bitwise-ior c 256))
|
|
;; Create pair representation, store exclusively in cadr
|
|
(cons (set-sgr-state-fg256 s 0)
|
|
(cons (bitwise-ior c #x1000000) #f)))
|
|
;; Just clear the bits
|
|
(set-sgr-state-fg256 s 0))))
|
|
|
|
;; Sets background color, possibly compacting the SGR state, #f is
|
|
;; valid value representing default color
|
|
(define (set-sgr-state-background s c)
|
|
(if (pair? s)
|
|
;; Initially it is a pair
|
|
(if c
|
|
;; Setting some background
|
|
(if (< c 256)
|
|
;; Background does not need pair
|
|
(if (and (cadr s)
|
|
(>= (cadr s) 256))
|
|
;; Foreground needs a pair, set background to bits
|
|
;; and cddr
|
|
(cons (set-sgr-state-bg256 (car s)
|
|
(bitwise-ior c 256))
|
|
(cons (cadr s) c))
|
|
;; Neither background nor foreground need pair,
|
|
;; switch to bit-only representation
|
|
(set-sgr-state-bg256 (car s) (bitwise-ior c 256)))
|
|
;; Background needs pair, just update cddr and reset
|
|
;; bits
|
|
(cons (set-sgr-state-bg256 (car s) 0)
|
|
(cons (cadr s)
|
|
(bitwise-ior c #x1000000))))
|
|
;; Removing background
|
|
(if (and (cadr s)
|
|
(>= (cadr s) 256))
|
|
;; Still pair needed for foreground, store both in bits
|
|
;; and cddr
|
|
(cons (set-sgr-state-bg256 (car s) 0)
|
|
(cons (cadr s) #f))
|
|
;; Just reset, no pair for foreground needed
|
|
(set-sgr-state-bg256 s 0)))
|
|
;; Initially it is a bit representation
|
|
(if c
|
|
;; Setting background
|
|
(if (< c 256)
|
|
;; Just set the bits
|
|
(set-sgr-state-bg256 s (bitwise-ior c 256))
|
|
;; Create pair representation, store exclusively in cddr
|
|
(cons (set-sgr-state-bg256 s 0)
|
|
(cons #f (bitwise-ior c #x1000000))))
|
|
;; Just clear the bits
|
|
(set-sgr-state-bg256 s 0))))
|
|
|
|
;; Prepends required CSI SGR sequence for given color change
|
|
(define (sgr-prepend-color-change lst color background?)
|
|
(let ((off (if background? 10 0)))
|
|
(cond ((eq? color #f)
|
|
(cons (+ off 39) lst))
|
|
((< color 8)
|
|
(cons (+ off 30 color) lst))
|
|
((< color 16)
|
|
(cons (+ off 82 color) lst))
|
|
((< color 256)
|
|
(cons color
|
|
(cons 5
|
|
(cons (+ 38 off)
|
|
lst))))
|
|
(else
|
|
(let-values (((r g b) (split-sgr-truecolor color)))
|
|
(cons b
|
|
(cons g
|
|
(cons r
|
|
(cons 2
|
|
(cons (+ 38 off)
|
|
lst))))))))))
|
|
|
|
;; Produces an CSI SGR sequence to change from the orig state to the
|
|
;; next state.
|
|
(define (sgr-state-change->string orig next)
|
|
(cond
|
|
((equal? orig next)
|
|
"")
|
|
((equal? next empty-sgr-state)
|
|
"\x1b[0m")
|
|
(else
|
|
(let* ((cs0 '())
|
|
(cs1 (if (eq? (sgr-state-intensity orig)
|
|
(sgr-state-intensity next))
|
|
cs0
|
|
(cons (case (sgr-state-intensity next)
|
|
((1) 1)
|
|
((2) 2)
|
|
(else 22))
|
|
cs0)))
|
|
(cs2 (if (eq? (sgr-state-italic orig)
|
|
(sgr-state-italic next))
|
|
cs1
|
|
(cons (if (sgr-state-italic next)
|
|
3
|
|
23)
|
|
cs1)))
|
|
(cs3 (if (eq? (sgr-state-underline orig)
|
|
(sgr-state-underline next))
|
|
cs2
|
|
(cons (case (sgr-state-underline next)
|
|
((1) 4)
|
|
((2) 21)
|
|
(else 24))
|
|
cs2)))
|
|
(cs4 (if (eq? (sgr-state-blink orig)
|
|
(sgr-state-blink next))
|
|
cs3
|
|
(cons (if (sgr-state-blink next)
|
|
5
|
|
25)
|
|
cs3)))
|
|
(cs5 (if (eq? (sgr-state-reverse orig)
|
|
(sgr-state-reverse next))
|
|
cs4
|
|
(cons (if (sgr-state-reverse next)
|
|
7
|
|
27)
|
|
cs4)))
|
|
(cs6 (if (eq? (sgr-state-crossed orig)
|
|
(sgr-state-crossed next))
|
|
cs5
|
|
(cons (if (sgr-state-crossed next)
|
|
9
|
|
29)
|
|
cs5)))
|
|
(cs7 (if (eq? (sgr-state-foreground orig)
|
|
(sgr-state-foreground next))
|
|
cs6
|
|
(sgr-prepend-color-change cs6 (sgr-state-foreground next) #f)))
|
|
(cs8 (if (eq? (sgr-state-background orig)
|
|
(sgr-state-background next))
|
|
cs7
|
|
(sgr-prepend-color-change cs7 (sgr-state-background next) #t)))
|
|
(cs cs8))
|
|
(string-append
|
|
"\x1b["
|
|
(string-intersperse
|
|
(map number->string (reverse cs))
|
|
";")
|
|
"m")))))
|
|
|
|
;; Parses a CSI SGR sequence. Returns a list of numeric arguments in
|
|
;; the same order as they are present in the sequence, prepends the
|
|
;; terminating character (sequence type). Returns position just after
|
|
;; parsed sequence as second value.
|
|
(define (parse-csi-sgr-sequence+pos str . ps)
|
|
(let ((pos (if (null? ps) 0 (car ps)))
|
|
(len (string-length str)))
|
|
(if (or (>= pos len)
|
|
(not (eq? (string-ref str pos) #\x1b)))
|
|
(values '() 0)
|
|
(if (or (>= (add1 pos) len)
|
|
(not (eq? (string-ref str (add1 pos)) #\[)))
|
|
(values '() 1)
|
|
(let loop ((pos (+ pos 2))
|
|
(res '())
|
|
(pending #f))
|
|
(if (>= pos len)
|
|
(values '() pos)
|
|
(let ((ch (string-ref str pos)))
|
|
(cond ((and (char>=? ch #\0)
|
|
(char<=? ch #\9))
|
|
(let ((digit (- (char->integer ch)
|
|
(char->integer #\0))))
|
|
(loop (add1 pos)
|
|
res
|
|
(if pending
|
|
(+ (* pending 10) digit)
|
|
digit))))
|
|
((eq? ch #\;)
|
|
(loop (add1 pos)
|
|
(cons pending res)
|
|
#f))
|
|
(else
|
|
(values (cons ch
|
|
(reverse (if pending
|
|
(cons pending res)
|
|
res)))
|
|
(add1 pos)))))))))))
|
|
|
|
;; Parses CSI SGR sequence and returns the sequence list only.
|
|
(define (parse-csi-sgr-sequence str . ps)
|
|
(let-values (((lst pos)
|
|
(parse-csi-sgr-sequence+pos str (if (null? ps) 0 (car ps)))))
|
|
lst))
|
|
|
|
;; Parses 256 and 16M color sequences
|
|
(define (parse-extended-sgr-color lst state background?)
|
|
(if (null? lst)
|
|
(list lst state)
|
|
(case (car lst)
|
|
((5)
|
|
(if (null? (cdr lst))
|
|
(list (cdr lst) state)
|
|
(list (cddr lst)
|
|
(if background?
|
|
(set-sgr-state-background state (cadr lst))
|
|
(set-sgr-state-foreground state (cadr lst))))))
|
|
((2)
|
|
(if (null? (cdr lst)) ; R?
|
|
(list (cdr lst) state)
|
|
(if (null? (cddr lst)) ; G?
|
|
(list (cddr lst) state)
|
|
(if (null? (cdddr lst)) ; B?
|
|
(list (cdddr lst) state)
|
|
(list (cddddr lst)
|
|
(let ((c (make-sgr-truecolor (cadr lst)
|
|
(caddr lst)
|
|
(cadddr lst))))
|
|
(if background?
|
|
(set-sgr-state-background state c)
|
|
(set-sgr-state-foreground state c))))))))
|
|
(else
|
|
(list (cdr lst) state)))))
|
|
|
|
;; Update given state by parsed SGR state list
|
|
(define* (update-sgr-state-from-list state lst
|
|
#:default (default empty-sgr-state))
|
|
(if (or (null? lst)
|
|
(not (eq? (car lst) #\m)))
|
|
state
|
|
(let loop ((lst (cdr lst))
|
|
(state state))
|
|
(if (null? lst)
|
|
state
|
|
(case (car lst)
|
|
((0)
|
|
(loop (cdr lst)
|
|
default))
|
|
((1)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-intensity state 1)))
|
|
((2)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-intensity state 2)))
|
|
((3)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-intensity state #t)))
|
|
((4)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-underline state 1)))
|
|
((5)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-blink state #t)))
|
|
((7)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-reverse state #t)))
|
|
((9)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-crossed state #t)))
|
|
((21)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-underline state 2)))
|
|
((22)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-intensity state #f)))
|
|
((23)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-italic state #f)))
|
|
((24)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-underline state #f)))
|
|
((25)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-blink state #f)))
|
|
((27)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-reverse state #f)))
|
|
((29)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-crossed state #f)))
|
|
((30 31 32 33 34 35 36 37)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-foreground state (- (car lst) 30))))
|
|
((38)
|
|
(apply loop (parse-extended-sgr-color (cdr lst) state #f)))
|
|
((39)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-foreground state #f)))
|
|
((40 41 42 43 44 45 46 47)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-background state (- (car lst) 40))))
|
|
((48)
|
|
(apply loop (parse-extended-sgr-color (cdr lst) state #f)))
|
|
((49)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-background state #f)))
|
|
((90 91 92 93 94 95 96 97)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-foreground state (- (car lst) 82))))
|
|
((100 101 102 103 104 105 106 107)
|
|
(loop (cdr lst)
|
|
(set-sgr-state-background state (- (car lst) 92))))
|
|
(else
|
|
(loop (cdr lst)
|
|
state)))))))
|
|
|
|
;; Updates given SGR state based on ESC sequence(s) given in the
|
|
;; string. Optional starting position can be given. Processes only
|
|
;; one sequence.
|
|
(define* (update-sgr-state-from-string state str
|
|
(pos 0)
|
|
#:default (default empty-sgr-state))
|
|
(let ((lst (parse-csi-sgr-sequence str pos)))
|
|
(update-sgr-state-from-list state lst #:default default)))
|
|
|
|
;; Module self-tests
|
|
(define (sgr-state-tests!)
|
|
(run-tests
|
|
sgr-state
|
|
(test-true sgr-color-valid?
|
|
(sgr-color-valid? 1))
|
|
(test-true sgr-color-valid?
|
|
(sgr-color-valid? #x1234567))
|
|
(test-false sgr-color-valid?
|
|
(sgr-color-valid? 1000))
|
|
(test-false sgr-color-valid?
|
|
(sgr-color-valid? #x2000000))
|
|
(test-false sgr-truecolor?
|
|
(sgr-truecolor? 123))
|
|
(test-true sgr-truecolor?
|
|
(sgr-truecolor? #x1234567))
|
|
(test-equal? make-sgr-truecolor
|
|
(make-sgr-truecolor 1 2 3)
|
|
#x1010203)
|
|
(test-equal? split-sgr-truecolor
|
|
(call-with-values
|
|
(lambda ()
|
|
(split-sgr-truecolor #x1112233))
|
|
list)
|
|
'(17 34 51))
|
|
(test-equal? sgr-state-intensity-mask
|
|
sgr-state-intensity-mask
|
|
3)
|
|
(test-equal? sgr-state-italic-mask
|
|
sgr-state-italic-mask
|
|
4)
|
|
(test-equal? sgr-state-italic
|
|
(sgr-state-italic 4)
|
|
1)
|
|
(test-equal? set-sgr-state-italic
|
|
(set-sgr-state-italic 0 1)
|
|
4)
|
|
(test-equal? set-sgr-state-italic
|
|
(set-sgr-state-italic 15 0)
|
|
11)
|
|
(test-equal? set-sgr-state-italic
|
|
(set-sgr-state-italic 15 #f)
|
|
11)
|
|
(test-equal? set-sgr-state-foreground
|
|
(set-sgr-state-foreground 0 255)
|
|
(set-sgr-state-fg256 0 511))
|
|
(test-equal? set-sgr-state-foreground
|
|
(set-sgr-state-foreground 0 256)
|
|
(cons 0 (cons #x1000100 #f)))
|
|
(test-equal? set-sgr-state-foreground
|
|
(set-sgr-state-foreground
|
|
(set-sgr-state-foreground 0 256) 255)
|
|
(set-sgr-state-fg256 0 511))
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-intensity empty-sgr-state 1))
|
|
"\x1b[1m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
(set-sgr-state-italic
|
|
empty-sgr-state 1) 1)
|
|
empty-sgr-state)
|
|
"\x1b[0m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
(set-sgr-state-italic
|
|
empty-sgr-state #t) 2)
|
|
(set-sgr-state-italic
|
|
empty-sgr-state #t))
|
|
"\x1b[22m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
(set-sgr-state-italic
|
|
empty-sgr-state #t) 2)
|
|
(set-sgr-state-intensity
|
|
empty-sgr-state 2))
|
|
"\x1b[23m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
empty-sgr-state 2)
|
|
(set-sgr-state-intensity
|
|
(set-sgr-state-italic
|
|
empty-sgr-state #t) 2))
|
|
"\x1b[3m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
empty-sgr-state 2)
|
|
(set-sgr-state-intensity
|
|
(set-sgr-state-underline
|
|
empty-sgr-state 2) 2))
|
|
"\x1b[21m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
empty-sgr-state 2)
|
|
(set-sgr-state-intensity
|
|
(set-sgr-state-blink
|
|
empty-sgr-state #t) 2))
|
|
"\x1b[5m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
empty-sgr-state 2)
|
|
(set-sgr-state-intensity
|
|
(set-sgr-state-reverse
|
|
empty-sgr-state #t) 2))
|
|
"\x1b[7m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string (set-sgr-state-intensity
|
|
empty-sgr-state 2)
|
|
(set-sgr-state-intensity
|
|
(set-sgr-state-crossed
|
|
empty-sgr-state #t) 2))
|
|
"\x1b[9m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-foreground
|
|
empty-sgr-state
|
|
5))
|
|
"\x1b[35m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-foreground
|
|
empty-sgr-state
|
|
15))
|
|
"\x1b[97m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-foreground
|
|
empty-sgr-state
|
|
115))
|
|
"\x1b[38;5;115m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-foreground
|
|
empty-sgr-state
|
|
#x1112233))
|
|
"\x1b[38;2;17;34;51m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-background
|
|
empty-sgr-state
|
|
5))
|
|
"\x1b[45m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-background
|
|
empty-sgr-state
|
|
15))
|
|
"\x1b[107m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-background
|
|
empty-sgr-state
|
|
115))
|
|
"\x1b[48;5;115m")
|
|
(test-equal? sgr-state-change->string
|
|
(sgr-state-change->string empty-sgr-state
|
|
(set-sgr-state-background
|
|
empty-sgr-state
|
|
#x1112233))
|
|
"\x1b[48;2;17;34;51m")
|
|
(test-equal? parse-csi-sgr-sequence
|
|
(parse-csi-sgr-sequence "\x1b[38;2;1;2;3m")
|
|
'(#\m 38 2 1 2 3))
|
|
(test-equal? update-sgr-state-from-string
|
|
(update-sgr-state-from-string
|
|
empty-sgr-state
|
|
"\x1b[1m")
|
|
1)
|
|
(test-equal? update-sgr-state-from-string
|
|
(update-sgr-state-from-string
|
|
empty-sgr-state
|
|
"\x1b[31m")
|
|
(set-sgr-state-foreground 0 1))
|
|
(test-equal? update-sgr-state-from-string
|
|
(update-sgr-state-from-string
|
|
empty-sgr-state
|
|
"\x1b[91m")
|
|
(set-sgr-state-foreground 0 9))
|
|
(test-equal? update-sgr-state-from-string
|
|
(update-sgr-state-from-string
|
|
empty-sgr-state
|
|
"\x1b[38;2;17;34;51m")
|
|
(set-sgr-state-foreground empty-sgr-state #x1112233))
|
|
))
|
|
|
|
)
|