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