about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--.gitignore5
-rw-r--r--.repl29
-rw-r--r--makefile7
-rw-r--r--readme136
-rw-r--r--yolk.colors.sld7
-rw-r--r--yolk.colors.ss89
-rw-r--r--yolk.common.sld9
-rw-r--r--yolk.common.ss39
-rw-r--r--yolk.cursor.sld15
-rw-r--r--yolk.cursor.ss60
-rw-r--r--yolk.egg27
-rw-r--r--yolk.erase.sld13
-rw-r--r--yolk.erase.ss26
-rw-r--r--yolk.install.sh91
-rw-r--r--yolk.xterm.sld11
-rw-r--r--yolk.xterm.ss22
16 files changed, 586 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..eea9250 --- /dev/null +++ b/.gitignore
@@ -0,0 +1,5 @@
1*.build.sh
2*.so
3*.link
4*.o
5*.import.scm \ No newline at end of file
diff --git a/.repl b/.repl new file mode 100644 index 0000000..8adbefe --- /dev/null +++ b/.repl
@@ -0,0 +1,29 @@
1;;; -*- scheme -*-
2
3#+chicken (import (r7rs))
4
5(import (scheme file))
6
7;;; Load libraries
8
9(let loop ((load-files '("yolk.common"
10 "yolk.colors"
11 "yolk.cursor"
12 "yolk.erase"
13 "yolk.xterm")))
14 (if (null? load-files)
15 #t
16 (let* ((this (car load-files))
17 (ss (string-append (car load-files) ".ss"))
18 (sld (string-append (car load-files) ".sld")))
19 (and (file-exists? ss)
20 (load ss))
21 ;(eval `(import ,(map string->symbol (string-split this "."))))
22 (and (file-exists? sld)
23 (load sld))
24 (loop (cdr load-files)))))
25
26;;; Set up a test environment
27
28;;; Done.
29(print "Ready.")
diff --git a/makefile b/makefile new file mode 100644 index 0000000..05522f6 --- /dev/null +++ b/makefile
@@ -0,0 +1,7 @@
1.PHONY: install
2install:
3 chicken-install
4
5.PHONY: clean
6clean:
7 rm -f *.so *.o *.link *.build.sh
diff --git a/readme b/readme new file mode 100644 index 0000000..a98c60b --- /dev/null +++ b/readme
@@ -0,0 +1,136 @@
1YOLK --- ansi escapes for CHICKEN -*- text -*-
2
3yes there's already ansi-escape-sequences[1]. consider this NIH ;)
4this library is based on the information a gist by fnky[2].
5at some point i should base it instead on xterm's manual[3].
6
7Unless otherwise stated, all procedures and variables in this library are
8strings or return strings ready for `display'.
9
10INSTALLATION.
11
12Run `chicken-install' in this directory or `make install', which will run it for you. You can also run `make clean' to clean the folder of build artifacts.
13
14MODULES.
15
16(yolk common) --- common functionality
17
18Procedures.
19
20- (esc . xs)
21
22Return a string consisting of XS, converted to strings, prepended by ESC.
23
24- (csi . xs)
25
26Convenience function to escape XS using the csi code (ESC "[").
27
28- (dcs . xs)
29
30Convenience function to escape XS using the dcs code (ESC "P").
31
32- (ocs . xs)
33
34Convenience function to escape XS using the ocs code (ESC "]").
35
36- (parameter-assert predicate error-message)
37
38Convenience function. Returns a function that runs PREDICATE on its argument and
39returns the argument if PREDICATE passes, or errors if not. I use this for
40parameters.
41
42Syntax.
43
44- (define-esc-alt-wrapper wrapper-proc-name param-name (default-proc args ...))
45
46Many terminal behaviors have multiple escape sequences that might work. This
47macro defines a parameter named PARAM-NAME and a procedure named
48WRAPPER-PROC-NAME that will call PARAM-NAME with ARGS ... . The user can change
49which procedure to call by calling (PARAM-NAME new-proc).
50
51(yolk colors) --- NOT FINISHED
52
53There's a bug in this library.
54
55(yolk cursor) --- cursor movement
56
57Variables.
58
59-- cursor-home
60
61Move the cursor to the top-left corner (0,0). NOTE: This and the move commands
62might be revised later.
63
64Procedures.
65
66-- (cursor-move x y)
67
68Move cursor to X, Y, counting from the top-left corner of the screen.
69cursor-move is an esc-alt-wrapper that defaults to cursor-move/H ("^[[Y;XH").
70
71-- (cursor-up n)
72-- (cursor-down n)
73-- (cursor-right n)
74-- (cursor-left n)
75
76Move cursor up, down, left, or right by N spaces.
77
78-- (cursor-up-bol n)
79-- (cursor-down-bol n)
80
81Move cursor up or down by N lines, to the beginning of the given line.
82
83-- (cursor-move-column n)
84
85Move cursor to column N.
86
87-- (cursor-save)
88-- (cursor-restore)
89
90Save or restore the cursor's position on the screen. These variables are
91parameters defaulting to the DEC escapes. You can set them to the SCO escapes
92using (cursor-save cursor-save/sco), for example.
93
94(yolk erase) --- erasing the screen
95
96Variables.
97
98-- erase-screen-down
99-- erase-screen-up
100-- erase-screen
101-- erase-saved-lines
102
103These erase portions of the entire screen.
104
105-- erase-line-right
106-- erase-line-left
107-- erase-line
108
109These erase portions of the current line.
110
111-- erase-line-and-return
112
113Convenience function to return the cursor to the beginning of the line after erasing it.
114
115(yolk xterm) --- xterm-specific escape sequences
116
117Variables.
118
119-- invisible-cursor
120-- visible-cursor
121
122Make the cursor invisible or visible.
123
124-- save-screen
125-- restore-screen
126
127Save or restore the screen's state.
128
129-- alt-buffer-enable
130-- alt-buffer-disable
131
132Enable or disable the "alternate buffer."
133
134[1]: http://wiki.call-cc.org/eggref/5/ansi-escape-sequences
135[2]: https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797
136[3]: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
diff --git a/yolk.colors.sld b/yolk.colors.sld new file mode 100644 index 0000000..44d7593 --- /dev/null +++ b/yolk.colors.sld
@@ -0,0 +1,7 @@
1(define-library (yolk colors)
2 (export colors-reset
3 color?
4 colors
5 with-colors)
6
7 (include "yolk.colors.ss"))
diff --git a/yolk.colors.ss b/yolk.colors.ss new file mode 100644 index 0000000..70b821b --- /dev/null +++ b/yolk.colors.ss
@@ -0,0 +1,89 @@
1;;; (yolk colors) --- ansi color escapes
2
3;; "Colors" in this context refers both to actual /colors/, and to text
4;; properties like bold, italic, etc.
5
6(import (scheme base)
7 (scheme write)
8 (chicken string)
9 (matchable) ; is this something i want?
10 (yolk common))
11
12(define (%colors . codes)
13 (let ((codestr (string-intersperse (map ->string codes) ";")))
14 (csi codestr "m")))
15
16(define %props-alist
17 '((reset . "0")
18 ;; name . (on . off)
19 (bold . ("1" . "22"))
20 (dim . ("2" . "22"))
21 (italic . ("3" . "23"))
22 (underline . ("4" . "24"))
23 (blink . ("5" . "25"))
24 (inverse . ("7" . "27"))
25 (hidden . ("8" . "28"))
26 (strikethrough . ("9" . "29"))))
27
28(define %colors-alist
29 '((reset . "0")
30 ;; color . (fg . bg)
31 (black . ("30" . "40"))
32 (red . ("31" . "41"))
33 (green . ("32" . "42"))
34 (yellow . ("33" . "43"))
35 (blue . ("34" . "44"))
36 (magenta . ("35" . "45"))
37 (cyan . ("36" . "46"))
38 (white . ("37" . "47"))
39 (default . ("39" . "49"))))
40
41(define (atom? x)
42 (and (not (pair? x))
43 (not (null? x))))
44
45(define (colors-reset . codes)
46 (cond
47 ((null? codes)
48 (%colors 0))
49 (else (apply string-append
50 (map (lambda (code)
51 (match code
52 ('fg (%colors (cadr (assq 'default %colors-alist))))
53 ('bg (%colors (cddr (assq 'default %colors-alist))))
54 (x (%colors (cddr (assq x %props-alist))))))
55 codes)))))
56
57(define (color? x)
58 (memq x '(default black red green yellow blue magenta cyan white)))
59
60(define (colors codes)
61 (let loop ((codes codes)
62 (acc '()))
63 (if (null? codes)
64 (apply %colors (reverse acc))
65 (loop (cdr codes)
66 (match (car codes)
67 ((? number? x)
68 (cons x acc))
69 ((or `(fg ,color)
70 (? color? color))
71 (cons (cadr (assq color %colors-alist))
72 acc))
73 (`(bg ,color)
74 (cons (cddr (assq color %colors-alist))
75 acc))
76 ((or `(set ,prop)
77 `(,prop on)
78 (? atom? prop))
79 (cons (cadr (assq prop %props-alist))
80 acc))
81 ((or `(reset ,prop)
82 `(,prop off))
83 (cons (cddr (assq prop %props-alist)))))))))
84
85(define (with-colors codes thunk)
86 (dynamic-wind
87 (lambda () (display (colors codes)))
88 thunk
89 (lambda () (display (colors-reset)))))
diff --git a/yolk.common.sld b/yolk.common.sld new file mode 100644 index 0000000..94ac630 --- /dev/null +++ b/yolk.common.sld
@@ -0,0 +1,9 @@
1(define-library (yolk common)
2 (export esc
3 csi
4 dcs
5 ocs
6 define-esc-alt-wrapper
7 parameter-assert)
8
9 (include "yolk.common.ss"))
diff --git a/yolk.common.ss b/yolk.common.ss new file mode 100644 index 0000000..00aa91e --- /dev/null +++ b/yolk.common.ss
@@ -0,0 +1,39 @@
1;;; (yolk common) --- common stuff for ansi things
2
3(import (scheme base)
4 (scheme write))
5
6(define (->string x)
7 (let ((str (open-output-string)))
8 (display x str)
9 (close-output-port str)
10 (get-output-string str)))
11
12(define (esc . xs)
13 (apply string-append (string #\escape)
14 (map ->string xs)))
15
16(define (csi . xs)
17 (apply esc "[" xs))
18
19(define (dcs . xs)
20 (apply esc "P" xs))
21
22(define (ocs . xs)
23 (apply esc "]" xs))
24
25(define-syntax define-esc-alt-wrapper
26 (syntax-rules ()
27 ((_ wrapper-proc-name param-name (default-proc args ...))
28 (begin
29 (define param-name
30 (make-parameter default-proc
31 (parameter-assert procedure? "Must be a procedure")))
32 (define (wrapper-proc-name args ...)
33 ((param-name) args ...))))))
34
35(define (parameter-assert predicate error-message)
36 (lambda (x)
37 (if (predicate x)
38 x
39 (error error-message x))))
diff --git a/yolk.cursor.sld b/yolk.cursor.sld new file mode 100644 index 0000000..822720e --- /dev/null +++ b/yolk.cursor.sld
@@ -0,0 +1,15 @@
1(define-library (yolk cursor)
2 (export cursor-home
3 cursor-move cursor-move-proc
4 cursor-move/H cursor-move/f
5 cursor-up
6 cursor-down
7 cursor-right
8 cursor-left
9 cursor-down-bol
10 cursor-up-bol
11 cursor-move-column
12 cursor-save cursor-save/dec cursor-save/sco
13 cursor-restore cursor-restore/dec cursor-restore/sco)
14
15 (include "yolk.cursor.ss"))
diff --git a/yolk.cursor.ss b/yolk.cursor.ss new file mode 100644 index 0000000..a61aa2f --- /dev/null +++ b/yolk.cursor.ss
@@ -0,0 +1,60 @@
1;;; (yolk cursor) --- move the cursor around the terminal
2
3(import (scheme base)
4 (scheme case-lambda)
5 (yolk common))
6
7(define cursor-home
8 (csi "H"))
9
10(define (cursor-move/H x y)
11 (csi y ";" x "H"))
12
13(define (cursor-move/f x y)
14 (csi y ";" x "f"))
15
16(define-esc-alt-wrapper cursor-move cursor-move-proc
17 (cursor-move/H x y))
18
19(define (cursor-up n)
20 (csi n "A"))
21
22(define (cursor-down n)
23 (csi n "B"))
24
25(define (cursor-right n)
26 (csi n "C"))
27
28(define (cursor-left n)
29 (csi n "D"))
30
31(define (cursor-down-bol n)
32 (csi n "E"))
33
34(define (cursor-up-bol n)
35 (csi n "F"))
36
37(define (cursor-move-column n)
38 (csi n "G"))
39
40(define cursor-save/dec
41 (esc 7))
42
43(define cursor-restore/dec
44 (esc 8))
45
46(define cursor-save/sco
47 (csi "s"))
48
49(define cursor-restore/sco
50 (csi "u"))
51
52(define cursor-save
53 (make-parameter cursor-save/dec
54 (parameter-assert string? "Not a string")))
55
56(define cursor-restore
57 (make-parameter cursor-restore/dec
58 (parameter-assert string? "Not a string")))
59
60;; (define (get-cursor-postion) ...) ; (csi "6n"), reports as (csi r;cR)
diff --git a/yolk.egg b/yolk.egg new file mode 100644 index 0000000..4e77939 --- /dev/null +++ b/yolk.egg
@@ -0,0 +1,27 @@
1;;; yolk.egg --- ansi escapes for chicken -*- scheme -*-
2
3((synopsis "ANSI escapes for CHICKEN")
4 (author "Case Duckworth")
5 (category io)
6 (license "ISC")
7 (dependencies r7rs matchable)
8 (components
9 (extension yolk.common
10 (source "yolk.common.sld")
11 (csc-options "-R" "r7rs" "-X" "r7rs"))
12 #;(extension yolk.colors
13 (source "yolk.colors.sld")
14 (csc-options "-R" "r7rs" "-X" "r7rs")
15 (component-dependencies yolk.common))
16 (extension yolk.cursor
17 (source "yolk.cursor.sld")
18 (csc-options "-R" "r7rs" "-X" "r7rs")
19 (component-dependencies yolk.common))
20 (extension yolk.erase
21 (source "yolk.erase.sld")
22 (csc-options "-R" "r7rs" "-X" "r7rs")
23 (component-dependencies yolk.common))
24 (extension yolk.xterm
25 (source "yolk.xterm.sld")
26 (csc-options "-R" "r7rs" "-X" "r7rs")
27 (component-dependencies yolk.common))))
diff --git a/yolk.erase.sld b/yolk.erase.sld new file mode 100644 index 0000000..7d449ec --- /dev/null +++ b/yolk.erase.sld
@@ -0,0 +1,13 @@
1;;; (yolk erase) --- erasing ansi sequences
2
3(define-library (yolk erase)
4 (export erase-screen-down
5 erase-screen-up
6 erase-screen
7 erase-saved-lines
8 erase-line-right
9 erase-line-left
10 erase-line
11 erase-line-and-return)
12
13 (include "yolk.erase.ss"))
diff --git a/yolk.erase.ss b/yolk.erase.ss new file mode 100644 index 0000000..bc2d813 --- /dev/null +++ b/yolk.erase.ss
@@ -0,0 +1,26 @@
1(import (scheme base)
2 (yolk common))
3
4(define erase-screen-down
5 (csi "0J"))
6
7(define erase-screen-up
8 (csi "1J"))
9
10(define erase-screen
11 (csi "2J"))
12
13(define erase-saved-lines
14 (csi "3J"))
15
16(define erase-line-right
17 (csi "0K"))
18
19(define erase-line-left
20 (csi "1K"))
21
22(define erase-line
23 (csi "2K"))
24
25(define erase-line-and-return
26 (csi "2K\r"))
diff --git a/yolk.install.sh b/yolk.install.sh new file mode 100644 index 0000000..beaf7a7 --- /dev/null +++ b/yolk.install.sh
@@ -0,0 +1,91 @@
1#!/bin/sh
2
3set -e
4cd '/home/acdw/src/yolk'
5
6mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
7install -m 644 '/home/acdw/src/yolk/yolk.xterm.static.o' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.xterm.o'
8install -m 644 '/home/acdw/src/yolk/yolk.xterm.link' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.xterm.link'
9
10mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
11install -m 755 '/home/acdw/src/yolk/yolk.xterm.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.xterm.so'
12
13mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
14install -m 755 '/home/acdw/src/yolk/yolk.xterm.import.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.xterm.import.so'
15
16mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
17install -m 644 '/home/acdw/src/yolk/yolk.erase.static.o' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.erase.o'
18install -m 644 '/home/acdw/src/yolk/yolk.erase.link' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.erase.link'
19
20mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
21install -m 755 '/home/acdw/src/yolk/yolk.erase.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.erase.so'
22
23mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
24install -m 755 '/home/acdw/src/yolk/yolk.erase.import.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.erase.import.so'
25
26mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
27install -m 644 '/home/acdw/src/yolk/yolk.cursor.static.o' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.cursor.o'
28install -m 644 '/home/acdw/src/yolk/yolk.cursor.link' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.cursor.link'
29
30mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
31install -m 755 '/home/acdw/src/yolk/yolk.cursor.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.cursor.so'
32
33mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
34install -m 755 '/home/acdw/src/yolk/yolk.cursor.import.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.cursor.import.so'
35
36mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
37install -m 644 '/home/acdw/src/yolk/yolk.common.static.o' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.common.o'
38install -m 644 '/home/acdw/src/yolk/yolk.common.link' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.common.link'
39
40mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
41install -m 755 '/home/acdw/src/yolk/yolk.common.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.common.so'
42
43mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
44install -m 755 '/home/acdw/src/yolk/yolk.common.import.so' "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.common.import.so'
45
46mkdir -p "${DESTDIR}"'/home/acdw/usr/lib/chicken/11'
47rm -f "${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.egg-info'
48cat >"${DESTDIR}"'/home/acdw/usr/lib/chicken/11/yolk.egg-info' <<ENDINFO
49((installed-files
50 "/home/acdw/usr/lib/chicken/11/yolk.common.o"
51 "/home/acdw/usr/lib/chicken/11/yolk.common.link"
52 "/home/acdw/usr/lib/chicken/11/yolk.common.so"
53 "/home/acdw/usr/lib/chicken/11/yolk.common.import.so"
54 "/home/acdw/usr/lib/chicken/11/yolk.cursor.o"
55 "/home/acdw/usr/lib/chicken/11/yolk.cursor.link"
56 "/home/acdw/usr/lib/chicken/11/yolk.cursor.so"
57 "/home/acdw/usr/lib/chicken/11/yolk.cursor.import.so"
58 "/home/acdw/usr/lib/chicken/11/yolk.erase.o"
59 "/home/acdw/usr/lib/chicken/11/yolk.erase.link"
60 "/home/acdw/usr/lib/chicken/11/yolk.erase.so"
61 "/home/acdw/usr/lib/chicken/11/yolk.erase.import.so"
62 "/home/acdw/usr/lib/chicken/11/yolk.xterm.o"
63 "/home/acdw/usr/lib/chicken/11/yolk.xterm.link"
64 "/home/acdw/usr/lib/chicken/11/yolk.xterm.so"
65 "/home/acdw/usr/lib/chicken/11/yolk.xterm.import.so")
66 (synopsis "ANSI escapes for CHICKEN")
67 (author "Case Duckworth")
68 (category io)
69 (license "ISC")
70 (dependencies r7rs matchable)
71 (components
72 (extension
73 yolk.common
74 (source "yolk.common.sld")
75 (csc-options "-R" "r7rs" "-X" "r7rs"))
76 (extension
77 yolk.cursor
78 (source "yolk.cursor.sld")
79 (csc-options "-R" "r7rs" "-X" "r7rs")
80 (component-dependencies yolk.common))
81 (extension
82 yolk.erase
83 (source "yolk.erase.sld")
84 (csc-options "-R" "r7rs" "-X" "r7rs")
85 (component-dependencies yolk.common))
86 (extension
87 yolk.xterm
88 (source "yolk.xterm.sld")
89 (csc-options "-R" "r7rs" "-X" "r7rs")
90 (component-dependencies yolk.common))))
91ENDINFO
diff --git a/yolk.xterm.sld b/yolk.xterm.sld new file mode 100644 index 0000000..6d57c85 --- /dev/null +++ b/yolk.xterm.sld
@@ -0,0 +1,11 @@
1;;; (yolk xterm) --- xterm private mode settings
2
3(define-library (yolk xterm)
4 (export invisible-cursor
5 visible-cursor
6 save-screen
7 restore-screen
8 alt-buffer-enable
9 alt-buffer-disable)
10
11 (include "yolk.xterm.ss"))
diff --git a/yolk.xterm.ss b/yolk.xterm.ss new file mode 100644 index 0000000..50cfff8 --- /dev/null +++ b/yolk.xterm.ss
@@ -0,0 +1,22 @@
1(import (scheme base)
2 (yolk common))
3
4;;; Common private modes
5
6(define invisible-cursor
7 (csi "?25l"))
8
9(define visible-cursor
10 (csi "?25h"))
11
12(define save-screen
13 (csi "?47h"))
14
15(define restore-screen
16 (csi "?47l"))
17
18(define alt-buffer-enable
19 (csi "?1049h"))
20
21(define alt-buffer-disable
22 (csi "?1049l"))