From 945cb186f9dd094070e538c3c94c11457b7a136d Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones <tonygarnockjones@gmail.com> Date: Fri, 28 Oct 2011 16:52:30 -0400 Subject: [PATCH] Initial commit. --- README.md | 1 + ansi.rkt | 178 ++++++++++++++++++++++++++++++++++++++++++++++++++ test-ansi.rkt | 35 ++++++++++ 3 files changed, 214 insertions(+) create mode 100644 README.md create mode 100644 ansi.rkt create mode 100644 test-ansi.rkt diff --git a/README.md b/README.md new file mode 100644 index 0000000..f2fdde9 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +ANSI and VT10x escape sequences. diff --git a/ansi.rkt b/ansi.rkt new file mode 100644 index 0000000..93da7a2 --- /dev/null +++ b/ansi.rkt @@ -0,0 +1,178 @@ +#lang racket/base +;; ANSI/VT10x escape sequences +;; Based initially on http://en.wikipedia.org/wiki/ANSI_escape_code. +;; +;; This is also an excellent resource: +;; http://bjh21.me.uk/all-escapes/all-escapes.txt + +(provide (except-out (all-defined-out) + CSI + define-escape-sequence)) + +(define CSI "\033[") + +(define-syntax-rule (define-escape-sequence (name arg ...) piece ...) + (define (name arg ...) + (let ((arg (number->string arg)) ...) + (string-append piece ...)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic ANSI sequences +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-escape-sequence (insert-characters n) CSI n "@") + +(define-escape-sequence (move-cursor-up n) CSI n "A") +(define-escape-sequence (move-cursor-down n) CSI n "B") +(define-escape-sequence (move-cursor-right n) CSI n "C") +(define-escape-sequence (move-cursor-left n) CSI n "D") + +(define-escape-sequence (cursor-next-line n) CSI n "E") +(define-escape-sequence (cursor-previous-line n) CSI n "F") + +(define-escape-sequence (goto-column n) CSI n "G") +(define-escape-sequence (goto row column) CSI row ";" column "H") + +(define-escape-sequence (cursor-forward-tabulation n) CSI n "I") + +(define-escape-sequence (clear-screen-from-cursor) CSI "0J") +(define-escape-sequence (clear-screen-to-cursor) CSI "1J") +(define-escape-sequence (clear-screen) CSI "2J") + +(define-escape-sequence (clear-to-eol) CSI "0K") +(define-escape-sequence (clear-to-sol) CSI "1K") +(define-escape-sequence (clear-line) CSI "2K") + +(define-escape-sequence (insert-lines n) CSI n "L") +(define-escape-sequence (delete-lines n) CSI n "M") + +(define-escape-sequence (clear-to-end-of-field) CSI "0N") +(define-escape-sequence (clear-to-start-of-field) CSI "1N") +(define-escape-sequence (clear-field) CSI "2N") + +(define-escape-sequence (clear-to-end-of-area) CSI "0O") +(define-escape-sequence (clear-to-start-of-area) CSI "1O") +(define-escape-sequence (clear-area) CSI "2O") + +(define-escape-sequence (delete-characters n) CSI n "P") + +(define-escape-sequence (select-editing-extent-page) CSI "0Q") +(define-escape-sequence (select-editing-extent-line) CSI "1Q") +(define-escape-sequence (select-editing-extent-field) CSI "2Q") +(define-escape-sequence (select-editing-extent-area) CSI "3Q") +(define-escape-sequence (select-editing-extent-whole) CSI "4Q") + +(define-escape-sequence (active-position-report row column) CSI row ";" column "R") + +(define-escape-sequence (scroll-up n) CSI n "S") +(define-escape-sequence (scroll-down n) CSI n "T") + +(define-escape-sequence (next-page n) CSI n "U") +(define-escape-sequence (previous-page n) CSI n "V") + +(define (select-graphic-rendition . parameters) + (if (null? parameters) + (string-append CSI "m") + (string-append CSI + (number->string (car parameters)) + (foldr (lambda (n acc) (string-append ";" (number->string n) acc)) + "m" + (cdr parameters))))) + +(define-escape-sequence (device-status-report) CSI "6n") +(define-escape-sequence (save-cursor-position) CSI "s") +(define-escape-sequence (restore-cursor-position) CSI "u") +(define-escape-sequence (hide-cursor) CSI "?25l") +(define-escape-sequence (show-cursor) CSI "?25h") + +(define-escape-sequence (ansi-interrupt) "\033a") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; DEC private VT100 sequences +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-escape-sequence (dec-double-width-double-height-top) "\033#3") +(define-escape-sequence (dec-double-width-double-height-bottom) "\033#4") +(define-escape-sequence (dec-single-width-single-height) "\033#5") +(define-escape-sequence (dec-double-width-single-height) "\033#6") + +(define-escape-sequence (dec-save-cursor) "\0337") +(define-escape-sequence (dec-restore-cursor) "\0338") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Parameters for select-graphic-rendition +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define style-normal 0) +(define style-bold 1) +(define style-faint 2) +(define style-italic/inverse 3) +(define style-underline 4) +(define style-blink-slow 5) +(define style-blink-fast 6) +(define style-inverse 7) +(define style-conceal 8) +(define style-crossed-out 9) + +(define style-primary-font 10) +(define (style-font n) + (if (<= 0 n 9) + (+ n 10) + (error 'style-font "Font number out of range: ~a" n))) + +(define style-fraktur 20) +(define style-no-bold/double-underline 21) +(define style-normal-intensity 22) +(define style-no-italic-no-fraktur 23) +(define style-no-underline 24) +(define style-no-blink 25) +;; 26 reserved, per wikipedia +(define style-no-inverse 27) +(define style-no-conceal 28) + +(define (style-text-color n) + (if (<= 0 n 7) + (+ n 30) + (error 'style-text-color "Color number out of range: ~a" n))) +(define style-default-text-color 39) + +(define (style-background-color n) + (if (<= 0 n 7) + (+ n 40) + (error 'style-background-color "Color number out of range: ~a" n))) +(define style-default-background-color 49) + +(define-escape-sequence (select-xterm-256-text-color n) CSI "38;5;" n "m") +(define-escape-sequence (select-xterm-256-background-color n) CSI "48;5;" n "m") + +;; 50 reserved, per wikipedia +(define style-framed 51) +(define style-encircled 52) +(define style-overlined 53) +(define style-no-framed-no-encircled 54) +(define style-no-overlined 55) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Colors for certain parameters to select-graphic-rendition +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define color-black 0) +(define color-red 1) +(define color-green 2) +(define color-yellow 3) +(define color-blue 4) +(define color-magenta 5) +(define color-cyan 6) +(define color-white 7) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Derived sequences +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-escape-sequence (kill-line) + (goto-column 1) + (clear-to-eol)) + +(define-escape-sequence (clear-screen/home) + (clear-screen) + (goto 1 1)) diff --git a/test-ansi.rkt b/test-ansi.rkt new file mode 100644 index 0000000..baa0602 --- /dev/null +++ b/test-ansi.rkt @@ -0,0 +1,35 @@ +#lang racket/base + +(require "ansi.rkt") + +(for-each display (list (select-graphic-rendition style-bold + (style-text-color color-yellow) + (style-background-color color-blue)) + (clear-screen/home) + (dec-double-width-single-height) + "Hello world!" + (move-cursor-left 6) + (insert-characters 5) + "ANSI" + "\n" + (dec-double-width-double-height-top) + "Bigger yet\n" + (dec-double-width-double-height-bottom) + "Bigger yet\n" + (dec-single-width-single-height) + "Normal\n" + (move-cursor-up 3) + (select-graphic-rendition style-normal-intensity) + (select-graphic-rendition (style-text-color color-white) + (style-background-color color-red)) + (insert-lines 3) + "Test\n" + (select-graphic-rendition (style-text-color color-white) + (style-background-color color-green)) + (delete-lines 2) + (move-cursor-up 1) + (goto-column 2) + (delete-characters 1) + (select-graphic-rendition) + (goto 19 1))) +