;;
;; 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))
    ))

 )