slope ansi module
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

145 lines
5.5 KiB

;;;
;;; ansi - a set of procedures and variables for
;;; working with ansi/vt100 terminal escape codes
; Helper function
(define ansi-between (lambda (val min max)
(if (and (number? val) (number? min) (number? max))
(and (>= val min) (<= val max))
(! "'ansi-between' expects three number values, at least one non-number value was given"))))
; Move the cursor home
(define ansi-curs-home (lambda () "\033[H"))
; Set the cursor position
(define ansi-curs-pos (lambda (row col)
(if (and (number? row) (number? col))
(string-append "\033[" (abs (floor row)) ";" (abs (floor col)) "H")
(! "'ansi-curs-pos' expected two values, row and col, as numbers"))))
; Move the cursor up
(define ansi-curs-up (lambda (count)
(if (number? count)
(string-append "\033[" (abs (floor count)) "A")
(! "'ansi-curs-up' expected a number, a non-number value was given"))))
; Move the cursor down
(define ansi-curs-down (lambda (count)
(if (number? count)
(string-append "\033[" (abs (floor count)) "B")
(! "'ansi-curs-down' expected a number, a non-number value was given"))))
; Move the cursor forward
(define ansi-curs-forward (lambda (count)
(if (number? count)
(string-append "\033[" (abs (floor count)) "C")
(! "'ansi-curs-forward' expected a number, a non-number value was given"))))
; Move the cursor back
(define ansi-curs-back (lambda (count)
(if (number? count)
(string-append "\033[" (abs (floor count)) "D")
(! "'ansi-curs-back' expected a number, a non-number value was given"))))
; Save the current cursor position
(define ansi-save-pos (lambda () "\033[s"))
; Restores the current cursor position
(define ansi-restore-pos (lambda () "\033[u"))
; Erase to end of line
(define ansi-erase->line-end (lambda () "\033[K"))
; Erase to start of line
(define ansi-erase->line-start (lambda () "\033[1K"))
; Erase line
(define ansi-erase-line (lambda () "\033[2K"))
; Erase to bottom
(define ansi-erase->bottom (lambda () "\033[J"))
; Erase to top
(define ansi-erase->top (lambda () "\033[1J"))
; Erase screen
(define ansi-erase-screen (lambda () "\033[2J"))
; Various attributes
(define ansi-att-reset (lambda () "\033[0m"))
(define ansi-att-bold (lambda () "\033[1m"))
(define ansi-att-dim (lambda () "\033[2m"))
(define ansi-att-italic (lambda () "\033[3m"))
(define ansi-att-underline (lambda () "\033[4m"))
(define ansi-att-slow-blink (lambda () "\033[5m"))
(define ansi-att-fast-blink (lambda () "\033[6m"))
(define ansi-att-inverse (lambda () "\033[7m"))
(define ansi-att-bold-off (lambda () "\033[21m"))
(define ansi-att-normal-intensity (lambda () "\033[22m"))
(define ansi-att-italic-off (lambda () "\033[23m"))
(define ansi-att-underline-off (lambda () "\033[24m"))
(define ansi-att-blink-off (lambda () "\033[25m"))
(define ansi-att-inverse-off (lambda () "\033[27m"))
; 4-bit color
(define black '(30 40))
(define red '(31 41))
(define green '(32 42))
(define yellow '(33 43))
(define blue '(34 44))
(define magenta '(35 45))
(define cyan '(36 46))
(define white '(37 47))
(define bright-black '(90 100))
(define bright-red '(91 101))
(define bright-green '(92 102))
(define bright-yellow '(93 103))
(define bright-blue '(94 104))
(define bright-magenta '(95 105))
(define bright-cyan '(96 106))
(define bright-white '(97 107))
(define ansi-color (lambda (fg bg)
(define out (string-make-buf))
(write "\033[" out)
(cond ; vet the fg input a little bit
((and (list? fg) (equal? (length fg) 2) (number? (car fg))) (set! fg (abs (floor (car fg)))))
((and (number? fg) (or (ansi-between fg 29 38) (ansi-between fg 89 98))) (set! fg (abs (floor fg))))
(else (set! fg #f)))
(cond ; vet the bg input a little bit
((and (list? bg) (equal? (length bg) 2) (number? (car (cdr bg)))) (set! bg (abs (floor (car (cdr bg))))))
((and (number? bg) (or (ansi-between bg 39 48) (ansi-between bg 99 108))) (set! bg (abs (floor bg))))
(else (set! bg #f)))
; Set and return output
(cond
((and fg bg)
(begin (write fg out) (write ";" out) (write bg out) (write "m" out) (read-all out)))
(fg
(begin (write fg out) (write "m" out) (read-all out)))
(bg
(begin (write bg out) (write "m" out) (read-all out))))))
(define ansi-256-color-fg (lambda (val)
(if (and (number? val) (ansi-between val 0 255))
(string-format "\033[38;5;%vm" val)
(! "'ansi-256-color-fg' expects a number value between 0 and 255"))))
(define ansi-256-color-bg (lambda (val)
(if (and (number? val) (ansi-between val 0 255))
(string-format "\033[48;5;%vm" val)
(! "'ansi-256-color-bg' expects a number value between 0 and 255"))))
(define ansi-true-color-fg (lambda (r g b)
(if (and (number? r) (number? g) (number? b))
(if (and (ansi-between r 0 255) (ansi-between g 0 255) (ansi-between b 0 255))
(string-format "\033[38;2;%v;%v;%vm" (abs (floor r)) (abs (floor g)) (abs (floor b)))
(! "'ansi-true-color-fg' expects its three r g b values to be numbers between 0 and 255, at least one out of range number was given"))
(! "'ansi-true-color-fg' expects three numbers, a non-number value was received"))))
(define ansi-true-color-bg (lambda (r g b)
(if (and (number? r) (number? g) (number? b))
(if (and (ansi-between r 0 255) (ansi-between g 0 255) (ansi-between b 0 255))
(string-format "\033[48;2;%v;%v;%vm" (abs (floor r)) (abs (floor g)) (abs (floor b)))
(! "'ansi-true-color-bg' expects its three r g b values to be numbers between 0 and 255, at least one out of range number was given"))
(! "'ansi-true-color-bg' expects three numbers, a non-number value was received"))))