Import new table renderer.

src/sgr-state.scm

@@ -0,0 +1,756 @@
+;;
+;; 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 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))
+    ))
+
+ )