24 lines
904 B
Racket
24 lines
904 B
Racket
#lang racket
|
|
|
|
;; Utility interfaces to the low-level command
|
|
(define (capability? cap) (system (~a "tput "cap" > /dev/null 2>&1")))
|
|
(define (tput . xs) (system (apply ~a 'tput " " (add-between xs " "))) (void))
|
|
(define (colorterm?) (and (capability? 'setaf) (capability? 'setab)))
|
|
(define color-map '([black 0] [red 1] [green 2] [yellow 3]
|
|
[blue 4] [magenta 5] [cyan 6] [white 7]))
|
|
(define (foreground color) (tput 'setaf (cadr (assq color color-map))))
|
|
(define (background color) (tput 'setab (cadr (assq color color-map))))
|
|
(define (reset) (tput 'sgr0) (void))
|
|
|
|
;; Demonstration of use
|
|
(if (colorterm?)
|
|
(begin (foreground 'blue)
|
|
(background 'yellow)
|
|
(displayln "Color output")
|
|
(reset))
|
|
(displayln "Monochrome only"))
|
|
(if (capability? 'blink)
|
|
(begin (tput 'blink)
|
|
(displayln "Blinking output")
|
|
(reset))
|
|
(displayln "Steady only"))
|